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