带有相声和传单的响应式“ addWebGLHeatmap”

如何解决带有相声和传单的响应式“ addWebGLHeatmap”

我使用addHeatmap制作了带有响应热图的传单图。不幸的是，这种工具的用处还不够，因为存在两个主要问题：1）使用新的缩放级别重新绘制热图，以及2）无法将热图和单独组中的点分别绘制。

addWebGLHeatmap可能有类似的解决方案吗？

在this question之后有addHeatmap解决方案的代码

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

解决方法

此方法有点骇人听闻，但仍然可以使用addWebGLHeatmap。它添加了两组相同的标记，并隐藏了一个控制热图的标记。这允许进行图层控制。一个有效的示例可以在这里找到：

https://rpubs.com/Jumble/leaflet_webgl_heatmap

下面是产生此代码的代码。这段代码解决了两个主要问题，尽管如果您不想绘制超过1000个点，它也会很麻烦。

如果要绘制数千个点，则最好使用leafgl，shiny和addWebGLHeatmap 之类的组合，而不是使用串扰。

n <- 200
data <- data.frame(id = seq(1,n*2),lat = rnorm(n,15),long = rnorm(n,group=c(rep("Heatmap",n),rep("Markers",n)),mag=rep(as.integer(runif(n,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);
          }
      "))

下方为圆形标记

n <- 200
data <- data.frame(id = seq(1,leaflet(sd) %>% 
         addTiles() %>% 
         leaflet::setView(lat=0,zoom=4) %>%
         addCircleMarkers(group=~group,opacity=~ifelse(group=="Heatmap",0.5),fillOpacity=~ifelse(group=="Heatmap",0.2)) %>%
         leaflet.extras::addWebGLHeatmap(layerId = "heatmapwebgl") %>%
         leaflet.extras::removeWebGLHeatmap("heatmapwebgl") %>%
         addLayersControl(overlayGroups = c("Heatmap",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,redraw_heatmap);
          }
      "))