Is there a way to change styles twice (for double click and triple click) when selecting and deselecting polygons in leaflet/shiny?

Question

I am trying to build a leaflet map where users can click once on a polygon to indicate that it has low importance, twice to indicate medium importance and three times to indicate high importance. I want the first time the polygon is clicked to turn yellow, the second time its clicked it changes to orange and the third time it changes to red.

I've found these two posts to change to red once the polygon is initially selected, and then once it is double clicked to remove it.

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)

A copy of the code mentioned above:

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

Is this possible? Any help would be appreciated!

score 1 · Accepted Answer · answered Oct 18 '21 at 15:03

This is a possible solution using groups. I tried to make eveything simple and commented, but ask me if there is something unclear.

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)

Is there a way to save the map clicks to a data frame within the shiny app? — Brooke Gibbons, Oct 21 '21 at 07:28

Is there a way to change styles twice (for double click and triple click) when selecting and deselecting polygons in leaflet/shiny?

1 Answers1

Linked