问题描述
我想创建一个传单地图，您可以在其中选择多个多边形，这将更新闪亮应用中的 selectizeinput()。这将包括在 selectizeinput() 中移除选定的多边形时移除该多边形。
我稍微更改/更新了 the code from the answer here（使用 sf 而不是 sp 和更多 dplyr，我可以计算出基本 R 是什么）。
多边形可能可以使用与 observeEvent 相关联的 input$clicked_locations 进行更新，但不确定具体如何。
代码如下：
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 = "",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",layerId = clicked_polys$CNTY_ID)
# just to see
print(clicked_ids$ids)
# update
updateSelectizeInput(session,selected = clicked_ids$ids)
} #END CONDITIONAL
}) #END OBSERVE EVENT
}) #END SHINYAPP
这也发布在 here 中，您还可以在其中找到有效的答案（最初是 sp 数据集）中代码的编辑版本。 nc 数据集的此代码对我来说似乎相同，但似乎不起作用，尽管基于 selectizeinput() 更新多边形不在其中。
对此有什么想法吗？
解决方法
请参阅以下解决方法：
我在渲染地图和隐藏红色叠加层时添加所有多边形。此外，每个红色多边形都分配给它自己的组。单击相应的组，从而显示/隐藏多边形。
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",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 = "",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)
})
编辑：关于调整 this answer 的初始方法，您需要将 layerId 传递为 character 才能使事情再次运行：
proxy %>% removeShape(layerId = as.character(click$id))
proxy %>% addPolygons(data = clicked_polys,layerId = as.character(clicked_polys$CNTY_ID))
我提交了 issue regarding this。
但是，我仍然更喜欢上面的显示/隐藏方法，因为我猜它比添加和删除多边形更高效。