Responsive `addWebGLHeatmap` with crosstalk and leaflet in

Question

I make a leaflet map with a responsive heatmap using addHeatmap. Unfortunately, this kind of tool it is not enough useful because two main problems: 1) The heatmap is redrawed with each new level of zoom and 2) you can not make the heatmap and the points in a separated group each one.

It is possible a similar solution with addWebGLHeatmap?

There is the code for the addHeatmap solution, following this question

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);
      }
    "))

Answer 1

This method is kind of a hack, but still should be able to work with addWebGLHeatmap. It adds two sets of identical markers and hides one which controls the heatmap. This allows for the layer control. A working example can be found here:

https://rpubs.com/Jumble/leaflet_webgl_heatmap

Below is the code that produced this. This code solves the main two problems although it struggles if you wan't to plot over 1000 points.

Rather than using crosstalk it might be better to use a combination of something like leafgl, shiny and addWebGLHeatmap if you are wanting to plot thousands of points.

n <- 200
data <- data.frame(id = seq(1, n*2), lat = rnorm(n, 0, 15), long = rnorm(n, 0, 15), group=c(rep("Heatmap",n), rep("Markers", n)), mag=rep(as.integer(runif(n, 0, 20)),2))
sd <- SharedData$new(data)

bscols(widths=c(3,9),
       filter_slider("mag", "Magnitude", sd, column=~mag, step=0.1),
       leaflet(sd, options=leafletOptions(preferCanvas = TRUE)) %>% 
         addTiles() %>% 
         leaflet::setView(lat=0, lng=0, zoom=4) %>%
         addMarkers(group=~group) %>%
         leaflet.extras::addWebGLHeatmap(layerId = "heatmapwebgl") %>%
         leaflet.extras::removeWebGLHeatmap("heatmapwebgl") %>%
         addLayersControl(overlayGroups = c("Heatmap", "Markers"), options=layersControlOptions(collapsed=FALSE)) %>%
         htmlwidgets::onRender("
          function(el,x){
            var myMap = this;
            var coord_state;
            
            // hide heatmap markers 
            setTimeout(function(){
              myMap.eachLayer(function(layer){
                if (layer.options.group=='Heatmap'){
                  layer.setOpacity(0);
                  layer.getElement().style.pointerEvents = 'none';
                }
              })
            }, 100)
            
            function get_markers(){
              coord_state = [];
              myMap.eachLayer(function(layer){
                if (layer.options.group=='Heatmap'){
                  coord_state.push([layer.options.lat, layer.options.lng, 0.5]);
                  layer.getElement().style.pointerEvents = 'none';
                }
              })
              return(coord_state)
            }
            
            function redraw_heatmap(){
              heatmap.setData(get_markers());
            }
            
            var heatmap = L.webGLHeatmap({size: 1000000,units: 'm',alphaRange: 1});
            heatmap.setData(get_markers());
            myMap.addLayer(heatmap);
            
            myMap.on('layerremove', redraw_heatmap);
            myMap.on('layeradd', redraw_heatmap);
          }
      "))

Below for Circle Markers

n <- 200
data <- data.frame(id = seq(1, n*2), lat = rnorm(n, 0, 15), long = rnorm(n, 0, 15), group=c(rep("Heatmap",n), rep("Markers", n)), mag=rep(as.integer(runif(n, 0, 20)),2))
sd <- SharedData$new(data)

bscols(widths=c(3,9),
       filter_slider("mag", "Magnitude", sd, column=~mag, step=0.1),
       leaflet(sd) %>% 
         addTiles() %>% 
         leaflet::setView(lat=0, lng=0, zoom=4) %>%
         addCircleMarkers(group=~group, opacity=~ifelse(group=="Heatmap", 0, 0.5), fillOpacity=~ifelse(group=="Heatmap", 0, 0.2)) %>%
         leaflet.extras::addWebGLHeatmap(layerId = "heatmapwebgl") %>%
         leaflet.extras::removeWebGLHeatmap("heatmapwebgl") %>%
         addLayersControl(overlayGroups = c("Heatmap", "Markers"), options=layersControlOptions(collapsed=FALSE)) %>%
         htmlwidgets::onRender("
          function(el,x){
            var myMap = this;
            var coord_state;
            
            function get_markers(){
              coord_state = [];
              myMap.eachLayer(function(layer){
                if (layer.options.group=='Heatmap'){
                  coord_state.push([layer.options.lat, layer.options.lng, 0.5]);
                  layer.getElement().style.pointerEvents = 'none';
                }
              })
              return(coord_state)
            }
            
            function redraw_heatmap(){
              heatmap.setData(get_markers());
            }
            
            var heatmap = L.webGLHeatmap({size: 1000000,units: 'm',alphaRange: 1});
            heatmap.setData(get_markers());
            myMap.addLayer(heatmap);
            
            myMap.on('layerremove', redraw_heatmap);
            myMap.on('layeradd', redraw_heatmap);
          }
      "))