使用传单中的 map_click 选择多个项目，链接到闪亮应用程序 (R) 中的 selectizeInput()
wil*_*031 8 r leaflet shiny r-leaflet r-sf
我想创建一个传单地图，您可以在其中选择多个多边形，这将selectizeInput()在一个闪亮的应用程序中更新。这将包括删除选定的多边形（当它在selectizeInput().
我稍微更改/更新了此处答案中的代码（使用 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 = "",
choices = nc$NAME,
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",
fillOpacity = 0.5,
weight = 1,
color = "black",
stroke = TRUE,
layerId = clicked_polys$CNTY_ID)
# just to see
print(clicked_ids$ids)
# update
updateSelectizeInput(session,
inputId = "clicked_locations",
label = "",
choices = nc$NAME,
selected = clicked_ids$ids)
} #END CONDITIONAL
}) #END OBSERVE EVENT
}) #END SHINYAPP
这也发布在这里，您还可以从答案（最初是一个sp数据集）中找到代码的编辑版本，该版本有效。数据集的代码对nc我来说似乎是相同的，但似乎不起作用，尽管根据selectizeInput()不在那里更新多边形。
对此有什么想法吗？
ism*_*gal 15
请参阅以下解决方法：
我在渲染地图时添加所有多边形并隐藏红色覆盖层。此外，每个红色多边形都被分配给它自己的组。单击相应的组后，多边形就会显示/隐藏。
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",
fillOpacity = 0.5,
weight = 1,
color = "black",
stroke = TRUE,
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",
choices = nc$NAME,
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)
})
编辑：关于您适应此答案的初始方法，您需要传递 aslayerId以character使事情再次工作：
proxy %>% removeShape(layerId = as.character(click$id))
proxy %>% addPolygons(data = clicked_polys,
fillColor = "red",
fillOpacity = 0.5,
weight = 1,
color = "black",
stroke = TRUE,
layerId = as.character(clicked_polys$CNTY_ID))
但是，我仍然更喜欢上面的显示/隐藏方法，因为我认为它比添加和删除多边形的性能更高。