使用串扰包在传单中绘制动态条形图

编程问答 2022-11-22

问题描述

我试图在 R 中的传单旁边绘制两个动态图（一个散点图和一个条形图）（我不能使用 Shiny 包）。 我使用 Lasso-Leaflet 在传单中设置套索。随着传单图中选定点的变化，散点图工作正常（按选定点更新），但条形图不起作用。这是我的代码：

library(leaflet)
library(crosstalk)
library(DT)
library(dplyr)
library(htmltools)
library(summarywidget)
library(plotly)
library(d3scatter)
data_2<-structure(list(ID = 1:8,Name1 = c("A","A","C","B","B"),Name2 = c("a","b","a","c"),Value1 = c(12,43,54,34,23,77,44,22),Value2 = c(0,1,2),Lat = c(51.1,51.6,57.3,52.4,56.3,54.3,60.4,49.2),Lon = c(5,-3,-2,-1,4,3,-5,0),lab_DB = c("blue","blue","green","red","red")),class = "data.frame",row.names = c(NA,-8L))

sdf <- SharedData$new(data_2,key=~ID,group="SharedDataqwertyui")
lmap <- leaflet() %>% addTiles() %>%
  addCircleMarkers(data = sdf,lng = ~Lon,lat = ~Lat,group = ~Name1,color = ~lab_DB,radius =3,layerId = ~ID
  )  %>% htmlwidgets::prependContent(tags$script(src="https://unpkg.com/leaflet-lasso@2.2.4/dist/leaflet-lasso.umd.min.js")) %>%
  htmlwidgets::onRender("
function(el,x) {var sheet = window.document.styleSheets[0];
  sheet.insertRule('.selectedMarker { filter: hue-rotate(135deg); }',sheet.cssRules.length);
  var map = this;
  const lassoControl = L.control.lasso(options={'position':'topleft'}).addTo(map);
  function resetSelectedState() {
        map.eachLayer(layer => {
            if (layer instanceof L.Marker) {
                layer.setIcon(new L.Icon.Default());
            } else if (layer instanceof L.Path) {
                layer.setStyle({  });
            }
        });
    }
    function setSelectedLayers(layers) {
        resetSelectedState();
        let ids = [];

        layers.forEach(layer => {
            if (layer instanceof L.Marker) {
              layer.setIcon(new L.Icon.Default({ className: 'selected selectedMarker'}));
            } else if (layer instanceof L.Path) {
                layer.setStyle({  });
            }
            ids.push(layer.options.layerId);
        });
        ct_filter.set(ids);
    }
    var ct_filter = new crosstalk.FilterHandle('SharedDataqwertyui');
    ct_filter.setGroup('SharedDataqwertyui');
    var ct_sel = new crosstalk.SelectionHandle('SharedDataqwertyui');
    ct_sel.setGroup('SharedDataqwertyui');
    map.on('mousedown',() => {
        ct_filter.clear();
        ct_sel.clear();
        resetSelectedState();
    });
    map.on('lasso.finished',event => {
        setSelectedLayers(event.layers);
    });

    lassoControl.setoptions({ intersect: true});
    var clearSel = function(){
        ct_filter.clear();
        ct_sel.clear();
        resetSelectedState();
    }
    document.getElementById('clearbutton').onclick = clearSel;
    }") %>%
  addEasyButton(
easyButton(
  icon = "fa-ban",title = "Clear Selection",id="clearbutton",onClick = JS("function(btn,map){
          return
     }")
)) 
dtable <- datatable(sdf,width = "100%",editable=TRUE,caption=tags$caption("Mean of Value1: ",summarywidget(sdf,statistic='mean',column='Value1')))
ggplt<-ggplot(sdf,aes(x=factor(Value2)))+
  geom_bar(stat="count",width=0.7,fill="steelblue")+
  theme_minimal()
d3<-d3scatter(sdf,x=~Value1,y=~Value2,width="100%",height=300)
bscols( widths=c(6,6,list(lmap,d3),list(dtable,ggplotly(ggplt)),htmltools::p(summarywidget(sdf,column='Value1'),style="display:none;"))

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

crosstalkdtjavascriptleafletrr