Leaflet in R - Highlight Polygon on Click

Question

Using the leaflet package in R, I'm looking to highlight / change fillColor of polygon upon click instead of hover.

This is in a Shiny app, so I have access to the reactive values, and knowledge of leafletProxy, but haven't been able to get anything working. I can change the selected polygon to a different color, but it stays that way when a different polygon is clicked - I need it to change back to its original fillColor after another polygon has been selected.

Here's a map with reproducible code:

library(rnaturalearth)
library(rnaturalearthdata)
library(leaflet)
library(tidyverse)
library(sf)

world <- ne_countries(scale = "medium", returnclass = "sf")

africa <- world %>% filter(continent == "Africa")

bbox <- st_bbox(africa$geometry) %>% 
  as.vector()

leaflet(data = africa) %>%
  setView(bbox[1], bbox[2],
        bbox[3], bbox[4]) %>% 
  addPolygons(fillColor = "#D3D3D3",
              color = "black",
              weight = 1,
              opacity = 1.0,
              fillOpacity = 1.0,
              highlightOptions = highlightOptions(fillColor = "yellow", weight = 2,
                                                  bringToFront = TRUE),
              layerId = ~geounit,
              label = ~geounit,
              labelOptions = labelOptions(
                style = list("font-weight" = "normal",
                             padding = "3px 8px",
                             textsize = "15px",
                             direction = "auto" )
              )
  )%>%
  fitBounds(bbox[1], bbox[2], #xmin, ymin, 
            bbox[3], bbox[4]) %>% # xmax, ymax
  setMaxBounds(bbox[1], bbox[2],
               bbox[3], bbox[4])

Answer 1

all credits to the source of this solution go to: https://gist.github.com/cybernar/a3cf262301e4cce3a6105ccf2e0398cc

store in in a file named app.R and run...

library(tidyverse)
library(shiny)
library(sf)
library(leaflet)
library(rnaturalearth)
library(rnaturalearthdata)

#data(africa)
world <- ne_countries(scale = "medium", returnclass = "sf")

africa <- world %>% filter(continent == "Africa") %>%
  # add rownumber
  dplyr::mutate(id = row_number()) %>%
  sf::st_transform(4326)
  

bbox <- st_bbox(africa$geometry) %>% 
  as.vector()

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("mymap", width = "100%", height = "100%")
  )

server <- function(input, output, session) {
  
  rv <- reactiveValues()
  rv$selected <- NULL
  
  output$mymap <- renderLeaflet({
    hl_opts <- highlightOptions(
      color = "#CC0000", weight = 3, bringToFront = TRUE)
    leaflet() %>% addTiles() %>% 
      addPolygons(
        layerId = ~id,
        group = "countries",
        data = africa,
        label = ~name,
        fillColor = "#FCFFA4",
        weight = 1,
        color = "#666666",
        opacity = 0.4,
        fillOpacity = 0.8,
        highlightOptions = hl_opts)
  })
  
  output$click_on_shape <- renderPrint({
    input$mymap_shape_click
  })

  observeEvent(input$mymap_click, {
    new_selected <- req(input$mymap_shape_click)
    isolate(old_selected <- rv$selected)
    if (is.null(old_selected) || new_selected$.nonce != old_selected$.nonce) {
      validate(
        need(new_selected$group!="selection", message=FALSE)
      )
      rv$selected <- new_selected
      i <- which(africa$id==new_selected$id) 
      africa_filtered <- africa[i,]
      leafletProxy("mymap") %>%
        clearGroup("selection") %>%
        addPolygons(
          layerId = ~id,
          group = "selection",
          data = africa_filtered,
          fillColor = "cyan",
          weight = 1.2,
          color = "#666666",
          opacity = 0.4,
          fillOpacity = 0.8)
    } else {
      rv$selected <- NULL
      leafletProxy("mymap") %>%
        clearGroup("selection")
    }
  })
  
}

shinyApp(ui, server)