r-具有串扰和传单的响应性"addWebGLHeatmap"

Question

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

Answer 1

这个方法有点像破解，但仍然可以使用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, 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);
}
"))