lundi 16 octobre 2023

R Shiny script, checkbox and save

I have a problem with my script below, in fact when recording the status of checkboxes, I would like to have True if the checkbox is checked otherwise False, because for now I just have or . This is my script on R :

library(shiny)
library(shinythemes)
library(leaflet)
library(DT)
library(leaflet.extras)
library(readxl)
library(purrr) 
library(htmlwidgets)
library(magrittr)
library(rgdal)
library(sf)
library(htmltools)

Boccurrence <- read.csv("data1", sep = ",")
Boccurrence2 <- read.csv("data2", sep = ",")
Boccurrence$etape_suppression <- NA
Boccurrence1 <- rbind(Boccurrence, Boccurrence2)


lng1 <- -12
lat1 <- 39
lng2 <- 13
lat2 <- 52

taxon_data <- read_excel("species.xlsx")
species_names <- taxon_data$species

output_directory <- "map"


zee <- st_read("zee.shp")

zee <- st_transform(zee, crs = st_crs("+proj=longlat +datum=WGS84"))


ui <- fluidPage(
  titlePanel("Map"),
  sidebarLayout(
    sidebarPanel(
      selectInput("species_name", "Species", choices = unique(c(Boccurrence1$scientificname, Boccurrence2$scientificname))),
    ),
    mainPanel(
      leafletOutput("map"),
      verbatimTextOutput("selected_marker_id"), 
      DTOutput("table"),
      actionButton("save_button", "save"),
      downloadButton("download_button", "download")
    )
  )
)

server <- function(input, output, session) {
  
  filtered_occurrences1 <- reactiveVal(NULL)
  
  observe({
    species_name <- input$species_name
    
   
    filtered_data <- subset(Boccurrence1, scientificname == species_name)
    
    filtered_data$Longitude <- as.numeric(filtered_data$Longitude)
    filtered_data$Latitude <- as.numeric(filtered_data$Latitude)
    
    
    if (nrow(filtered_data) == 0) {
      filtered_occurrences1(NULL)  
    } else {
      filtered_occurrences1(filtered_data)  
    }
  })
  

  selected_rows <- reactiveVal(list())
  
  
  observeEvent(input$map_marker_click, {
    event <- input$map_marker_click
    if (!is.null(event$id)) {
      selected_row <- filtered_occurrences1()[filtered_occurrences1()$id == event$id,]
      complete_cases <- complete.cases(selected_row$id)
      selected_row <- selected_row[complete_cases,]
      
      selected_row <- cbind(Suppression = paste0('<input type="checkbox" id="suppression_', selected_row$id, '">'),
                            Inversion = paste0('<input type="checkbox" id="inversion_', selected_row$id, '">'),
                            selected_row)
      
      output$table <- renderDataTable({
        datatable(
          selected_row,
          escape = FALSE, 
          options = list(rowId = "id")
        )
      })
    }
  })
  
  
  observeEvent(input$save_button, {
    event <- input$map_marker_click
    if (!is.null(event$id)) {
      selected_row <- filtered_occurrences1()[filtered_occurrences1()$id == event$id,]
      complete_cases <- complete.cases(selected_row$id)
      selected_row <- selected_row[complete_cases,]
      
      selected_row$Suppression <- paste0('<input type="checkbox" id="suppression_', selected_row$id, '">')
      selected_row$Inversion <- paste0('<input type="checkbox" id="inversion_', selected_row$id, '">')
      
  
      current_selected_rows <- selected_rows()
      current_selected_rows[[length(current_selected_rows) + 1]] <- selected_row
      selected_rows(current_selected_rows)
    }
  })
  

  output$download_button <- downloadHandler(
    filename = function() {
      "data.csv"
    },
    content = function(file) {
      all_selected_rows <- do.call(rbind, selected_rows())
      write.csv(all_selected_rows, file, row.names = FALSE)
    }
  )
  
  # Leaflet map
  output$map <- renderLeaflet({
    m <- leaflet() %>%
      addTiles() %>%
      addProviderTiles("Esri.OceanBasemap", group = "Esri Ocean Basemap") %>%
      addPolygons(
        data = zee,
        weight = 1,
        color = "#0000FF",
        opacity = 1,
        fill = TRUE,
        fillOpacity = 0
      ) %>%
      addRectangles(
        lng1 = lng1, lat1 = lat1,
        lng2 = lng2, lat2 = lat2,
        weight = 2,
        color = "black",
        opacity = 1,
        fillOpacity = 0
      )
    
    if (!is.null(filtered_occurrences1())) {
      m <- m %>%
        addCircleMarkers(
          data = filtered_occurrences1(),
          lng = ~Longitude, lat = ~Latitude,
          color = "#34C924", radius = 4, stroke = FALSE,
          fillOpacity = 1,
          group = "markers",
          layerId = ~id 
        )
      
      if (!is.null(input$map_marker_click)) {
        clicked_id <- input$map_marker_click$id
        if (!is.null(clicked_id)) {
          m <- m %>%
            addCircleMarkers(
              data = filtered_occurrences1()[filtered_occurrences1()$id == clicked_id, ],
              lng = ~Longitude, lat = ~Latitude,
              color = "#FFA500", radius = 4, stroke = FALSE,
              fillOpacity = 1,
              group = "selected_marker",
              layerId = ~id
            )
        }
      }
    }
    
    m %>%
      addCircleMarkers(
        lng = 13, lat = 52,
        options = markerOptions(clickable = TRUE, opacity = 0),
        popup = "Zone : 39-52 °N; -12-13 °E"
      )
  })
  
}


shinyApp(ui = ui, server = server)

I tried this code but as soon as I save the page it closes and doesn't work anymore.

observeEvent(input$save_button, {
  event <- input$map_marker_click
  if (!is.null(event$id)) {
    selected_row <- filtered_occurrences1()[filtered_occurrences1()$id == event$id,]
    complete_cases <- complete.cases(selected_row$id)
    selected_row <- selected_row[complete_cases,]

    if (input[[paste0("suppression_", selected_row$id)]] == "on") {
      selected_row$Suppression <- "Suppression"
    } else {
      selected_row$Suppression <- ""
    }

    if (input[[paste0("inversion_", selected_row$id)]] == "on") {
      selected_row$Inversion <- "Inversion"
    } else {
      selected_row$Inversion <- ""
    }

    current_selected_rows <- selected_rows()
    current_selected_rows[[length(current_selected_rows) + 1]] <- selected_row
    selected_rows(current_selected_rows)
  }
})

I've also tried this, but it gives me the same error and I don't understand.


selected_rows <- reactiveVal(list())

observeEvent(input$map_marker_click, {
  event <- input$map_marker_click
  if (!is.null(event$id)) {
    selected_row <- filtered_occurrences1()[filtered_occurrences1()$id == event$id,]
    complete_cases <- complete.cases(selected_row$lat, selected_row$lng)
    selected_row <- selected_row[complete_cases,]

    selected_row$Suppression <- paste0(
      '<input type="checkbox" id="suppression_', selected_row$id, '" name="suppression_', selected_row$id, '">'
    )
    selected_row$Inversion <- paste0(
      '<input type="checkbox" id="inversion_', selected_row$id, '" name="inversion_', selected_row$id, '">'
    )

    current_selected_rows <- selected_rows()
    current_selected_rows[[length(current_selected_rows) + 1]] <- selected_row
    selected_rows(current_selected_rows)

    output$table <- renderDataTable({
      datatable(
        selected_row,
        escape = FALSE,
        options = list(rowId = "id")
      )
    })
  }
})

observeEvent(input$save_button, {
  event <- input$map_marker_click
  if (!is.null(event$id)) {
    selected_row <- filtered_occurrences1()[filtered_occurrences1()$id == event$id,]
    complete_cases <- complete.cases(selected_row$lat, selected_row$lng)
    selected_row <- selected_row[complete_cases,]

    selected_row$Suppression <- ifelse(
      input[[paste0("suppression_", selected_row$id)]] == "on",
      "TRUE",
      ""
    )
    selected_row$Inversion <- ifelse(
      input[[paste0("inversion_", selected_row$id)]] == "on",
      "TRUE",
      ""
    )

    current_selected_rows <- selected_rows()
    current_selected_rows[[length(current_selected_rows) + 1]] <- selected_row
    selected_rows(current_selected_rows)
  }
})





Aucun commentaire:

Enregistrer un commentaire