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?
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)