0

我使用addHeatmap. 不幸的是，这种工具不够有用，因为有两个主要问题：1）热图会随着每个新的缩放级别重新绘制；2）您不能将热图和单独的组中的点分别制作成一个。

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

在这个问题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);
      }
    "))
4

1 回答 1

1

这种方法是一种 hack，但仍然应该能够使用addWebGLHeatmap. 它添加了两组相同的标记并隐藏了一组控制热图的标记。这允许层控制。可以在此处找到一个工作示例：

https://rpubs.com/Jumble/leaflet_webgl_heatmap

下面是产生这个的代码。这段代码解决了主要的两个问题，但如果你不想绘制超过 1000 个点，它会很困难。

与其使用串扰，不如使用类似的组合，leafgl如果您想绘制数千个点。shinyaddWebGLHeatmap 

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

下面是圆圈标记

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);
          }
      "))
于 2020-11-06T18:09:31.780 回答