使用 Leaflet/Shiny 选择和取消选择多个多边形时更改样式

Changing styles when selecting and deselecting multiple polygons with Leaflet/Shiny

在我正在处理的 Leaflet Shiny 应用程序中 selecting 和 deselecting 多边形时,我在更改多边形样式时遇到了一些问题。在我当前的应用程序中,当您单击一个多边形时,该多边形会以不同的颜色突出显示。理想情况下,我希望用户能够 select 并突出显示多个多边形。我还希望用户能够重新单击单个突出显示的多边形以取消select它。

我能处理的最好的方法是 select 多个多边形,给它们相同的组 ID "selected",然后当一个多边形时 deselect 整个组被重新点击。这是一些 example/reproducible 代码:

library(raster)
library(shiny)
library(leaflet)

#load shapefile
rwa <- getData("GADM", country = "RWA", level = 1)

shinyApp(
  ui = fluidPage(
    leafletOutput("map")
  ), 

  server <- function(input, output, session){

    #initial map output
    output$map <- renderLeaflet({
      leaflet() %>% 
        addTiles() %>% 
        addPolygons(data = rwa, 
                    fillColor = "white", 
                    fillOpacity = 1, 
                    color = "black", 
                    stroke = T, 
                    weight = 1, 
                    layerId = rwa@data$OBJECTID, 
                    group = "regions")
    }) #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")

      #subset regions shapefile by the clicked on polygons
      selectedReg <-rwa[rwa@data$OBJECTID == click$id,]


      #map clicked on polygons
      proxy %>% addPolygons(data = selectedReg,
                            fillColor = "red",
                            fillOpacity = 1,
                            weight = 1,
                            color = "black", 
                            stroke = T,
                            group = "selected",
                            # layerId = "selected")
                            layerId = selectedReg@data$OBJECTID)


      #remove polygon group that are clicked twice 
      if(click$group == "selected"){
        proxy %>% 
          clearGroup(group = "selected")
      } #END CONDITIONAL 

    }) #END OBSERVE EVENT

  }) #END SHINYAPP

在上面的例子中,每个点击的多边形都会变成红色。如果再次单击先前 selected 的红色多边形,每个红色多边形都会从地图中清除,留下初始的白色多边形渲染。

当我一次只处理一个多边形时,我可以通过使用字符串 layerId "selected"(在上面的代码中注释掉)来实现所需的 selecting/deselecting 效果,但是这样做删除了我 select 并同时突出显示多个多边形的能力。

我愿意接受任何和所有的建议!

答案就在layerIds。我不明白这些是如何应用于我的多边形和删除形状的——理解这是关键。这可能不是最优雅的解决方案,但它完成了工作!

在下面的代码中,卢旺达的初始地图渲染有一个 layerIdrwa@data$NAME_1,这是区域名称。您可以看到 label 也被设置为 rwa@data$NAME_1。所以在下图中,最左边的多边形被标记为 Iburengerazuba,它的属性在 NAME_1 列中。 此 layerId 为您在此初始地图渲染上的任何点击事件设置 click$id 因此,正如此多边形被标记为 Iburengerazuba,它的 click$id 也将是设置为 Iburengerazuba。 As stated in the Leaflet Shiny documentation,如果你有多个多边形,这需要是一个矢量化参数。如果你只需要 select 和 deselect 一个多边形(所以在这个例子中一次只有一个区域),你可以使用 layerId 字符串,正如我在我的问题中提到的(例如layerId = "selected")。

接下来是点击形状的 observeEvent,我想出了如何保存在地图上进行的所有点击事件(在这种情况下特别是点击 id)。我将它们保存在反应向量中,然后通过这些点击 ID 对我的 shapefile 进行子集化。该代码已被彻底注释,所以希望任何其他正在寻找相同解决方案的人都能弄清楚到底发生了什么。

最后一段代码(位于 if...else 条件语句中)可能是最令人困惑的。让我们先看看代码的 else 部分。 (注意:您的初始地图点击将触发此事件,因为首次点击无法满足 if 条件。)如果点击任何白色多边形,则会触发 addPolygons() 调用,将点击的多边形添加到具有不同样式的地图上(在本例中,它是红色的)。 这是在 leafletProxy 对象之上绘制一个完全不同的多边形!

删除红色单击多边形的关键是为这些多边形提供与初始地图渲染不同的layerId请注意,在上图中,白色多边形标记为 Iburengerazuba 现在标记为 3。这是因为第二个 addPolygons 调用中的 layerId 设置为 CC_1 而不是 NAME_1。因此,底层白色地图有一个 NAME_1 layerID,因此有 NAME_1 点击 id,而绘制在上面的任何红色点击多边形都有一个 CC_1 layerId,因此有 CC_1 点击ids.

if 声明指出,如果您的 click$id 已经存在于 clickedPolys 多边形中,则该形状将被删除。这有点令人困惑,所以再说一遍,仔细阅读每一行代码并尝试一下以真正理解它可能会有所帮助。

再次使用上面的示例,单击最左边的多边形会将 layerId Iburengerazuba 添加到 clickedIds$ids 向量中。此点击事件触发第二次地图绘制,以不同的样式在自身顶部绘制被点击的多边形,layerId 为 3(来自 CC_1 列)。我们想说的是,如果任何红色多边形被点击两次 (if(click$id %in% clickedPolys@data$CC_1)),它就算作 deselection,并且应该从地图中删除该多边形。因此,如果您单击 layerId 为 3 的红色最左边的多边形,则 clickedIds$ids 向量将由 Iburengerazuba3 组成。 clickedPolys多边形NAME_1列的Iburengerazuba对应CC_1列的3,触发if语句。调用 removeShape(layerId = click$id) 意味着删除对应于该 click$id 的形状。所以在这种情况下,clickedPolys 多边形的 CC_1 layerId 为 3.

请记住,每个 点击 ID,NAME_1CC_1 都被记录在您的 clickedIds$ids 向量中。该矢量正在对您的卢旺达 shapefile 进行子集化以映射所有单击的多边形,因此当您单击多边形时,clickedPolys 多边形正在动态更新(如果不是,请使用 print 调用来检查每一位代码对你有意义!)。删除任何双击的形状不足以正确绘制所有内容——您需要从 clickedIds$ids向量。我将每个 deselected CC_1 layerId 与其对应的 NAME_1 值匹配,并从 clickedIds$ids 向量中删除了这两个属性,以便将它们从 clickedPolys 中删除多边形。

瞧!现在您可以 select 和 deselect 任何您想要的多边形!

library(raster)
library(shiny)
library(leaflet)

#load shapefile
rwa <- getData("GADM", country = "RWA", level = 1)

shinyApp(
  ui = fluidPage(
    leafletOutput("map")
  ), 
  
  server <- function(input, output, session){
    
    #create empty vector to hold all click ids
    clickedIds <- reactiveValues(ids = vector())
    
    #initial map output
    output$map <- renderLeaflet({
      leaflet() %>% 
        addTiles() %>% 
        addPolygons(data = rwa, 
                    fillColor = "white", 
                    fillOpacity = 1, 
                    color = "black", 
                    stroke = T, 
                    weight = 1, 
                    layerId = rwa@data$NAME_1, 
                    group = "regions", 
                    label = rwa@data$NAME_1)
    }) #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 
      clickedIds$ids <- c(clickedIds$ids, click$id)
      
      #shapefile with all clicked polygons - original shapefile subsetted by all admin names from the click list
      clickedPolys <- rwa[rwa@data$NAME_1 %in% clickedIds$ids, ]
      
      #if the current click ID [from CC_1] exists in the clicked polygon (if it has been clicked twice)
      if(click$id %in% clickedPolys@data$CC_1){
        
        #define vector that subsets NAME that matches CC_1 click ID
        nameMatch <- clickedPolys@data$NAME_1[clickedPolys@data$CC_1 == click$id]
        
        #remove the current click$id AND its name match from the clickedPolys shapefile
        clickedIds$ids <- clickedIds$ids[!clickedIds$ids %in% click$id] 
        clickedIds$ids <- clickedIds$ids[!clickedIds$ids %in% nameMatch]
        
        #remove that highlighted polygon from the map
        proxy %>% removeShape(layerId = click$id)
        
      } else {
        
        #map highlighted polygons
        proxy %>% addPolygons(data = clickedPolys,
                              fillColor = "red",
                              fillOpacity = 1,
                              weight = 1,
                              color = "black",
                              stroke = T,
                              label = clickedPolys@data$CC_1, 
                              layerId = clickedPolys@data$CC_1)
      } #END CONDITIONAL
    }) #END OBSERVE EVENT
  }) #END SHINYAPP