My question is identical to this one: Trigger marker mouse click event in R leaflet for shiny but I don't have enough rep to add a comment, and the edit queue is 'full' so I can't add my thoughts to the original question. Not sure if this goes against community rules/best practice, please remove if so! Apologies for the long winded description below but I think I might be close to a solution that a javascript or shiny guru could fix in no time! Or, I'm barking up the wrong tree completely. Thanks for reading!
Here's a min example app as a base for adding this functionality:
library(shiny)
library(leaflet)
library(magrittr)
library(shinyjs)
# create js function that triggers a click on a button 'buttona'
jsCode <- 'shinyjs.buttonClick = (function() {
$("#buttona").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('buttonClick')),
leaflet::leafletOutput('map'),
DT::DTOutput('table'),
shiny::actionButton('buttona',"Button A") # new button
)
server <- function(input, output, session) {
output$map <- leaflet::renderLeaflet({
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 triggering js function
observeEvent(input$table_rows_selected,{
shinyjs::js$buttonClick()
})
# 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)
I have been able to successfully use the shinyjs package to create similar funtionality with a button (see example app above), but when I try to do the same thing for the markers I just don't have the js knowledge to find the right element. By browsing in the js console in chrome I am able to find them manually, but they are within an iframe which I don't know how to programatically target, plus there is a random string in the location e.g. jQuery351022343796258432992.
Using manual location via chrome js console (I need to use the 'Elements' tab to select the #document within the iframe before this works) I can trigger the click event I want with the following lines:
var mymap = document.getElementsByClassName('leaflet');
var els = mymap.map.jQuery351022343796258432992.leafletMap.layerManager._byGroup.group1;
els[0].fire('click'); //note this is the leaflet.js to trigger a marker click event
There might be something in using shinywidgets::onRender as per the leaflet documentation at the bottom of this page https://rstudio.github.io/leaflet/morefeatures.html, but I don't know exactly how to implement it in this scenario.
Thanks again for reading!
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)
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)