Select 传单中使用 map_click 的多个项目，链接到 shiny 应用程序 (R) 中的 selectizeInput()

Question

我想创建一个传单地图，您可以在其中 select 多个多边形，这将在闪亮的应用程序中更新 selectizeInput()。这将包括在 selectizeInput().

中删除 selected 多边形时

我有点 changed/updated （使用 sf 而不是 sp 和更多的 dplyr，我可以计算出基数 R 是什么）。

多边形可能会用 observeEvent 与 input$clicked_locations 结合更新，但不确定具体如何。

代码如下：

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

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

shinyApp(
  ui = fluidPage(
    
    "Update selectize input by clicking on the map",
    
    leafletOutput("map"),
    "I would like the selectize input to update to show all the locations clicked,",
    "but also when items are removed here, they are removed on the map too, so linked to the map.",
    selectizeInput(inputId = "clicked_locations",
                   label = "Clicked",
                   choices = nc$NAME,
                   selected = NULL,
                   multiple = TRUE)
  ),
  
  server <- function(input, output, session){
    
    #create empty vector to hold all click ids
    clicked_ids <- reactiveValues(ids = vector())
    
    #initial map output
    output$map <- renderLeaflet({
      leaflet() %>%
        addTiles() %>%
        addPolygons(data = nc,
                    fillColor = "white",
                    fillOpacity = 0.5,
                    color = "black",
                    stroke = TRUE,
                    weight = 1,
                    layerId = ~NAME,
                    group = "regions",
                    label = ~NAME)
    }) #END RENDER LEAFLET
    
    observeEvent(input$map_shape_click, {
      
      #create object for clicked polygon
      click <- input$map_shape_click
      
      #define leaflet proxy for second regional level map
      proxy <- leafletProxy("map")
      
      #append all click ids in empty vector
      clicked_ids$ids <- c(clicked_ids$ids, click$id) # name when clicked, id when unclicked
      
      #shapefile with all clicked polygons - original shapefile subsetted by all admin names from the click list
      clicked_polys <- nc %>%
        filter(NAME %in% clicked_ids$ids)
      
      #if the current click ID [from CNTY_ID] exists in the clicked polygon (if it has been clicked twice)
      if(click$id %in% clicked_polys$CNTY_ID){
        
        #define vector that subsets NAME that matches CNTY_ID click ID - needs to be different to above
        name_match <- clicked_polys$NAME[clicked_polys$CNTY_ID == click$id]
        
        #remove the current click$id AND its name match from the clicked_polys shapefile
        clicked_ids$ids <- clicked_ids$ids[!clicked_ids$ids %in% click$id]
        clicked_ids$ids <- clicked_ids$ids[!clicked_ids$ids %in% name_match]
        
        # just to see
        print(clicked_ids$ids)
        
        # update
        updateSelectizeInput(session,
                             inputId = "clicked_locations",
                             label = "",
                             choices = nc$NAME,
                             selected = clicked_ids$ids)
        
        #remove that highlighted polygon from the map
        proxy %>% removeShape(layerId = click$id)
        
      } else {
        
        #map highlighted polygons
        proxy %>% addPolygons(data = clicked_polys,
                              fillColor = "red",
                              fillOpacity = 0.5,
                              weight = 1,
                              color = "black",
                              stroke = TRUE,
                              layerId = clicked_polys$CNTY_ID)
        
        # just to see
        print(clicked_ids$ids)
        
        # update
        updateSelectizeInput(session,
                             inputId = "clicked_locations",
                             label = "",
                             choices = nc$NAME,
                             selected = clicked_ids$ids)
        
      } #END CONDITIONAL
    }) #END OBSERVE EVENT
  }) #END SHINYAPP

这也发布在 here 中，您还可以从答案（最初是 sp 数据集）中找到代码的编辑版本，它可以工作。 nc 数据集的这段代码对我来说似乎是一样的，但似乎不起作用，尽管根据 selectizeInput() 更新多边形不在那里。

对此有什么想法吗？

Answer 1

请参阅以下解决方法：

我在渲染地图时添加了所有多边形并隐藏了红色叠加层。此外，每个红色多边形都分配给它自己的组。单击相应的组，因此多边形为 shown/hidden.

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

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

shinyApp(
  ui = fluidPage(
    
    "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 = nc$NAME,
                   selected = NULL,
                   multiple = TRUE)
  ),
  
  server <- function(input, output, session){
    
    #create empty vector to hold all click ids
    selected_ids <- reactiveValues(ids = vector())
    
    #initial map output
    output$map <- renderLeaflet({
      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 = nc$NAME) # 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",
                           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)
    
  })

编辑： 关于您适应的初始方法，您需要将 layerId 传递为 character 才能再次运行：

    proxy %>% removeShape(layerId = as.character(click$id))
    
    proxy %>% addPolygons(data = clicked_polys,
                          fillColor = "red",
                          fillOpacity = 0.5,
                          weight = 1,
                          color = "black",
                          stroke = TRUE,
                          layerId = as.character(clicked_polys$CNTY_ID))

我提交了 issue regarding this。

但是，我仍然更喜欢上面的 show/hide 方法，因为我认为它比添加和删除多边形更高效。

Select 传单中使用 map_click 的多个项目，链接到 shiny 应用程序 (R) 中的 selectizeInput()

Select multiple items using map_click in leaflet, linked to selectizeInput() in shiny app (R)

r

shiny

leaflet

sf

r-leaflet