Click-on ability on leaflet heatmap - r

Question

I have a shiny app which displayes a leaflet heatmap. I would like to know if is possible to click on a certain point of the map and get the relative row(s) of the dataframe in a data table below.
library(shiny)
library(DT)
library(leaflet)
library(leaflet.extras)
# ui object
ui <- fluidPage(
titlePanel(p("Spatial app", style = "color:#3474A7")),
sidebarLayout(
sidebarPanel(
),
mainPanel(
leafletOutput("map"),
tableOutput("myTable")
)
)
)
# server()
server <- function(input, output, session) {
data <- reactiveValues(clickedMarker=NULL)
output$map<-renderLeaflet({
leaflet(quakes) %>%
addProviderTiles(providers$CartoDB.DarkMatter) %>%
setView( 178, -20, 5 ) %>%
addHeatmap(
lng = ~long, lat = ~lat, intensity = ~mag,
blur = 20, max = 0.05, radius = 15
) %>%
addCircleMarkers(lng = quakes$long, lat = quakes$lat, layerId = quakes$depth,
fillOpacity = 0, weight = 0,
popup = paste("Depth:", quakes$depth, "<br>",
"Stations:", quakes$stations),
labelOptions = labelOptions(noHide = TRUE))
})
# observe the marker click info and print to console when it is changed.
observeEvent(input$map_marker_click,{
print("observed map_marker_click")
data$clickedMarker <- input$map_marker_click
print(data$clickedMarker)
output$myTable <- renderTable({
return(
subset(quakes,depth == data$clickedMarker$depth)
)
})
})
}
# shinyApp()
shinyApp(ui = ui, server = server)

Answer 1

As update to my comment, I think the issue is that when you are trying to subset the dataset at the end, the rows you trying to match with are actually $id and not $depth - I think this is because when you call layerId = quakes$depth it creates an id to match on.
I think this does what you want:
library(shiny)
library(DT)
library(leaflet)
library(leaflet.extras)
# ui object
ui <- fluidPage(
titlePanel(p("Spatial app", style = "color:#3474A7")),
sidebarLayout(
sidebarPanel(
),
mainPanel(
leafletOutput("map"),
tableOutput("myTable")
)
)
)
# server()
server <- function(input, output, session) {
data <- reactiveValues(clickedMarker=NULL)
output$map<-renderLeaflet({
leaflet(quakes) %>%
addProviderTiles(providers$CartoDB.DarkMatter) %>%
setView( 178, -20, 5 ) %>%
addHeatmap(
lng = ~long, lat = ~lat, intensity = ~mag,
blur = 20, max = 0.05, radius = 15
) %>%
addCircleMarkers(lng = quakes$long, lat = quakes$lat, layerId = quakes$depth,
fillOpacity = 0, weight = 0,
popup = paste("Depth:", quakes$depth, "<br>",
"Stations:", quakes$stations),
labelOptions = labelOptions(noHide = TRUE))
})
# observe the marker click info and print to console when it is changed.
observeEvent(input$map_marker_click,{
print("observed map_marker_click")
data$clickedMarker <- input$map_marker_click
print(data$clickedMarker)
output$myTable <- renderTable({
return(
subset(quakes, depth == data$clickedMarker$id)
)
})
})
}
# shinyApp()
shinyApp(ui = ui, server = server)
giving:
If you check the console output you will see the id subsetted (not depth):
[1] "observed map_marker_click"
$id
[1] 46
$.nonce
[1] 0.3895379
$lat
[1] -13.66
$lng
[1] 172.23