使用传单中的map_click选择多个项目，链接到基于过滤数据的selectizeInput()

Question

我正在创建一个闪亮的应用程序，它使用 ismirsehregal 提供的解决方案来使用 map_click 和

selectizeInput

（取消）选择多个项目。 使用传单中的map_click选择多个项目，链接到闪亮应用程序(R)中的selectizeInput()

但现在我想添加一个

pickerInput

来首先过滤地图。 因此，假设用户可以首先根据“SID79”过滤 nc 数据集（如下所示）。

library(shiny)
library(leaflet)
library(sf)
library(dplyr)
library(shinyWidgets)

#load shapefile
nc_raw <- st_read(system.file("shape/nc.shp", package="sf")) %>%
  st_transform(4326)

shinyApp(
  ui = fluidPage(
    
    # I added pickerinput to filter based on SID79
    pickerInput("select_type",
                label = "Select Type",
                choices = sort(unique(nc_raw$SID79)), 
                options = list("actions-box" = TRUE), 
                multiple = TRUE,
                selected = 1),
    
    "Update selectize input by clicking on the map",
    
    leafletOutput("map"),
    # I would like the selectize input to update to show all the locations selected by pickerInput,
    # when items are removed here, they are removed on the map too, so linked to the map. 
    # Also users can add areas that are initially deselected due to the pickerInput filter
    
    selectizeInput(inputId = "selected_locations",
                   label = "selected",
                   choices = " ",
                   selected = NULL,
                   multiple = TRUE)
  ),
  
  server <- function(input, output, session){
    
    ##### Filter regions ####
    nc <- reactive({
      nc  <- filter(nc_raw, 
                    SID79 %in% input$select_type) 
    })
    
    #create empty vector to hold all click ids
    selected_ids <- reactiveValues(ids = vector())
    
    #initial map output
    output$map <- renderLeaflet({
      leaflet() %>%
        addTiles() %>%
        addPolygons(data = nc_raw,
                    fillColor = "white",
                    fillOpacity = 0.5,
                    color = "black",
                    stroke = TRUE,
                    weight = 1,
                    layerId = ~NAME,
                    group = "regions",
                    label = ~NAME) %>%
        addPolygons(data = nc(),
                    fillColor = "red",
                    fillOpacity = 0.5,
                    weight = 1,
                    color = "black",
                    stroke = TRUE,
                    layerId = ~CNTY_ID,
                    group = ~NAME) %>%
        
        # I modified this from hideGroup; Ideally users could still add areas filtered out by
        # pickerInput but not sure the best way to do this... another map layer?
        showGroup(group = nc()$NAME)
    }) #END RENDER LEAFLET
    
    #define leaflet proxy for second regional level map
    proxy <- leafletProxy("map")
    
    # create empty vector to hold all click ids
    # selected should initially display all areas selected by pickerInput
    selected <- reactiveValues(groups = vector())
    
    observeEvent(input$map_shape_click, {
      if(input$map_shape_click$group == "regions"){
        selected$groups <- c(selected$groups, input$map_shape_click$id)
        proxy %>% showGroup(group = input$map_shape_click$id)
      } else {
        selected$groups <- setdiff(selected$groups, input$map_shape_click$group)
        proxy %>% hideGroup(group = input$map_shape_click$group)
      }
      updateSelectizeInput(session,
                           inputId = "selected_locations",
                           label = "",
                           choices = nc()$NAME,
                           selected = selected$groups)
    })
    
    observeEvent(input$selected_locations, {
      removed_via_selectInput <- setdiff(selected$groups, input$selected_locations)
      added_via_selectInput <- setdiff(input$selected_locations, selected$groups)
      
      if(length(removed_via_selectInput) > 0){
        selected$groups <- input$selected_locations
        proxy %>% hideGroup(group = removed_via_selectInput)
      }
      
      if(length(added_via_selectInput) > 0){
        selected$groups <- input$selected_locations
        proxy %>% showGroup(group = added_via_selectInput)
      }
    }, ignoreNULL = FALSE)
    
  })

现在地图应该根据 select_type 过滤器进行更新，并填充

selectizeInput

显示。从那里，用户应该能够通过单击地图或使用

selectizeInput

添加或删除区域。这是我的应用程序的图片以及我希望此功能如何工作：

我已经调整 ismirsehregal 的代码几个小时了，但无法让它工作。这个看似简单的修改对我来说太复杂了

Answer 1

我们需要添加另一个

observeEvent

来跟踪反应性

nc()

来更新

selectizeInput

“selected_locations”的选择。

请检查以下内容：

library(shiny)
library(leaflet)
library(sf)
library(dplyr)
library(shinyWidgets)

#load shapefile
nc_raw <- st_read(system.file("shape/nc.shp", package="sf")) %>%
  st_transform(4326)

shinyApp(
  ui = fluidPage(
    pickerInput("select_type",
                label = "Select Type",
                choices = sort(unique(nc_raw$SID79)), 
                options = list("actions-box" = TRUE), 
                multiple = TRUE,
                selected = 1),
    "Update selectize input by clicking on the map",
    leafletOutput("map"),
    "I would like the selectize input to update to show all the locations selected,",
    "but also when items are removed here, they are removed on the map too, so linked to the map.",
    selectizeInput(inputId = "selected_locations",
                   label = "Selected:",
                   choices = NULL,
                   selected = NULL,
                   multiple = TRUE)
  ),
  
  server <- function(input, output, session){
    ##### Filter regions ####
    nc <- reactive({
      filter(nc_raw, SID79 %in% input$select_type) 
    })
    
    observeEvent(nc(), {
      updateSelectizeInput(session,
                           inputId = "selected_locations",
                           choices = nc()$NAME,
                           selected = input$selected_locations)
    })
    
    #create empty vector to hold all click ids
    selected_ids <- reactiveValues(ids = vector())
    
    #initial map output
    output$map <- renderLeaflet({
      req({NROW(nc()) > 0})
      leaflet() %>%
        addTiles() %>%
        addPolygons(data = nc(),
                    fillColor = "white",
                    fillOpacity = 0.5,
                    color = "black",
                    stroke = TRUE,
                    weight = 1,
                    layerId = ~NAME,
                    group = "regions",
                    label = ~NAME) %>%
        addPolygons(data = nc(),
                    fillColor = "red",
                    fillOpacity = 0.5,
                    weight = 1,
                    color = "black",
                    stroke = TRUE,
                    layerId = ~CNTY_ID,
                    group = ~NAME) %>%
        hideGroup(group = setdiff(nc()$NAME, input$selected_locations)) # nc()$CNTY_ID
    }) #END RENDER LEAFLET
    
    #define leaflet proxy for second regional level map
    proxy <- leafletProxy("map")
    
    #create empty vector to hold all click ids
    selected <- reactiveValues(groups = vector())
    
    observeEvent(input$map_shape_click, {
      if(input$map_shape_click$group == "regions"){
        selected$groups <- c(selected$groups, input$map_shape_click$id)
        proxy %>% showGroup(group = input$map_shape_click$id)
      } else {
        selected$groups <- setdiff(selected$groups, input$map_shape_click$group)
        proxy %>% hideGroup(group = input$map_shape_click$group)
      }
      updateSelectizeInput(session,
                           inputId = "selected_locations",
                           choices = nc()$NAME,
                           selected = selected$groups)
    })
    
    observeEvent(input$selected_locations, {
      removed_via_selectInput <- setdiff(selected$groups, input$selected_locations)
      added_via_selectInput <- setdiff(input$selected_locations, selected$groups)
      
      if(length(removed_via_selectInput) > 0){
        selected$groups <- input$selected_locations
        proxy %>% hideGroup(group = removed_via_selectInput)
      }
      
      if(length(added_via_selectInput) > 0){
        selected$groups <- input$selected_locations
        proxy %>% showGroup(group = added_via_selectInput)
      }
    }, ignoreNULL = FALSE)
    
  })

---

编辑：OPs附加请求，取消选择组：

library(shiny)
library(leaflet)
library(sf)
library(dplyr)
library(shinyWidgets)

#load shapefile
nc_raw <- st_read(system.file("shape/nc.shp", package="sf")) %>%
  st_transform(4326)

shinyApp(
  ui = fluidPage(
    pickerInput("select_type",
                label = "Select Type",
                choices = sort(unique(nc_raw$SID79)), 
                options = list("actions-box" = TRUE), 
                multiple = TRUE,
                selected = 1),
    "Update selectize input by clicking on the map",
    leafletOutput("map"),
    "I would like the selectize input to update to show all the locations selected,",
    "but also when items are removed here, they are removed on the map too, so linked to the map.",
    selectizeInput(inputId = "selected_locations",
                   label = "Selected:",
                   choices = NULL,
                   selected = NULL,
                   multiple = TRUE)
  ),
  
  server <- function(input, output, session){
    ##### Filter regions ####
    nc <- reactive({
      filter(nc_raw, SID79 %in% input$select_type) 
    })
    
    observeEvent(nc(), {
      updateSelectizeInput(session,
                           inputId = "selected_locations",
                           choices = nc()$NAME,
                           selected = nc()$NAME) # input$selected_locations
    })
    
    #create empty vector to hold all click ids
    selected_ids <- reactiveValues(ids = vector())
    
    #initial map output
    output$map <- renderLeaflet({
      req({NROW(nc()) > 0})
      leaflet() %>%
        addTiles() %>%
        addPolygons(data = nc(),
                    fillColor = "white",
                    fillOpacity = 0.5,
                    color = "black",
                    stroke = TRUE,
                    weight = 1,
                    layerId = ~NAME,
                    group = "regions",
                    label = ~NAME) %>%
        addPolygons(data = nc(),
                    fillColor = "red",
                    fillOpacity = 0.5,
                    weight = 1,
                    color = "black",
                    stroke = TRUE,
                    layerId = ~CNTY_ID,
                    group = ~NAME) 
      # %>% hideGroup(group = setdiff(nc()$NAME, input$selected_locations)) # nc()$CNTY_ID
    }) #END RENDER LEAFLET
    
    #define leaflet proxy for second regional level map
    proxy <- leafletProxy("map")
    
    #create empty vector to hold all click ids
    selected <- reactiveValues(groups = vector())
    
    observeEvent(input$map_shape_click, {
      if(input$map_shape_click$group == "regions"){
        selected$groups <- c(selected$groups, input$map_shape_click$id)
        proxy %>% showGroup(group = input$map_shape_click$id)
      } else {
        selected$groups <- setdiff(selected$groups, input$map_shape_click$group)
        proxy %>% hideGroup(group = input$map_shape_click$group)
      }
      updateSelectizeInput(session,
                           inputId = "selected_locations",
                           choices = nc()$NAME,
                           selected = selected$groups)
    })
    
    observeEvent(input$selected_locations, {
      removed_via_selectInput <- setdiff(selected$groups, input$selected_locations)
      added_via_selectInput <- setdiff(input$selected_locations, selected$groups)
      
      if(length(removed_via_selectInput) > 0){
        selected$groups <- input$selected_locations
        proxy %>% hideGroup(group = removed_via_selectInput)
      }
      
      if(length(added_via_selectInput) > 0){
        selected$groups <- input$selected_locations
        proxy %>% showGroup(group = added_via_selectInput)
      }
    }, ignoreNULL = FALSE)
    
  })