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)
}
})
