R Leaflet:将多个组分配给一个层以过滤数据并更改表示的列
我试图在 R 传单中找到一种方法来包含覆盖按钮，以过滤掉数据中的组.我还需要包含用于切换数据中表示的列的单选按钮.我似乎找不到使用 addLayersControl() 函数在 R 传单中执行此操作的方法.
I am trying to find a way in R leaflet to include overlay buttons which filters out groups in the data. I also need to include radio buttons which switch the column which is being represented in the data. I can't seem to find a way to do this in R leaflet using the addLayersControl() function.
我最初认为可以将多个组添加到单个图层并使用 baseGroups 和 overlayGroups(如下面的代码所示).然而，这并没有达到预期的结果.如果有人可以提出另一种方法来实现这一目标，我将不胜感激.最好不要发亮.
I initial thought it would be possible to add multiple groups to a single layer and use baseGroups and overlayGroups (as seen in the code below). However, this does not achieve the desired results. I would appreciate it if someone could suggest an alternative way to achieve this. Preferably without shiny.
library(dplyr)
library(leaflet)
data <- data.frame(Name = c("A", "A", "A", "B", "B", "C", "C", "C"),
Value1 = c(12,43,54,34,23,77,44,22),
Value2 = c(6,5,2,7,5,6,4,3),
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))
data %>%
leaflet() %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addCircles(lat=~Lat, lng=~Lon, radius = ~Value1*1000, group=c(~Name, "Value1")) %>%
addCircles(lat=~Lat, lng=~Lon, radius = ~Value2, group=c(~Name, "Value2")) %>%
addLayersControl(
baseGroups = c("Value1", "Value2"),
overlayGroups = c("A", "B", "C"),
options = layersControlOptions(collapsed = F)
)
图像:输出不是我所期望的
推荐答案
下面是一个非常不优雅和 hacky 的问题解决方案.它为每个圆圈分配一个图层 ID，并使用一些 javascript 来确定在给定输入复选框的情况下应该显示哪个圆圈.
Below is a very inelegant and hacky solution to the problem. It assigns a layer id to each circle and uses some javascript to determine which circle should be displayed given the input checkboxes.
可以在此处找到工作演示:https://rpubs.com/Jumble/leaflet_layer_control
A working demonstration can be found here: https://rpubs.com/Jumble/leaflet_layer_control
如果有人有更优雅的解决方案，请分享.
Please share if anyone has a more elegant solution.
library(dplyr)
library(leaflet)
library(htmlwidgets)
data <- data.frame(ID = c("1", "2","3","4","5","6","7","8"),
Name = c("A", "A", "A", "B", "B", "C", "C", "C"),
Value1 = c(12,43,54,34,23,77,44,22),
Value2 = c(6,5,2,7,5,6,4,3),
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))
data %>%
leaflet() %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addCircles(lat=~Lat, lng=~Lon, radius = ~Value1*1000, group=~Name, label=~Name, popup=~as.character(Value1), layerId = ~paste(ID,"Value1", sep="")) %>%
addCircles(lat=~Lat, lng=~Lon, radius = ~Value2, group=~Name, label=~Name, popup=~as.character(Value2), layerId = ~paste(ID,"Value2", sep="")) %>%
addLayersControl(
baseGroups = c("Value1", "Value2"),
overlayGroups = c("A", "B", "C"),
options = layersControlOptions(collapsed = F)
) %>%
htmlwidgets::onRender("
function(el, x) {
var myMap = this;
var baseLayer = 'Value1';
myMap.eachLayer(function(layer){
var id = layer.options.layerId;
if (id){
if ('Value1' !== id.substring(1,)){
layer.getElement().style.display = 'none';
}
}
})
console.log(myMap.baselayer);
myMap.on('baselayerchange',
function (e) {
baseLayer=e.name;
myMap.eachLayer(function (layer) {
var id = layer.options.layerId;
if (id){
if (e.name !== id.substring(1,)){
layer.getElement().style.display = 'none';
layer.closePopup();
}
if (e.name === id.substring(1,)){
layer.getElement().style.display = 'block';
}
}
});
})
myMap.on('overlayadd', function(e){
myMap.eachLayer(function(layer){
var id = layer.options.layerId;
if (id){
if (baseLayer !== id.substring(1,)){
layer.getElement().style.display = 'none';
}
}
})
})
}")
相关文章