Je crée une carte dépliante avec une carte thermique réactive en utilisant addHeatmap. Malheureusement, ce genre d'outil n'est pas assez utile car deux problèmes principaux : 1) La heatmap est redessinée à chaque nouveau niveau de zoom et 2) vous ne pouvez pas faire la heatmap et les points dans un groupe séparé chacun.

Une solution similaire est-elle possible avec addWebGLHeatmap ?

Il y a le code pour la solution addHeatmap, suivant cette 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);
      }
    "))
0
Armando González Díaz 5 nov. 2020 à 02:45

1 réponse

Meilleure réponse

Cette méthode est une sorte de hack, mais devrait toujours pouvoir fonctionner avec addWebGLHeatmap. Il ajoute deux ensembles de marqueurs identiques et en masque un qui contrôle la carte thermique. Cela permet le contrôle des couches. Un exemple de travail peut être trouvé ici:

https://rpubs.com/Jumble/leaflet_webgl_heatmap

Vous trouverez ci-dessous le code qui a produit cela. Ce code résout les deux principaux problèmes bien qu'il soit difficile si vous ne voulez pas tracer plus de 1000 points.

Plutôt que d'utiliser la diaphonie, il peut être préférable d'utiliser une combinaison de quelque chose comme leafgl, shiny et addWebGLHeatmap si vous souhaitez tracer des milliers de 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);
          }
      "))

Ci-dessous pour les marqueurs de cercle

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);
          }
      "))
1
Jumble 25 nov. 2020 à 10:12