Marker Mouse Click Event in R Leaflet for Shiny

Programatically trigger marker mouse click event in R leaflet for shiny

Solution using JS

After getting access to the Map object, you need to iterate over all the layers to find the marker with a specific id.

I modified the JS function you call with shinyjs to iterate over all the layers and fire the event click on the marker that matches the id. To avoid looking for the Map object every time, the Map object is retrieved after rendering using htmlwidgets::onRender function. As an alternative to shinyjs, you can use runjs to execute the function (not in code below).

library(shiny)
library(leaflet)
library(magrittr)
library(shinyjs)

# create js function that triggers a click on a marker selected by a row in a DT
jsCode <- 'shinyjs.markerClick = function(id) {
              map.eachLayer(function (layer) {
                if (layer.options.layerId == id) {
                  layer.fire("click");
                }
              })
           };'

df <- tibble::tibble(id = c(1,2,3,4,5),
                     label = c('One','Two','Three','Four','Five'),
                     lat = c(50,55,60,65,70), lng = c(0,5,-5,10,-10)
)

ui <- fluidPage(
  # new lines to enable shinyjs and import custom js function
  shinyjs::useShinyjs(),
  shinyjs::extendShinyjs(text = jsCode, functions = c('markerClick')),
  
  leaflet::leafletOutput('map'),
  DT::DTOutput('table'),
  shiny::actionButton('buttona',"Button A") # new button
)

server <- function(input, output, session) {
  
  output$map <- leaflet::renderLeaflet({
    m <- leaflet::leaflet(options = leaflet::leafletOptions(minZoom = 3,maxZoom = 10)) %>%
      leaflet::setView(lng = 10,lat = 60,zoom = 3) %>%
      leaflet::addProviderTiles(provider = leaflet::providers$Esri.OceanBasemap) %>%
      leaflet::addMarkers(data = df,
                          layerId = ~id,
                          group = 'group1',
                          label = ~label,
                          lat = ~lat,
                          lng = ~lng,
                          popup = ~paste("<h3>More Information</h3>",
                                         "<b>Title:</b>",label,sep =" "))
    
    # assign the leaflet object to variable 'map'
    m <- m %>% 
      htmlwidgets::onRender("
          function(el, x) {
            map = this;
          }"
      )                                         
    
  })
  output$table <- DT::renderDT(df,
                               selection = 'single',
                               rownames = FALSE,
                               editable = FALSE
  )
  
  # observer looking for datatable row selection and triggering js function
  observeEvent(input$table_rows_selected,{
    rowIndex <- input$table_rows_selected
    df$id[rowIndex]
    shinyjs::js$markerClick(df$id[rowIndex])
  })
  
  # observer looking for button click to trigger modal
  observeEvent(input$buttona,{
    showModal(
      modalDialog(title = "Test",
                  size = 'm',
                  h1("Test")
                  
      )
    ) 
  })
  
}

# Run the application 
shinyApp(ui = ui, server = server)

Solution using Leaflet proxy

Just add a new popup every time a user selects a row in the table. It is important to use the same layerId to automatically update a popup that could be already on the map. Also, since the popup is going to be placed on the marker lat and lng, it is necessary to adjust the relative position on pixels using offset.

library(shiny)
library(leaflet)

df <- tibble::tibble(id = c(1,2,3,4,5),
                     label = c('One','Two','Three','Four','Five'),
                     lat = c(50,55,60,65,70), lng = c(0,5,-5,10,-10)
)

ui <- fluidPage( 
  leaflet::leafletOutput('map'),
  DT::DTOutput('table')
)

server <- function(input, output, session) {
  
  output$map <- leaflet::renderLeaflet({
    m <- leaflet::leaflet(options = leaflet::leafletOptions(minZoom = 3,maxZoom = 10)) %>%
      leaflet::setView(lng = 10,lat = 60,zoom = 3) %>%
      leaflet::addProviderTiles(provider = leaflet::providers$Esri.OceanBasemap) %>%
      leaflet::addMarkers(data = df,
                          layerId = ~id,
                          group = 'group1',
                          label = ~label,
                          lat = ~lat,
                          lng = ~lng,
                          popup = ~paste("<h3>More Information</h3>",
                                         "<b>Title:</b>",label,sep =" "))
    
  })
  
  output$table <- DT::renderDT(df,
                               selection = 'single',
                               rownames = FALSE,
                               editable = FALSE
  )
  
  # observer looking for datatable row selection and use leaflet proxy to add a popup
  observeEvent(input$table_rows_selected,{
    rowIndex <- input$table_rows_selected
    df$id[rowIndex]
    proxy <- leafletProxy("map")
    addPopups(
      proxy,
      lng = df$lng[rowIndex],
      lat =df$lat[rowIndex],
      popup = paste("<h3>More Information</h3>",
                    "<b>Title:</b>",df$label[rowIndex],sep =" "),
      layerId = "popup",
      options  = popupOptions(offset = list (x = 0, y = -26))
    )
  })
}

shinyApp(ui = ui, server = server)

R Shiny with Leaflet - change color of marker after click

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)

Related Topics