rshinydtr-leafletcrosstalk

Communicate 2-ways between DT and leaflet


I have a Shiny app that contains a leaflet and a DT table. I'm using crosstalk so that if I click a row in the table, it highlights the respective point on the map. However, I'd like to have it work both ways - 1) highlighting a row highlights the map point, but also 2) clicking a map point highlights the respective row. Also - how would I control the aesthetics of the map points pre- and post-click? For example - I'd like to make the unselected points less transparent.

library(dplyr)
library(shiny)
library(leaflet)
library(DT)
library(crosstalk)

data <- data.frame(Lon = rnorm(10, -85, 2), Lat = rnorm(10, 40, 1), Group = rep(c("a", "b"), 5))

ui <- fluidPage(
  fluidRow(
    column(6, leafletOutput("Map")),
    column(6, DT::dataTableOutput("Table", width = "100%"))
  )
)

server <- function(input, output, session) {
  shared <- SharedData$new(data)

  output$Map <- renderLeaflet({
    sub <- shared
    leaflet(sub)  %>%
        addCircleMarkers(data = sub, lng = ~Lon, lat = ~Lat, ) %>% 
        addProviderTiles("Esri.WorldImagery", layerId = "basetile",
                options = providerTileOptions(opacity = 0.75)) 
      })

  output$Table <- DT::renderDataTable({
        shared}, 
    selection = "single", 
    options = list(autoWidth = TRUE, paging = FALSE), server = FALSE) # selection = "single"
}

shinyApp(ui, server)

Solution

  • You can use htmlwidgets onRender function to grab click events to the map. We then fetch the target e.latlng which is the longitude latitude of the clicked point. Then we can send this over to an observable shiny event which in turn highlights the corresponding row.
    I use e.originalEvent.target._leaflet_id to figure out, if the user clicked on a point. This will have the value 3 if the user just clicked on the map. But wait, there is more! We can grab click events on the table and highlight the leaflet map accordingly. In this case, I marked the selected dots in a flashy red and increased the alpha from unselected points so they are more visible.

    out

    if (!requireNamespace("pacman", quietly = TRUE)) install.packages("pacman")
    pacman::p_load(dplyr, shiny, leaflet, DT, crosstalk, htmlwidgets)
    
    set.seed(123)
    data <- data.frame(
      id = 1:10,  # Unique ID to track selection
      Lon = rnorm(10, -85, 2),
      Lat = rnorm(10, 40, 1),
      Group = rep(c("a", "b"), 5)
    )
    
    ui <- fluidPage(
      fluidRow(
        column(6, leafletOutput("Map")),
        column(6, DT::dataTableOutput("Table", width = "100%"))
      )
    )
    
    server <- function(input, output, session) {
      shared <- SharedData$new(data, key = ~id)  # Use `key` for selection tracking
      
      output$Map <- renderLeaflet({
        leaflet(shared) %>%
          addProviderTiles("Esri.WorldImagery", layerId = "basetile",
                           options = providerTileOptions(opacity = 0.75)) %>%
          addCircleMarkers(
            lng = ~Lon, lat = ~Lat,
            layerId = ~id,  # Unique ID for selection tracking
            color = "blue",
            fillColor = "blue",
            fillOpacity = 0.7, opacity = 1,
            radius = 6,
            group = "points"
          ) %>%
          htmlwidgets::onRender("
            function(el, x) {
              var map = this;
              
              // Listen for clicks on the markers
              map.on('click', function(e) {
                // Check if the clicked layer is a CircleMarker
                var clicked = e.originalEvent.target._leaflet_id;
                if (clicked !== 3) {  // if 3 then user clicked the map
                  //console.log(e);
                  // Update the table selection
                  Shiny.setInputValue('map_click', e.latlng, {priority: 'event'}); // get lng /lat from clicked target
                }
              });
            }
          ")
      })
      
      output$Table <- DT::renderDataTable({
        shared
      }, selection = "single", options = list(autoWidth = TRUE, paging = FALSE), server = FALSE)
      
      # Respond to table selection
      observeEvent(input$Table_rows_selected, {
        selected_row <- input$Table_rows_selected  # Use the selected rows from the table directly
        # Update map with selected row(s)
        leafletProxy("Map") %>%
          clearGroup("points") %>%
          addCircleMarkers(
            data = shared,
            lng = ~Lon, lat = ~Lat,
            layerId = ~id,
            color = ~ifelse(id %in% selected_row, "blue", "blue"),
            fillColor = ~ifelse(id %in% selected_row, "red", "blue"),
            fillOpacity = ~ifelse(id %in% selected_row, 0.8, 0.3),
            radius = 6,
            group = "points"
          )
      })
      
      # Respond to map clicks and update table
      observeEvent(input$map_click, {
        lat_clicked <- input$map_click$lat
        lng_clicked <- input$map_click$lng
        
        # Calculate Euclidean distance (or you can use Haversine formula for geographic accuracy)
        distances <- sqrt((data$Lat - lat_clicked)^2 + (data$Lon - lng_clicked)^2)
        
        selected_index <- which.min(distances) # find the closest
        
        # Select the closest row in the table
        if (length(selected_index) > 0) {
          dataTableProxy("Table") %>%
            selectRows(selected_index)
        }
      })
    }
    
    shinyApp(ui, server)