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

我正在创建一个闪亮的应用程序（我的第一个），它使用ismirsehregal提供的解决方案，通过map_click和selectizeInput来选择（取消）多个项目。Select multiple items using map_click in leaflet, linked to selectizeInput() in shiny app (R)
但是现在我想先添加一个pickerInput来过滤Map，所以，假设用户可以先根据“SID 79”过滤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)
    
  })

现在，Map应该根据select_type过滤器更新，并填充selectizeInput显示。在那里，用户应该能够通过单击Map或使用selectizeInput添加或删除区域。以下是我的应用的图片，以及我希望如何使用此功能：

任何帮助都将不胜感激！我已经调整ismirsehregal的代码几个小时了，但不能让它工作。对我来说，做这个看似简单的修改太复杂了。
非常感谢！

我们需要添加另一个跟踪React式nc()的observeEvent来更新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)
    
  })

- 编辑：OP附加请求，取消选择组：**

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

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

1条答案

相关问题

热门标签

最新问答