我试图在 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", "A", "C", "B", "B",
"A", "B"), Name2 = c("a", "b", "b", "a", "b", "a", "b", "c"),
Value1 = c(12, 43, 54, 34, 23, 77, 44, 22), Value2 = c(0,
1, 1, 0, 0, 0, 0, 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", "blue", "green", "red", "red", "blue", "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,0), list(lmap, d3),list(dtable,ggplotly(ggplt)), htmltools::p(summarywidget(sdf, statistic='mean', column='Value1'), style="display:none;"))