使用传单中的 map_click 选择多个项目，链接到闪亮应用程序 (R) 中的 selectizeInput() [英] Select multiple items using map_click in leaflet, linked to selectizeInput() in shiny app (R)

问题描述

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

我稍微更改/更新了

解决方案

请看以下解决方法:

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

库(闪亮)图书馆(传单)图书馆(旧金山)图书馆(dplyr)#加载形状文件nc <- st_read(system.file(shape/nc.shp", package=sf")) %>%st_transform(4326)闪亮的应用程序(ui =流体页面(通过单击地图更新选择输入"，传单输出(地图")，我希望更新选择输入以显示所有选择的位置，"，而且当这里删除项目时，它们也会在地图上删除，因此链接到地图."，selectizeInput(inputId = "selected_locations",标签=选择"，选择 = nc$NAME,选择=空，多个=真)),服务器 <- 功能(输入，输出，会话){#创建空向量来保存所有点击IDselected_ids <-reactiveValues(ids = vector())#初始地图输出输出$map <- renderLeaflet({传单() %>%addTiles() %>%addPolygons(数据 = nc，fillColor =白色"，填充不透明度 = 0.5，颜色=黑色"，中风=真，重量 = 1，layerId = ~NAME,组=区域"，标签 = ~NAME) %>%addPolygons(数据 = nc，填充颜​​色=红色"，填充不透明度 = 0.5，重量 = 1，颜色=黑色"，中风=真，layerId = ~CNTY_ID,组 = ~NAME) %>%hideGroup(group = nc$NAME) # nc$CNTY_ID}) #END 渲染传单#define 二级区域地图的传单代理proxy <-leafletProxy(map")#创建空向量来保存所有点击ID选择<-反应值(组=向量())观察事件(输入$map_shape_click，{如果(输入$map_shape_click$group == 区域"){selected$groups <- c(selected$groups, input$map_shape_click$id)代理 %>% showGroup(group = input$map_shape_click$id)} 别的 {selected$groups <- setdiff(selected$groups, input$map_shape_click$group)代理 %>% hideGroup(group = input$map_shape_click$group)}更新选择输入(会话，inputId = "selected_locations",标签="，选择 = nc$NAME,选定的=选定的$组)})观察事件(输入$选定位置，{remove_via_selectInput <- setdiff(selected$groups, input$selected_locations)added_via_selectInput <- setdiff(input$selected_locations, selected$groups)if(长度(removed_via_selectInput) > 0){selected$groups <- 输入$selected_locations代理 %>% hideGroup(group = removed_via_selectInput)}if(长度(add_via_selectInput) > 0){selected$groups <- 输入$selected_locations代理 %>% showGroup(group = added_via_selectInput)}}，忽略NULL = FALSE)})

---

关于您适应 这个答案你需要将 layerId 作为 character 来让事情再次发生:

 代理 %>% removeShape(layerId = as.character(click$id))代理 %>% addPolygons(data = clicked_polys,填充颜​​色=红色"，填充不透明度 = 0.5，重量 = 1，颜色=黑色"，中风=真，layerId = as.character(clicked_polys$CNTY_ID))

我提交了一个关于此的问题.

但是，我仍然更喜欢上面的显示/隐藏方法，因为我猜它比添加和删除多边形更高效.

I would like to create a leaflet map where you can select multiple polygons and this will update the selectizeInput() in a shiny app. This would including removing a selected polygon, when it is removed in the selectizeInput().

I have slightly changed/updated the code from the answer here (use of sf instead of sp and more dplyr where I could work out what the base R was).

The polygons could probably be updated with an observeEvent tied in with input$clicked_locations, but not sure exactly how.

Here is the code:

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

This is also posted here where you can also find the edited version of the code from the answer (originally an sp dataset), that works. This code for the nc data set seems to be the same to me, but doesn't seem to work, although updating the polygons based on the selectizeInput() isn't in there.

Any ideas on this?

解决方案

Please see the following workaround:

I'm adding all polygons on rendering the map and hiding the red overlay. Furthermore each of the red polygons is assigned to it's own group. On click the according group and therefore the polygon is 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)
    
  })

---

Edit: regarding your initial approach adapting this answer you would need to pass the layerId as character to make things work again:

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

I filed an issue regarding this.

However, I'd still prefer the above show/hide approach as I guess it's more performant than adding and removing polygons.

这篇关于使用传单中的 map_click 选择多个项目，链接到闪亮应用程序 (R) 中的 selectizeInput()的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！