Я хотел бы создать карту листовок, где вы можете выбрать несколько полигонов, и это обновит 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()
там нет.
Любые идеи по этому поводу?