首页
学习
活动
专区
圈层
工具
发布
首页
学习
活动
专区
圈层
工具
MCP广场
社区首页 >问答首页 >在leaflet/shiny中选择和取消选择多边形时,有没有办法更改样式两次(双击和三次单击)?

在leaflet/shiny中选择和取消选择多边形时,有没有办法更改样式两次(双击和三次单击)?
EN

Stack Overflow用户
提问于 2021-10-18 07:39:36
回答 1查看 114关注 0票数 2

我正在尝试构建一个叶地图,用户可以在其中单击一次多边形来表示它的重要性较低,两次表示中等重要性,三次表示高度重要性。我想第一次点击多边形变成黄色,第二次点击它变成橙色,第三次点击变成红色。

我发现这两个帖子一旦多边形最初被选中,就会变成红色,然后双击它就会删除它。

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)

上面提到的代码的副本:

代码语言:javascript
运行
复制
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

这个是可能的吗?任何帮助都将不胜感激!

EN

回答 1

Stack Overflow用户

回答已采纳

发布于 2021-10-18 15:03:20

这是使用组的一种可能的解决方案。我试着让每件事都变得简单并发表评论,但问我是否有什么不清楚的地方。

代码语言:javascript
运行
复制
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)
票数 1
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/69612363

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档