javascriptrr-leaflet

Add an opacity slider to a leaflet map generated in r

I would like to add an opacity slider to a leaflet map generated in r. It should change the opacity of the uppermost visible or all visible layers (either of the two, I don't mind). I found helpful advice in this thread: Add opacity slider in R leaflet

This blog: https://bookdown.org/nicohahn/making_maps_with_r5/docs/leaflet.html

and tried the following two packages, but none of the two seems to work:

leaflet.multiopacity

leaflet.opacity

So I figured out, this should be possible with htmltools. However, I struggle with the following

  1. Dragging the slider moves the map too (while changing the opacity of the labels), as pointed out in Laurens comment here: Add opacity slider in R leaflet

  2. I would like to change the opacity of the selected overlay layers. However I neither manage to get those values nor to change their opacity value.

Not helpful in this cause is, that I have almost no command of Javascript. Here is an example on how far I got. Would appreciate anyone pointing me into the right direction. I don't even know how the access variables filled by htmltools javascript commands.

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)}
          ")

enter image description here

Solution

  • This seems to be working. Any improvements very welcome!

    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

    changing the opacity was done by setStyle({fillOpacity:+e.target.value})

    To stop the panning was resolved by the command $('#OpacitySlide').mousedown(function () { map.dragging.disable(); })

    This code checks for every element in every visible group layer, whether it is a polygon if(layer[el] instanceof L.Polygon). If it is, it then changes the opacity. I wouldn't know how to do that on a group basis.

    The code throws messages to the JS-Console. Might be good for other newbies. Thanks to https://plotly-r.com/json.html

    enter image description here