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

如何解决R中具有串扰和传单的响应式热图

我想使用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())
)

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

如何达到效果？

解决方法

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