在leaflet/shiny中选择和取消选择多边形时，有没有办法更改样式两次(双击和三次单击)？
在leaflet/shiny中选择和取消选择多边形时，有没有办法更改样式两次(双击和三次单击)？
提问于 2021-10-18 07:39:36
我正在尝试构建一个叶地图，用户可以在其中单击一次多边形来表示它的重要性较低，两次表示中等重要性，三次表示高度重要性。我想第一次点击多边形变成黄色，第二次点击它变成橙色，第三次点击变成红色。
我发现这两个帖子一旦多边形最初被选中，就会变成红色，然后双击它就会删除它。
Changing styles when selecting and deselecting multiple polygons with Leaflet/Shiny
Select multiple items using map_click in leaflet, linked to selectizeInput() in shiny app (R)
上面提到的代码的副本：
library(raster)
library(shiny)
library(leaflet)
#load shapefile
rwa <- getData("GADM", country = "RWA", level = 1)
shinyApp(
ui = fluidPage(
leafletOutput("map")
),
server <- function(input, output, session){
#create empty vector to hold all click ids
clickedIds <- reactiveValues(ids = vector())
#initial map output
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data = rwa,
fillColor = "white",
fillOpacity = 1,
color = "black",
stroke = T,
weight = 1,
layerId = rwa@data$NAME_1,
group = "regions",
label = rwa@data$NAME_1)
}) #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
clickedIds$ids <- c(clickedIds$ids, click$id)
#shapefile with all clicked polygons - original shapefile subsetted by all admin names from the click list
clickedPolys <- rwa[rwa@data$NAME_1 %in% clickedIds$ids, ]
#if the current click ID [from CC_1] exists in the clicked polygon (if it has been clicked twice)
if(click$id %in% clickedPolys@data$CC_1){
#define vector that subsets NAME that matches CC_1 click ID
nameMatch <- clickedPolys@data$NAME_1[clickedPolys@data$CC_1 == click$id]
#remove the current click$id AND its name match from the clickedPolys shapefile
clickedIds$ids <- clickedIds$ids[!clickedIds$ids %in% click$id]
clickedIds$ids <- clickedIds$ids[!clickedIds$ids %in% nameMatch]
#remove that highlighted polygon from the map
proxy %>% removeShape(layerId = click$id)
} else {
#map highlighted polygons
proxy %>% addPolygons(data = clickedPolys,
fillColor = "red",
fillOpacity = 1,
weight = 1,
color = "black",
stroke = T,
label = clickedPolys@data$CC_1,
layerId = clickedPolys@data$CC_1)
} #END CONDITIONAL
}) #END OBSERVE EVENT
}) #END SHINYAPP这个是可能的吗？任何帮助都将不胜感激！
回答 1
Stack Overflow用户
回答已采纳
发布于 2021-10-18 15:03:20
这是使用组的一种可能的解决方案。我试着让每件事都变得简单并发表评论，但问我是否有什么不清楚的地方。
library(shiny)
library(leaflet)
## create two square polygons
Sr1 <- Polygon(cbind(c(1, 2, 2, 1, 1), c(1, 1, 2, 2, 1)))
Sr2 <- Polygon(cbind(c(2, 3, 3, 2, 2), c(1, 1, 2, 2, 1)))
Srs1 <- Polygons(list(Sr1), "s1")
Srs2 <- Polygons(list(Sr2), "s2")
SpP <- SpatialPolygons(list(Srs1, Srs2), 1:2)
ui <- fluidPage(
leafletOutput("map")
)
change_color <- function(map, id_to_remove, data, colour, new_group){
leafletProxy(map) %>%
removeShape(id_to_remove) %>% # remove previous occurrence
addPolygons(
data = data,
label = data$display,
layerId = data$ID,
group = new_group, # change group
fillColor = colour)
}
server <- function(input,output,session){
## Polygon data
rv <- reactiveValues(
df = SpatialPolygonsDataFrame(SpP, data = data.frame(
ID = c("1", "2"),
display = c("1", "1")
), match.ID = FALSE)
)
# initialization
output$map <- renderLeaflet({
leaflet(options = leafletOptions( zoomControl = FALSE, minZoom = 6.2, maxZoom = 6.2, dragging = FALSE))
})
observe({
data <- rv$df
leafletProxy("map") %>%
addPolygons(
data = data,
label = data$display,
layerId = data$ID,
group = "unclicked_poly")
})
#first click
observeEvent(input$map_shape_click, {
# execute only if the polygon has never been clicked
req(input$map_shape_click$group == "unclicked_poly")
# filter data
data <- rv$df[rv$df$ID==input$map_shape_click$id,]
change_color(map = "map",
id_to_remove = input$map_shape_click$id,
data = data,
colour = "yellow",
new_group = "clicked1_poly")
})
#second click
observeEvent(input$map_shape_click, {
# execute only if the polygon has been clicked once
req(input$map_shape_click$group == "clicked1_poly")
data <- rv$df[rv$df$ID==input$map_shape_click$id,]
change_color(map = "map",
id_to_remove = input$map_shape_click$id,
data = data,
colour = "orange",
new_group = "clicked2_poly")
})
#third click
observeEvent(input$map_shape_click, {
req(input$map_shape_click$group == "clicked2_poly")
# filter data
data <- rv$df[rv$df$ID==input$map_shape_click$id,]
change_color(map = "map",
id_to_remove = input$map_shape_click$id,
data = data,
colour = "red",
new_group = "clicked3_poly")
})
#fourth click : back to normal ?
observeEvent(input$map_shape_click, {
req(input$map_shape_click$group == "clicked3_poly")
data <- rv$df[rv$df$ID==input$map_shape_click$id,]
# back to normal
leafletProxy("map") %>%
removeShape(input$map_shape_click$id) %>% # remove previous occurrence
addPolygons(
data = data,
label = as.character(data$display),
layerId = data$ID,
group = "unclicked_poly") # back to initialize group
})
}
shinyApp(ui, server)页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/69612363
复制相关文章
相似问题
腾讯云开发者
