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

时间:2016-12-12 15:52:28

标签: r shiny leaflet selection

在我正在处理的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”(在上面的代码中注释掉)一次只处理一个多边形时,我可以完成所需的选择/取消选择效果,但这样做会消除我选择和选择的能力。同时突出显示多个多边形。

我愿意接受任何建议!

1 个答案:

答案 0 :(得分:5)

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

在下面的代码中,卢旺达的初始地图呈现具有layerId rwa@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") 。

enter image description here

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

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

enter image description here

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

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

再次使用上面的示例,单击最左边的多边形会将layerId Iburengerazuba添加到clickedIds$ids向量。此单击事件触发第二个地图绘制,以不同的样式绘制单击的多边形,其中layerId为3(来自CCA_1列)。我们想说,如果点击两次红色多边形(if(click$id %in% clickedPolys@data$CCA_1)),它将被视为取消选择,并且应该从地图中删除该多边形。因此,如果单击红色最左边的多边形,layerId为3,则clickedIds$ids向量将由Iburengerazuba3组成。 NAME_1多边形的clickedPolys列中的Iburengerazuba对应CCA_1列中的3,触发if语句。调用removeShape(layerId = click$id)表示删除与单击$ id对应的形状。因此,在这种情况下,clickedPolys多边形的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