从 UI checkboxGroupInput 切换点组，而不是 addLayersControl

Question

鉴于一个闪亮的应用程序通过传单显示多组地图点，我想创建一个切换来显示/隐藏特定组。

我可以通过

addLayersControl

实现此目的，如下例所示：

library(shiny)
library(shinyjs)
library(leaflet)
library(dplyr)

ui <- fluidPage(
  leafletOutput("mymap",height = '100vh')
)

server <- function(input, output) {
  data(quakes)
  
  output$mymap <- renderLeaflet({
    leaflet(data = quakes) %>% 
      
      setView(lng = quakes[1, 'long'],
              lat = quakes[1, 'lat'],
              zoom=5) %>%
      
      addTiles()
  })
  
  observe({
    leafletProxy('mymap', data = quakes) %>%
      
    clearShapes() %>%
      
    addCircleMarkers(data = quakes[quakes$mag>=5, ],
                     ~long,
                     ~lat,
                     radius=3,
                     group = 'quakes1',
                     stroke=FALSE,
                     fillOpacity=0.5,
                     color = 'red')  %>%
      
      addCircleMarkers(data = quakes[quakes$mag<5, ],
                       ~long,
                       ~lat,
                       radius=3,
                       group = 'quakes2',
                       stroke=FALSE,
                       fillOpacity=0.5,
                       color = 'green')  %>%
      
      addLayersControl(overlayGroups = c('quakes1','quakes2'),
                       options = layersControlOptions(collapsed = FALSE))
  })
}

shinyApp(ui, server)

但是，我更喜欢由服务器端创建的

checkboxGroupInput

来处理切换。比如：

# Changing `mag` to a binary classification for simplicity
quakes$mag<- ifelse(quakes$mag >=5, 1, 2)

output$quakesToggle <- renderUI({
   checkboxGroupInput('quakesToggle', 'Select magnitude:',
                       choices  = list('Quakes1'=1,'Quakes2'=2)
   )
})

observe({
  toggle(id='foo', condition = 'Quakes1' %in% input$quakesToggle)
  toggle(id='bar', condition = 'Quakes2' %in% input$quakesToggle)
})

问题是我不知道如何或即使可以将切换 ID 与传单地图点的相关组 ID 关联起来...

Answer 1

这是一个可能的解决方案：

library(shiny)
library(shinyjs)
library(leaflet)
library(dplyr)

ui <- fluidPage(
  uiOutput("quakesToggle"),
  leafletOutput("mymap",height = '100vh')
)

server <- function(input, output) {
  data(quakes)
  
  output$mymap <- renderLeaflet({
    leaflet(data = quakes) %>% 
      setView(lng = quakes[1, 'long'],
              lat = quakes[1, 'lat'],
              zoom=5) %>%
      addTiles() %>%
      addCircleMarkers(data = quakes[quakes$mag>=5, ],
                       ~long,
                       ~lat,
                       radius=3,
                       group = 'quakes1',
                       stroke=FALSE,
                       fillOpacity=0.5,
                       color = 'red')  %>%
      addCircleMarkers(data = quakes[quakes$mag<5, ],
                       ~long,
                       ~lat,
                       radius=3,
                       group = 'quakes2',
                       stroke=FALSE,
                       fillOpacity=0.5,
                       color = 'green')
  })
  
  output$quakesToggle <- renderUI({
    checkboxGroupInput('quakesToggle', 'Select magnitude:',
                       choices  = c('Quakes1','Quakes2'),
                       selected = c('Quakes1','Quakes2')
    )
  })
  
  observeEvent(input$quakesToggle, {
    if('Quakes1' %in% input$quakesToggle) {
      leafletProxy('mymap', data = quakes) %>%
        showGroup('quakes1')
    } else {
      leafletProxy('mymap', data = quakes) %>%
        hideGroup('quakes1')
    }
    
    if('Quakes2' %in% input$quakesToggle) {
      leafletProxy('mymap', data = quakes) %>%
        showGroup('quakes2')
    } else {
      leafletProxy('mymap', data = quakes) %>%
        hideGroup('quakes2')
    }
  }, ignoreNULL = FALSE)
}

shinyApp(ui, server)