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

Question

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

我能够管理的最好方法是选择多个多边形，为它们提供“已选择”的相同组 ID，然后在重新单击多边形时取消选择整个组。这是一些示例/可重现的代码：

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

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

当我一次只处理一个多边形时，我可以通过使用字符串 layerId “selected”（在上面的代码中注释掉）来实现所需的选择/取消选择效果，但是这样做会消除我选择和取消选择的能力同时突出显示多个多边形。

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

Answer 1

答案在于 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，如果你有多个多边形，这需要是一个矢量化参数。如果您只需要选择和取消选择一个多边形（因此在本例中一次只能选择一个区域），您可以使用layerId 字符串，正如我在问题中提到的那样（例如layerId = "selected"）。

接下来是observeEvent 用于您的形状点击。 Thanks to the help of user @John Paul，我想出了如何保存在地图上制作的所有点击事件（在这种情况下特别是点击 id）。我将它们保存在反应向量中，然后通过这些点击 ID 子集我的 shapefile。该代码的注释非常详尽，因此希望寻找相同解决方案的其他任何人都可以弄清楚到底发生了什么。

最后一段代码（包含在if...else 条件语句中）可能是最令人困惑的。让我们先看一下代码的else 部分。 （注意：您的初始地图单击将触发此事件，因为在第一次单击时无法满足 if 条件。）如果单击任何白色多边形，将触发 addPolygons() 调用，添加单击的多边形到地图上的不同样式（在这种情况下，它是红色的）。 这是在leafletProxy 对象上绘制一个完全不同的多边形！

移除点击的红色多边形的关键是为这些多边形赋予与初始地图渲染不同的layerId。请注意，在上图中，标记为 Iburengerazuba 的白色多边形现在被标记为如 3。这是因为第二个 addPolygons 调用中的 layerId 设置为 CC_1 INSTEAD OF NAME_1。因此，底层白色地图有一个 NAME_1 图层 ID，因此有 NAME_1 点击 ID，而任何绘制在其顶部的红色点击多边形都有一个 CC_1 图层 ID，因此有 CC_1 点击 ID。

if 语句指出，如果您的click$id 已存在于clickedPolys 多边形中，则此形状将被删除。这有点令人困惑，所以再一次，它可能有助于遍历每一行代码并玩弄它以真正理解。

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

请记住，每个点击 ID，NAME_1 和 CC_1 都记录在您的 clickedIds$ids 向量中。此向量将您的卢旺达 shapefile 设置为子集以映射所有单击的多边形，因此当您单击多边形时，clickedPolys 多边形正在动态更新（如果这对您没有意义，请使用 print 调用检查每一位代码！）。删除任何双击的形状并不足以正确绘制所有内容 --您需要从 clickedIds$ids 向量中删除取消选择的 layerId，包括 NAME_1 和 CC_1。我将每个取消选择的CC_1 layerId 与其对应的NAME_1 值匹配，并从clickedIds$ids 向量中删除了这两个属性，以便将它们从clickedPolys 多边形中删除。

瞧！现在您可以选择和取消选择您想要的任何多边形！

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