R leaflet highlight options

Question

I am highlighting a line on R leaflet using the following command

library(leaflet)
m = leaflet() %>% addTiles(group = "OpenStreetMap")

x <- c(1,5,4,8)
y <- c(1,3,4,7)
data = sp::SpatialLines(list(sp::Lines(sp::Line(cbind(x,y)), ID="a")))

addPolylines(smoothFactor = 0.4, map = m, data=data, opacity = 0.3, weight = 2, color = "black", label = "text", popup = "text1", highlightOptions = highlightOptions(bringToFront = TRUE, opacity = 1, weight = 5, sendToBack = FALSE, color = "white"))

Is there a way to ensure that the line stays white until I click somewhere else (either on another line or on somewhere else on the map)?

Answer 1

The following example shows a similar behaviour. You can click the lines and highlight them, and when you click again on them you de-select them.

Actually, when you hover over the lines, you will see that the highlightcolor changes when clicked/unclicked, as I actually duplicate the original line and remove that duplicate again on a second click.

Maybe its helpful for your task. You could also include a listener for a general map-click in leaflet with input$MAPID_click, but it will also trigger when a layer is clicked.

.

library(shiny)
library(leaflet)

## DATA
x <- c(1,5,4,8)
y <- c(1,3,4,7)
data = sp::SpatialLines(list(
  sp::Lines(sp::Line(cbind(x,y)), ID="a"),
  sp::Lines(sp::Line(cbind(rev(x)*1.1,y)), ID="b")), 
  CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs"))

data = SpatialLinesDataFrame(data, data = data.frame(
  id = 1:length(data)), match.ID = F)

data$id_2 <- c("a","b")


## UI
ui = fluidPage(
  leafletOutput("map")
)

## SERVER
server <- shinyServer(function(input, output, session) {

  polylines <- reactiveValues(geom = data)
  clicklist <- reactiveValues(ids = vector())

  output$map <- renderLeaflet({

    mapl <- leaflet(options = leafletOptions(doubleClickZoom= FALSE)) %>% 
      addTiles() %>% 
      addPolylines(data = polylines$geom, smoothFactor = 10, opacity = 1,
                   layerId = as.character(polylines$geom$id_2),
                   color = "blue",
                   highlightOptions = highlightOptions(color = "white",
                                      weight = 5, bringToFront = F, opacity = 1)
                   )
    mapl
  })

  observeEvent(input$map_shape_click, {

    # Leaflet Proxy
    proxy <- leafletProxy("map")

    # Get Shape Input Click
    click <- input$map_shape_click

    # Store click IDS in reactiveValue
    clicklist$ids <- c(clicklist$ids, click$id)

    # Filter Lines based on ID_2 in Stored Clicks
    sel_lines <- polylines$geom[as.character(polylines$geom$id_2) %in% clicklist$ids, ]

    # If Clicked-ID is already known
    if (click$id %in% sel_lines$id) {

      # Get ID_2 of clicked line
      nameMatch <- as.character(sel_lines@data$id_2)[as.character(sel_lines@data$id) == click$id]

      ## Filter Stored clicks for matching ID_2 in actual click
      clicklist$ids <- clicklist$ids[!clicklist$ids %in% click$id]

      ## Remove ID_2 from Stored Clicks
      clicklist$ids <- clicklist$ids[!clicklist$ids %in% nameMatch]

      # Remove layer based on clicked-ID
      proxy %>% removeShape(layerId = click$id)

    } else { 

      # Add Filtered Lines
      proxy %>% addPolylines(data = sel_lines, smoothFactor = 10,
                             layerId = as.character(sel_lines@data$id),
                             color="red", weight=5,opacity=1, 
                             highlightOptions = highlightOptions(color = "green",
                                                                 weight = 5, bringToFront = F, opacity = 1))
    }

  })
})

shinyApp(ui, server)