Click-on ability on leaflet heatmap

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