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

R 中带有串扰和传单的响应式热图

responsive heatmap with crosstalk and leaflet in R

r

leaflet

crosstalk