向 r 中生成的传单地图添加不透明度滑块

Question

我想向 r 中生成的传单地图添加不透明度滑块。它应该改变最上面的可见层或所有可见层的不透明度（两者之一，我不介意）。 我在这个帖子中找到了有用的建议： 在 R 传单中添加不透明度滑块

这个博客： https://bookdown.org/nicohahn/making_maps_with_r5/docs/leaflet.html

并尝试了以下两个软件包，但这两个似乎都不起作用：

传单.多重不透明度

传单.不透明度

所以我发现，这应该可以通过 htmltools 实现。然而，我遇到以下问题

1. 拖动滑块也会移动地图（同时更改标签的不透明度），如劳伦斯评论中所指出的：在 R leaflet 中添加不透明度滑块

2. 我想更改所选覆盖层的不透明度。然而，我既无法获得这些值，也无法改变它们的不透明度值。

对此没有帮助的是，我几乎不懂 Javascript。这是一个关于我走了多远的例子。如果有人指出我正确的方向，我将不胜感激。我什至不知道 htmltools javascript 命令如何填充访问变量。

library(leaflet)
library(mapview) #to get the franconia dataset
library(htmltools)

colors <- colorFactor(palette = c("Red", "Green", "Blue"),
                      levels = c("Oberfranken","Mittelfranken", "Unterfranken"))


franconia %>% leaflet() %>% 
  addProviderTiles("CartoDB.Positron", group = "CartoDB.Positron") %>% 
  addPolygons(fillColor = ~colors(district),weight =  1, group = "Districts") %>%
  addPolygons(label = ~NAME_ASCI,weight =  1, group = "Names", fillColor = "Grey") %>%
  addLayersControl(baseGroups = "CartoDB.Positron",overlayGroups = c("Districts", "Names"),position = "topleft") %>%
  addControl(html = "<input id=\"slide\" type=\"range\" min=\"0\" max=\"1\" step=\"0.1\" value=\"0.5\">") %>%   # Add Slider
  htmlwidgets::onRender("function(el,x,data){
                     var map = this;
                     var evthandler = function(e){
                        var layers = map.layerManager.getVisibleGroups();
                        Object.keys(layer).forEach(function(el){
                             layer[el]._container.style.opacity = +e.target.value;
                             });
                     };
              $('#slide').on('mousemove',L.DomEvent.stopPropagation);
              $('#slide').on('input', evthandler)}
          ")

Answer 1

这似乎有效。非常欢迎任何改进！

library(leaflet)
library(htmltools)

colors <- colorFactor(palette="viridis",
                      domain=gadmCHE@data$NAME_1, na.color="transparent")

map <- gadmCHE %>% leaflet() %>% 
  addProviderTiles("CartoDB.Positron", group = "CartoDB.Positron") %>% 
  addPolygons(fillColor = ~colors(NAME_1), fillOpacity = 1, group="Colors") %>%
  addPolygons(label = ~NAME_1,weight =  1, group = "Names", fillColor = "Grey") %>%
  addLayersControl(baseGroups = "CartoDB.Positron",overlayGroups = c("Colors", "Names"),position = "topleft") %>%
  addControl(html = "<input id=\"OpacitySlide\" type=\"range\" min=\"0\" max=\"1\" step=\"0.1\" value=\"0.5\">") %>%   # Add Slider
  htmlwidgets::onRender(
    "function(el,x,data){
                     var map = this;
                     var evthandler = function(e){
                        var layers = map.layerManager.getVisibleGroups();
                        console.log('VisibleGroups: ', layers); 
                        console.log('Target value: ', +e.target.value);
                        layers.forEach(function(group) {
                          var layer = map.layerManager._byGroup[group];
                          console.log('currently processing: ', group);
                          Object.keys(layer).forEach(function(el){
                            if(layer[el] instanceof L.Polygon){;
                            console.log('Change opacity of: ', group, el);
                             layer[el].setStyle({fillOpacity:+e.target.value});
                            }
                          });
                          
                        })
                     };
              $('#OpacitySlide').mousedown(function () { map.dragging.disable(); });
              $('#OpacitySlide').mouseup(function () { map.dragging.enable(); });
              $('#OpacitySlide').on('input', evthandler)}
          ")

map

更改不透明度是通过

setStyle({fillOpacity:+e.target.value})

完成的

停止平移已通过命令解决

$('#OpacitySlide').mousedown(function () { map.dragging.disable(); })

此代码检查每个可见图层组中的每个元素，是否是多边形

if(layer[el] instanceof L.Polygon)

。如果是，它就会改变不透明度。我不知道如何在团体的基础上做到这一点。

代码向 JS-Console 抛出消息。可能对其他新手有好处。感谢https://plotly-r.com/json.html