将不透明度滑块添加到在 r 中生成的传单贴图

Question

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

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

并尝试了以下两个包，但其中 none 似乎有效：

leaflet.multiopacity

leaflet.opacity

所以我想通了，这应该可以通过 htmltools 实现。但是，我遇到以下问题

拖动滑块也会移动地图（同时更改标签的不透明度），正如劳伦斯在此处评论中指出的那样：
我想更改所选叠加层的不透明度。但是我既没有设法获得这些值，也没有改变它们的不透明度值。

对这个原因没有帮助，我几乎没有 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

将不透明度滑块添加到在 r 中生成的传单贴图

Add an opacity slider to a leaflet map generated in r

javascript

r

leaflet