Как удалить выделение, сделанное с помощью Shiny и mapedit, снова щелкнув по этой функции?

Question

Используя пакеты Shiny, leaflet и mapedit, я могу создать график из нескольких рядов, используя приведенный ниже код.

Интуитивно я хотел бы нажать на значок выбранной карты во второй раз, и связанные данные будут удалены из графика. По сути, событие щелчка может быть включено или выключено.

У кого-нибудь есть предложения?

# devtools::install_github("r-spatial/sf")
# devtools::install_github("r-spatial/mapview@develop")
# devtools::install_github("bhaskarvk/leaflet.extras")
# devtools::install_github("r-spatial/mapedit")
library(tidyverse)
library(sf)
library(leaflet)
library(mapedit)
library(mapview)
library(shiny)
library(shinyjs)

locnCoord <-
  data.frame(location = c('Sit1','Site2','Site3'),
             lat=c(-18.1, -18.3, -18.4),
             lon=c(145.8, 145.9, 145.9)) %>%
  mutate(depth = runif(3))

locnSF <- st_as_sf(locnCoord, coords = c('lon','lat'), crs="+proj=longlat +datum=WGS84 +no_defs")

#### User input

ui <- fluidPage(
  shinyjs::useShinyjs(),
  shinyjs::extendShinyjs(text = "shinyjs.refresh = function() { location.reload(); }"),
  fluidRow(
    # edit module ui
    column(6,
           selectModUI("selectmap"),
           actionButton("refresh", "Refresh Map")
           ),
    column(6,
           h3("Point of Depth"),
           plotOutput("selectstat")
           )
    )
  )

#### Server

server <- function(input, output, session) {

  observeEvent(input$refresh, {
    shinyjs::js$refresh()
  })

  g_sel <- callModule(
    selectMod,
    "selectmap",
    leaflet() %>%
      addTiles() %>%
      addFeatures(
        data = locnSF,
        layerId = ~location,
        stroke = TRUE,
        color = 'orange',
        fill = TRUE,
        fillColor = 'black',
        radius=10)
  )

  rv <- reactiveValues(selected=NULL)

  observe({
    gs <- g_sel()

    if(length(gs$id) > 0) {
      rv$selected <- locnSF %>% filter(location %in% gs$id)
    } else {
      rv$selected <- NULL
    }
  })

  output$selectstat <- renderPlot({
    ggplot()
    if(!is.null(rv$selected) && nrow(rv$selected) > 0) {
      ggplot(data=rv$selected, aes(location, depth))+
        geom_point(color='red', size=5)
    } else {
      ggplot()
    }
  })
}
shinyApp(ui, server)

Answer 1

Это работает. На вашем сервере попробуйте это:

observe({
   gs <- g_sel()

   if(length(gs$id) > 0) {
     site_select <- c(gs$selected)
     rv$selected <- locnSF %>% filter(location %in% gs$id) %>% 
       mutate(keeps = site_select) %>% filter(keeps == "TRUE")
   } else {
     rv$selected <- NULL
   }
})

Это отредактировано из вашего кода выше. Что я сделал, так это добавил новый столбец под названием keep via mutate который содержит логический термин, если сайт был выбран, а затем отфильтрован толькоTRUE (то есть в настоящее время выбранные) Когда вы отменяете выбор сайта, термин в очереди превращается в FALSE, таким образом, опускается из rv$selected.

Надеюсь это поможет.