R中具有串扰和小叶的响应热图

Question

我想用R中的串扰制作一个带有点的地图和一个响应热图

library(crosstalk)
library(leaflet)
library(DT)
# Wrap data frame in SharedData
sd <- SharedData$new(quakes[sample(nrow(quakes), 10),])
bscols(
# Create a filter input
filter_slider("mag", "Magnitude", sd, column=~mag, step=0.1, width=250),
leaflet(sd) %>% addTiles() %>% addMarkers() %>% addHeatmap())
)

但是，正如在运行代码后可以观察到的那样，这种方式在过滤时并没有对热图产生响应效果

我怎样才能达到效果？

Answer 1

这可以用Shiny轻松完成。然而，如果你真的不想使用串扰，那么每次标记更改时，你都必须添加一些javascript来重新绘制热图，因为串扰由于某种原因似乎无法做到这一点。

可以在此处找到一个工作示例：https://rpubs.com/Jumble/r_crosstalk_leaflet_heatmap_update

下面是产生这个的代码：

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