rstudio / leaflet

R Interface to Leaflet Maps
http://rstudio.github.io/leaflet/
Other
805 stars 509 forks source link

addLegend group not working when group is in addLayersControl baseGroups #477

Open wimpel opened 6 years ago

wimpel commented 6 years ago

In my shiny-app, i've got a leaflet, based on reactive userinput

  output$leafletMap2 <- renderLeaflet({
    leaflet(df[which(!is.na(df$latitude)), ]) %>% addTiles() %>% setView(4.213, 51.876, zoom = 7)
  })

  observe({
    leafletProxy("leafletMap2", data = filteredData() ) %>% 
      clearGroup("test1") %>%
      clearGroup("test2") %>%
      clearGroup("test3") %>%
      addCircleMarkers(lng = ~longitude,
                       lat = ~latitude,
                       radius = 6,
                       color = ~pal(process),
                       stroke = FALSE,
                       fillOpacity = 1,
                       popup = paste(filteredData()$time, "<br>", filteredData()$description),
                       popupOptions = popupOptions(closeOnClick = FALSE),
                       group = "test1") %>%
      addCircleMarkers(lng = ~longitude,
                       lat = ~latitude,
                       radius = 6,                        
                       color = ~pal(PROCES),
                       stroke = FALSE,
                       fillOpacity = 1,
                       clusterOptions = markerClusterOptions() ,
                       popup = paste(filteredData()$time, "<br>", filteredData()$description),
                       popupOptions = popupOptions(closeOnClick = FALSE),
                       group = "test2") %>%
      addHeatmap(lng = ~longitude,
                 lat = ~latitude,
                 blur = 15,                 
                 max = 1, 
                 radius = 10,              
                 intensity = 0.25,       
                 group = "test3") %>%
      clearControls() %>%
      addLegend(position = "bottomleft",
                pal = pal,
                values = sort( unique(filteredData()$PROCES) ),
                opacity = 1,
                group = "test1") %>%
      addLayersControl(baseGroups = c("test3", "test1", "test2"), 
                       #overlayGroups = c("test3", "test1", "test2"), 
                       options = layersControlOptions(collapsed = FALSE)
      )
  })

I would like the legend to show only when test3 is the selected layer. This does not work when I select a layer from the baseGroups (with radiobuttons). However, it does work when I add the laters to the overlayGroups (with checkboxes). I rather do not want to do that, because I want the user not to be able to select multiple layers at once).

Not sure if this is a bug-report, feature request or that I'm simply missing somthing ;-).

bhaskarvk commented 6 years ago

Yeah I haven't added support for baselayer change. I think I can add it though.

wimpel commented 6 years ago

That would be great! I wpould be happy to test :)

ummel commented 6 years ago

I, too, would make use of this functionality (i.e. baseGroups correctly toggling legends). Here is a snippet based on ?addLegend example that produces the issue:

df = local({
  n = 300; x = rnorm(n); y = rnorm(n)
  z = sqrt(x^2 + y^2); z[sample(n, 10)] = NA
  z2 <- z ^ 2
  data.frame(x, y, z, z2)
})

pal1 = colorNumeric('OrRd', df$z)
pal2 = colorNumeric('OrRd', df$z2)

leaflet(df) %>%
  addTiles() %>%
  addCircleMarkers(~x, ~y, color = ~pal1(z), group='circles1') %>%
  addCircleMarkers(~x, ~y, color = ~pal2(z2), group='circles2') %>%
  addLegend(pal = pal1, values = ~z, group='circles1', position='bottomleft') %>%
  addLegend(pal = pal2, values = ~z2, group='circles2', position='bottomleft') %>%
  addLayersControl(baseGroups = c('circles1', 'circles2'))
mmari commented 6 years ago

I aggree that add "group" option inside "addLegend" would be great!!

wimpel commented 6 years ago

@bhaskarvk Could you indicate if, and if so: when, this feature will be added?

bantaj commented 6 years ago

+1. I would use this feature quite often.

bhaskarvk commented 6 years ago

This is not as straightforward to implement as overlay groups. The reason being that when an overlay group swaps we get JS events for both groups, the one that is going out and the one that is coming in, and we get the group name in the event. This makes it easy to tie the legend to every overlay gorup's add/remove events. Unfortunately for base group we receive group name in the JS event only for the group that is coming in. This means there's is no way to know which group was on the way out. There is a roundabout way of achieving this, but I don't have the time right now to work on this. Unless @jcheng5 has some free cycles, I don't see this getting resolved anytime soon.

jcheng5 commented 6 years ago

@schloerke Maybe you can at least scope this, even if we don't include it in 1.2.0?

beansrowning commented 6 years ago

@jcheng5 is it still anticipated that this will be in the 1.2.0 release, or will it take longer to scope out?

jcheng5 commented 6 years ago

I'll leave it to @schloerke but I don't think it will, the 1.2.0 release has already taken much longer than we realized it would due to tasks that absolutely have to be done (bringing leaflet.extras and leaflet.esri packages up to date, for example--I was under the mistaken impression that was done already).

beansrowning commented 6 years ago

Thanks for the update. Definitely understandable that those updates take precedence.

schloerke commented 6 years ago

@beansrowning Sorry, I didn't get to this one this round, but I'll add it for next release

beansrowning commented 6 years ago

@schloerke No problem, let me know if there is something I can do to help.

dhmontgomery commented 6 years ago

Are there any workarounds for this issue? I regularly make maps involving multiple polygon layers for which there's no point in showing more than one at a time — but for which extra legends for each layer fill up the real estate very quickly.

BenjSmith10 commented 6 years ago

Has any solution to this issue been devised yet? It is a problem I am finding with many of the maps I have created. It would be much more user friendly for basegroup legends to react to changing groups rather than relying on the user to select and unselect the overlay groups...any help appreciated. Thanks.

HughSt commented 5 years ago

Hi, I just wondered whether there is any update on this issue? Would be extremely useful! Thanks!

jzadra commented 5 years ago

Also encountering a need for this function.

Note that in leaflet 2.0.2 the help file for ?addLegend states the following for the group argument, leading one to believe that this functionality has already been implemented:

group name of a leaflet layer group. Supplying this value will tie the legend to the leaflet layer group with this name and will auto add/remove the legend as the group is added/removed, for example via layerControl. You will need to set the group when you add a layer (e.g. addPolygons) and supply the same name here.

jzadra commented 5 years ago

This is not as straightforward to implement as overlay groups. The reason being that when an overlay group swaps we get JS events for both groups, the one that is going out and the one that is coming in, and we get the group name in the event. This makes it easy to tie the legend to every overlay gorup's add/remove events. Unfortunately for base group we receive group name in the JS event only for the group that is coming in. This means there's is no way to know which group was on the way out. There is a roundabout way of achieving this, but I don't have the time right now to work on this. Unless @jcheng5 has some free cycles, I don't see this getting resolved anytime soon.

Couldn't the outgoing group be known just by keeping track of the previous incoming group?

macabuag commented 5 years ago

+1 I would also make regular use of this feature. Do you know when/if it will be added?

emilmahler commented 5 years ago

Here is a simple workaround - no new functionality is needed:

observeEvent(input$mymap_groups,{
  leafletProxy('mymap') %>% removeControl(layerId = "basegroup_legend_1") %>% removeControl(layerId = "basegroup_legend_2")

  if ('basegroup_layer_1' %in% isolate(input$mymap_groups)){
    leafletProxy('mymap') %>% addLegend(position = "bottomright",
                                        colors = c("#269900","#ff0000"),
                                        labels = c('Discrete label 1','Discrete label 2'),
                                        layerId = "basegroup_legend",
                                        title='Legend title')
  }
  else if ('basegroup_layer_2' %in% isolate(input$mymap_groups)){
    leafletProxy('mymap') %>% addLegend(position = "bottomright",
                                        colors = c("#269900","#ff0000"),
                                        labels = c('Discrete label 1','Discrete label 2'),
                                        layerId = "basegroup_legend_2",
                                        title='Legend title')
  }
})
vojtechkania commented 4 years ago

Have someone already solved the issue? The functionality group has not been added to addLegend yet. I would like to have the legend changed based on chosen baseGroup.

elsayyad commented 4 years ago

Afternoon All,

When is the ETA for v2.1 release? .. I'd have to write repetitive code for that legend issue.

Thanks in Advance.

JoshuaSturm commented 4 years ago

Hi, all.

Here's a workaround that works for me.

You can add a custom className to the legend (it should match the group name), and then, using htmlwidgets::onRender(), hide all legends except for the one whose class matches the selected group.

Note that you should keep "info legend" in the className since they are important attributes.

Modifying the function from here:

... %>%
   addPolygonsLayers(
      ...,
      group = "xxx"
   ) %>%
   addLegend(
      ...,
      group = "xxx",
      className = "info legend xxx"
   ) %>%
   addLayersControl(
      baseGroups = c("xxx", ...),
      options = layersControlOptions(collapsed = FALSE)
   ) %>%
   htmlwidgets::onRender("
      function(el, x) {
         var updateLegend = function () {
            var selectedGroup = document.querySelectorAll('input:checked')[0].nextSibling.innerText.substr(1);

            document.querySelectorAll('.legend').forEach(a => a.hidden=true);
            document.querySelectorAll('.legend').forEach(l => {
               if (l.classList.contains(selectedGroup)) l.hidden=false;
            });
         };
         updateLegend();
         this.on('baselayerchange', el => updateLegend());
      }"
   )
izahn commented 3 years ago

@JoshuaSturm Your work-around is awesome, but it doesn't work if there are spaces in the group name. Any way to accommodate that?

JoshuaSturm commented 3 years ago

@izahn I just tried with spaces, and it's working fine. Could you share a reprex?

hannahpoole commented 3 years ago

@JoshuaSturm Hi and thanks so much for your input on this thread. No problem with spaces, but having cut and pasted from the htmlwidgets::onRender line of code, it has solved the problem of all three legends for my three base groups all appearing at the same time. But, I only get the legend for the final (third) base group when I toggle through the three toggle buttons. The first two show no legend. Any help or suggestions for why this is happening are really appreciated - I'm a Biology undergrad in England on a very steep learning curve in R!

HughSt commented 3 years ago

@JoshuaSturm Thanks for the workaround. I too have issue if I have spaces in the group names and/or if the group names are similar (e.g. c("Distance to road", "Distance to city")). Here's a simple example which produces strange beehaviour if the groups have a space in them but works fine if I use elev_5 instead of elev 5.

elev <- raster::getData("alt", country="SWZ")
elev_5 <- elev * 5

elev_pal <- colorNumeric(terrain.colors(6), values(elev), na.color = NA)
elev_5_pal <- colorNumeric(heat.colors(6), values(elev_5), na.color = NA)

leaflet() %>% addTiles() %>%
  addRasterImage(
    elev,
    col = elev_pal,
    group = "elev"
  ) %>%
  addRasterImage(
    elev_5,
    col = elev_5_pal,
    group = "elev 5"
  ) %>%
  addLegend(
    group = "elev",
    pal = elev_pal,
    values = values(elev),
    className = "info legend elev"
  ) %>%
  addLegend(
    group = "elev 5",
    pal = elev_5_pal,
    values = values(elev_5),
    className = "info legend elev 5"
  ) %>%
  addLayersControl(
    baseGroups = c("elev", "elev 5"),
    options = layersControlOptions(collapsed = FALSE)
  ) %>%
  htmlwidgets::onRender("
      function(el, x) {
         var updateLegend = function () {
            var selectedGroup = document.querySelectorAll('input:checked')[0].nextSibling.innerText.substr(1);

            document.querySelectorAll('.legend').forEach(a => a.hidden=true);
            document.querySelectorAll('.legend').forEach(l => {
               if (l.classList.contains(selectedGroup)) l.hidden=false;
            });
         };
         updateLegend();
         this.on('baselayerchange', el => updateLegend());
      }"
  )
mtennekes commented 3 years ago

For those of you who have problems with the group name spaces (and need a solution before leaflet 2.1 is released), here is a workaround:

library(leaflet)
df <- local({
    n <- 300; x <- rnorm(n); y <- rnorm(n)
    z <- sqrt(x ^ 2 + y ^ 2); z[sample(n, 10)] <- NA
    data.frame(x, y, z)
})
pal <- colorNumeric("OrRd", df$z)
pal2 <- colorNumeric("Blues", df$z)
leaflet(df) %>%
  addTiles() %>%
  addCircleMarkers(~x, ~y, color = ~pal(z), group = "orange circles") %>%
  addCircleMarkers(~x, ~y, color = ~pal2(z), group = "blue circles") %>% 
  addLegend(pal = pal, values = ~z, group = "orangecircles", position = "bottomleft", 
    className = "info legend orangecircles") %>%
  addLegend(pal = pal2, values = ~z, group = "bluecircles", position = "bottomleft", 
    className = "info legend bluecircles") %>%
  addLayersControl(baseGroups =  c("orange circles", "blue circles")) %>% 
  tmlwidgets::onRender("
      function(el, x) {
         var updateLegend = function () {
            var selectedGroup = document.querySelectorAll('input:checked')[0].nextSibling.innerText.substr(1);
            var selectedClass = selectedGroup.replace(' ', '');
            document.querySelectorAll('.legend').forEach(a => a.hidden=true);
            document.querySelectorAll('.legend').forEach(l => {
               if (l.classList.contains(selectedClass)) l.hidden=false;
            });
         };
         updateLegend();
         this.on('baselayerchange', el => updateLegend());
      }"
  )

The problem was that div class names cannot take spaces.

Make sure you remove the spaces of the group name in the className argument (in this example orange circles => orangecircles).

P.S. Unfortunately this only works with group names that contain one space. The added JS code line should be: var selectedClass = selectedGroup.replace(/\s+/g, ''); but this throws the error '\s' is an unrecognized escape. @timelyportfolio : do you know how to fix this?

lvalnegri commented 2 years ago

the problem is not only spaces, but punctuation in general, and also numbers. I've solved it as following:

var updateLegend = function () {
    var selectedGroup = document.querySelectorAll('input:checked')[0].nextSibling.innerText.substr(1).replace(/[^a-zA-Z]+/g, ''); 
    document.querySelectorAll('.legend').forEach( a => a.hidden=true );
    document.querySelectorAll('.legend').forEach( l => { if (l.classList.contains(selectedGroup)) l.hidden=false; } );
};

you can see an example here

EwanMcHenry commented 2 years ago

@lvalnegri 's code didnt work for me generally, because of spaces, punctuation etc in the ClassName (which I would like to be the same as the group name). Got it working by removing these within the R code. Here is a version of the code by @mtennekes with my alterations, using the example of group name = "blue1 circles".

`library(leaflet) library(stringr)

df <- local({ n <- 300; x <- rnorm(n); y <- rnorm(n) z <- sqrt(x ^ 2 + y ^ 2); z[sample(n, 10)] <- NA data.frame(x, y, z) }) pal <- colorNumeric("OrRd", df$z) pal2 <- colorNumeric("Blues", df$z)

leaflet(df) %>% addTiles() %>% addCircleMarkers(~x, ~y, color = ~pal(z), group = "orange circles") %>% addCircleMarkers(~x, ~y, color = ~pal2(z), group = "blue1 circles") %>% addLegend(pal = pal, values = ~z, group = "orangecircles", position = "bottomleft", className = "info legend orangecircles") %>% addLegend(pal = pal2, values = ~z, group = "blue1circles", position = "bottomleft", className = paste0("info legend ",str_replace_all(("blue1 circles"), regex("[^a-zA-Z]"), ""))) %>% addLayersControl(baseGroups = c("orange circles", "blue1 circles"), options = layersControlOptions(collapsed = F)) %>% htmlwidgets::onRender(" function(el, x) { var updateLegend = function () { var selectedGroup = document.querySelectorAll('input:checked')[0].nextSibling.innerText.substr(1).replace(/[^a-zA-Z]+/g, ''); document.querySelectorAll('.legend').forEach( a => a.hidden=true ); document.querySelectorAll('.legend').forEach( l => { if (l.classList.contains(selectedGroup)) l.hidden=false; } ); }; updateLegend(); this.on('baselayerchange', el => updateLegend()); }" )`