我想创建一个传单Map,你可以选择多个多边形,这将更新一个闪亮的应用程序中的selectizeInput()
。这将包括删除选定的多边形,当它在selectizeInput()
中删除。
我稍微修改/更新了the code from the answer here(使用sf代替sp,并使用更多的dplyr,这样我就可以计算出基本r是什么)。
这些多边形可能会使用与input$clicked_locations
绑定的observeEvent
进行更新,但不确定具体如何更新。
下面是代码:
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
这也是张贴here在那里你也可以找到编辑版本的代码从答案(原来的sp
数据集),这工作.这个代码的nc
数据集似乎是相同的,但似乎不工作,虽然更新多边形的基础上selectizeInput()
是不是在那里.
有什么想法吗?
1条答案
按热度按时间py49o6xq1#
请参阅以下解决方法:
我在渲染Map时添加了所有的多边形,并隐藏了红色的覆盖层。此外,每个红色的多边形都被分配到了自己的组中。单击相应的组,多边形就会显示/隐藏。
**编辑:**考虑到您最初采用this answer的方法,您需要将
layerId
作为character
传递以使其再次工作:我提交了一份issue regarding this。
然而,我仍然更喜欢上面的显示/隐藏方法,因为我想它比添加和删除多边形更有性能。