r - 使用传单中的 map_click 选择多个项目,链接到闪亮应用程序 (R) 中的 selectizeInput()
问题描述
我想创建一个传单地图,您可以在其中选择多个多边形,这将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()
不在那里更新多边形。
对此有什么想法吗?
解决方案
请参阅以下解决方法:
我在渲染地图和隐藏红色叠加层时添加了所有多边形。此外,每个红色多边形都分配给它自己的组。单击相应的组,因此显示/隐藏多边形。
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",
label = "",
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)
})
编辑:关于您调整此答案的初始方法,您需要传递layerId
ascharacter
以使事情再次正常工作:
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))
我提出了一个关于这个的问题。
但是,我仍然更喜欢上面的显示/隐藏方法,因为我猜它比添加和删除多边形更高效。
推荐阅读
- html - 每侧的 CSS 图像放置
- node.js - 实施 GitHub OAuth 2.0 何时以及为何需要 Passport.js?
- sql - sql中如何连接四个表
- python - 如何从使用 selenium 中获取信息?
- python-3.x - 如何在python中将一个列表与多个列表进行比较以查看是否有任何匹配?
- node.js - 为什么我不能在同一条路线上使用 multer 两次?(Nodejs/Express)
- python - 如何将不和谐机器人命令限制为机器人所有者或管理员权限?
- google-drive-api - 通过 Google Docs API 下载 Google Doc 时,如何避免随着时间的推移重新下载相同的图像?
- javafx - JavaFX LineChart 正在剪裁系列图
- python - 如何在 QML 中创建 PyQT 注册类型的动态实例