responsive heatmap with crosstalk and leaflet in R

Question

I want to make a map with points and a responsive heatmap using crosstalk in R. Like this:

library(crosstalk)
library(leaflet)
library(DT)

# Wrap data frame in SharedData
sd <- SharedData$new(quakes[sample(nrow(quakes), 10),])

bscols(
  # Create a filter input
  filter_slider("mag", "Magnitude", sd, column=~mag, step=0.1, width=250),
  leaflet(sd) %>% addTiles() %>% addMarkers() %>% addHeatmap())
)

But, as can be observed after running the code, this way doesn't get the responsive effect on the heatmap when filtering

How can I achieve the effect?

Jumble Jumble · Accepted Answer · 2020-10-03T12:28:28

This could be easily done with Shiny. However, if you really wan't to use crosstalk, then you would have to add some javascript to redraw the heat map every time the markers are changed as crosstalk for some reason can't seem to do this.

A working example can be found here: https://rpubs.com/Jumble/r_crosstalk_leaflet_heatmap_update

Below is the code which produced this:

library(crosstalk)
library(leaflet)
library(leaflet.extras)
library(dplyr)

# Wrap data frame in SharedData
sd <- SharedData$new(quakes[sample(nrow(quakes), 10),])

bscols(widths=c(3,9),
  # Create a filter input
  filter_slider("mag", "Magnitude", sd, column=~mag, step=0.1),
  leaflet(sd) %>% 
    addTiles() %>% 
    addMarkers() %>% 
    addHeatmap(layerId="heatmap") %>%
    removeHeatmap("heatmap") %>%
    htmlwidgets::onRender("
      function(el,x){
        var myMap = this;
        var coord_state;
        var coords;
        
        function get_markers(){
          coord_state = [];
          myMap.eachLayer(function(layer){
            if (typeof layer.options.lat != 'undefined'){
              coord_state.push([layer.options.lat, layer.options.lng, 0.5]);
            }
          })
          return(coord_state)
        }
        
        function update_layer(){
          coords = get_markers()
          heat1.setLatLngs(coords);
          heat1.redraw();
        }
        
        var heat1 = L.heatLayer(get_markers(), {radius: 25}).addTo(myMap);
        myMap.on('layerremove', update_layer);
        myMap.on('layeradd', update_layer);
      }
    "))

responsive heatmap with crosstalk and leaflet in R

1 Answers