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

Lau*_*ren 7 r selection leaflet shiny

在我正在研究的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
Run Code Online (Sandbox Code Playgroud)

在上面的示例中,每个单击的多边形都变为红色.如果再次单击先前选择的红色多边形,则会从地图中清除每个红色多边形,从而保留初始的白色多边形渲染.

当我通过使用字符串layerId"selected"(在上面的代码中注释)一次只使用一个多边形时,我可以完成所需的选择/取消选择效果,但这样做会消除我选择和突出显示多个多边形的能力同时.

我愿意接受任何建议!

Lau*_*ren 6

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

在下面的代码,卢旺达初始地图呈现具有layerIdrwa@data$NAME_1,这是该区域的名称.你可以看到这个label也被设置为rwa@data$NAME_1.因此,在下图中,最左边的多边形标记为Iburengerazuba,其属性在NAME_1列中.此layerId click$id为您在此初始地图渲染上的任何点击事件设置.因此,就像这个多边形标记为Iburengerazuba一样,它click$id也将被设置为Iburengerazuba.如Leaflet Shiny文档中所述,如果您有多个多边形,则需要使用矢量化参数.如果你只需要选择和取消选择一个多边形(在这个例子中一次只有一个区域),你可以使用一个layerId字符串,就像我在我的问题中提到的那样(例如layerId = "selected").

在此输入图像描述

接下来是observeEvent你的形状点击.感谢用户@John Paul的帮助,我想出了如何在地图上保存所有点击事件(特别是在这种情况下点击ID).我将它们保存在反应向量中,然后通过这些点击ID对我的shapefile进行子集化.这段代码得到了非常全面的评论,所以希望其他任何寻找同样解决方案的人都可以确切地知道发生了什么.

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

在此输入图像描述

删除红色单击多边形的关键是使这些多边形layerId与初始地图渲染不同.请注意,在上图中,标记为Iburengerazuba的白色多边形现在标记为3.这是因为layerId第二个addPolygons调用中的白色多边形设置为CCA_1INSTEAD OF NAME_1.因此,底层白色地图具有NAME_1 layerID,因此NAME_1点击了ID,而在其上方绘制的任何红色点击多边形都具有CCA_1 layerId,因此CCA_1点击了ID.

if声明指出,如果你click$id在已经存在clickedPolys的多边形,该形状被删除.这有点令人困惑,所以再次,它可能有助于遍历每行代码并玩它来真正理解.

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

请这种心态的每个点击ID,都NAME_1CCA_1被记录在您的clickedIds$ids载体.此向量是对您的卢旺达shapefile进行子集化以映射所有单击的多边形,因此当您单击多边形时,clickedPolys多边形将动态更新(print如果对您没有意义,则使用调用来检查每一段代码!).删除任何双击形状不足以正确绘制所有内容 - 您需要从clickedIds$ids矢量中删除取消选择的图层ID,包括NAME_1和CCA_1.我将每个取消选择的值CCA_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 CCA_1] exists in the clicked polygon (if it has been clicked twice)
      if(click$id %in% clickedPolys@data$CCA_1){

        #define vector that subsets NAME that matches CCA_1 click ID
        nameMatch <- clickedPolys@data$NAME_1[clickedPolys@data$CCA_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$CCA_1, 
                              layerId = clickedPolys@data$CCA_1)
      } #END CONDITIONAL
    }) #END OBSERVE EVENT
  }) #END SHINYAPP
Run Code Online (Sandbox Code Playgroud)