Search code examples
rshinyleafletmarkers

R Shiny with Leaflet - change color of marker after click


I am developing a Shiny app that shows a Leaflet map with markers. The markers are clickable and I collect the IDs of the clicked markers.

But I also want to change the color of a clicked marker. When the marker is blue it should change to a red marker and vice versa.

So far I have the code to keep track of the clicked markers and I can store the IDs in a table.

output$mymap <- renderLeaflet({
            leaflet() %>%
                addProviderTiles("OpenStreetMap", group = "OSM",
                         options = providerTileOptions(minZoom = 4, maxZoom = 20)) %>%
                addMarkers(data = points, lng = ~X, lat = ~Y, layerId = ~id, popup = ~paste(id))
        })
        
        
        d <- c()
        values <- reactiveValues(df = data.frame(photo_ids=d))

        newEntry <- observeEvent(input$mymap_marker_click,{
            clicked_id <- input$mymap_marker_click$id
            selected_photos <- values$df$photo_ids
            if( clicked_id %in% selected_photos ){
                selected_photos <- selected_photos[!selected_photos %in% clicked_id]
            } else {
                selected_photos <- c(selected_photos, clicked_id)
            }
            #d_new <- c(values$df$photo_ids,as.numeric(clicked_id))
            values$df <- data.frame(photo_ids=selected_photos)
            updateTextInput(inputId = "selected_photos", value = paste(unlist(values$df), collapse = ",") )
        })

But how can I set the style of the marker in the click event?

edit:

Reproducible example (clicked markers are tracked but their style does not change):

    library("shiny")
    library("sf")
    library("leaflet")
    library("rgeos")
    
    
    selected_photos <- c()
    
    
  getData <- function(){
    sf_poly <- "POLYGON ((7.207031 46.97463, 7.182312 46.89868, 7.267456 46.86864, 7.392426 46.85831, 7.529755 46.86864, 7.67807 46.90618, 7.683563 46.97557, 7.592926 47.03082, 7.371826 47.01584, 7.207031 46.97463))"
  
    sf_poly <- st_as_sf(readWKT(sf_poly))
  
    points <- st_as_sf(st_sample(sf_poly, 20))
    points$id <- 1:nrow(points)
    coords <- st_coordinates(points)
  
    df <- data.frame(st_drop_geometry(points), coords)
    return(df)
  }
    
    
    
    ui <- fluidPage(
      
      titlePanel("Leaflet Map"),
      
      sidebarLayout(
        
        sidebarPanel(
          textInput(inputId="selected_photos", label="Selected images", value = "", placeholder = NULL)
        ),
        
        mainPanel(
          leafletOutput("mymap")
        )
      )
    )
    
    
    server <- function(input, output, session) {
      #https://groups.google.com/g/shiny-discuss/c/LWk4ZYNhsSc
      points <- getData()
      
      output$mymap <- renderLeaflet({
        leaflet() %>%
          addProviderTiles("OpenStreetMap", group = "OSM") %>%
          addMarkers(data = points, lng = ~X, lat = ~Y, layerId = ~id)
      })
      
      
      d <- c()
      values <- reactiveValues(df = data.frame(photo_ids=d))
      
      newEntry <- observeEvent(input$mymap_marker_click,{
        clicked_id <- input$mymap_marker_click$id
        selected_photos <- values$df$photo_ids
        if( clicked_id %in% selected_photos ){
          selected_photos <- selected_photos[!selected_photos %in% clicked_id]
        } else {
          selected_photos <- c(selected_photos, clicked_id)
        }
        values$df <- data.frame(photo_ids=selected_photos)
        updateTextInput(inputId = "selected_photos", session = session, value = paste(unlist(values$df), collapse = ",") )
      })
      
      
      
    }
    
    
    shinyApp(ui, server)

Solution

  • We can use addAwesomeMarkers to customize the icon color as suggested in the docs and use leafletProxy to change it on click:

    library(shiny)
    library(sf)
    library(leaflet)
    library(geojsonsf)
    
    getData <- function(){
      poly <- '{"type":"FeatureCollection","features":[{"type":"Feature","properties":{},"geometry":{"type":"Polygon","coordinates":[[[7.207031249999999,46.97463048970666],[7.18231201171875,46.89867745059795],[7.267456054687499,46.86864162233212],[7.392425537109376,46.85831292242506],[7.529754638671874,46.86864162233212],[7.678070068359375,46.9061837801476],[7.683563232421874,46.97556750833867],[7.592926025390624,47.03082254778662],[7.371826171874999,47.01584377790821],[7.207031249999999,46.97463048970666]]]}}]}'
      
      sf_poly <- geojson_sf(poly)
      points <- st_as_sf(st_sample(sf_poly, 20))
      points$id <- 1:nrow(points)
      coords <- st_coordinates(points)
      
      df <- data.frame(st_drop_geometry(points), coords)
      return(df)
    }
    
    ui <- fluidPage(
      titlePanel("Leaflet Map"),
      sidebarLayout(
        sidebarPanel(
          textInput(inputId="selected_photos", label="Selected images", value = "", placeholder = NULL)
        ),
        mainPanel(
          leafletOutput("mymap")
        )
      )
    )
    
    server <- function(input, output, session) {
      #https://groups.google.com/g/shiny-discuss/c/LWk4ZYNhsSc
      points <- getData()
      points$clicked <- FALSE
      RV <- reactiveValues(points = points)
      
      icons <- awesomeIcons(
        icon = 'ios-close',
        iconColor = 'white',
        library = 'ion',
        markerColor = "blue"
      )
      
      output$mymap <- renderLeaflet({
        leaflet() %>%
          #addTiles() %>%
          addProviderTiles("OpenStreetMap", group = "OSM") %>%
          addAwesomeMarkers(data = points, lng = ~X, lat = ~Y, layerId = ~id, icon = icons)
      })
      
      myLeafletProxy <- leafletProxy(mapId = "mymap", session)
      
      observeEvent(input$mymap_marker_click,{
        clicked_point <- input$mymap_marker_click
        RV$points[points$id==clicked_point$id,]$clicked <- !(RV$points[points$id==clicked_point$id,]$clicked)
        
        updateTextInput(inputId = "selected_photos", value = paste(unlist(RV$points$id[which(RV$points$clicked)]), collapse = ", "))
        
        removeMarker(map = myLeafletProxy, layerId = clicked_point$id)
        addAwesomeMarkers(map = myLeafletProxy,
                          lng = clicked_point$lng,
                          lat = clicked_point$lat,
                          layerId = clicked_point$id,
                          icon = awesomeIcons(
                            icon = 'ios-close',
                            iconColor = 'white',
                            library = 'ion',
                            markerColor = ifelse(RV$points[clicked_point$id,]$clicked, yes = "red", no = "blue")
                          ))
      })
    }
    
    shinyApp(ui, server)
    

    result