2

I am working with the R programming language.

Using this built-in map of North Carolina, I generated 3 random variables (income, number of kids, weight) and then created maps (with the "leaflet" library) for this data (via a loop):

library(sf)  
library(mapview)
library(leaflet)
library(leafgl)
library(colourvalues)
library(leaflet.extras)
library(magick)

nc <- st_read(system.file("gpkg/nc.gpkg", package="sf"), quiet = TRUE) %>% 
  st_transform(st_crs(4326)) %>% 
  st_cast('POLYGON')


set.seed(123) 
nc$median_income <- sample(20000:100000, nrow(nc), replace = TRUE)
pal <- colorNumeric(palette = "YlOrRd", domain = nc$median_income)
nc$median_number_of_kids <- sample(0:5, nrow(nc), replace = TRUE)
pal2 <- colorNumeric(palette = "Blues", domain = nc$median_number_of_kids)
nc$median_weight <- rnorm(nrow(nc), mean = 175, sd = 15)
pal3 <- colorNumeric(palette = "Greens", domain = nc$median_weight)


vars <- list(median_income = pal, median_number_of_kids = pal2, median_weight = pal3)
maps <- list()

for (i in seq_along(vars)) {
  var <- names(vars)[i]
  pal <- vars[[i]]
  map <- leaflet(data = nc) %>%
    addProviderTiles(providers$OpenStreetMap) %>%
    addPolygons(fillColor = ~pal(get(var)),
                fillOpacity = 0.8,
                weight = 1,
                color = "white",
                popup = ~NAME,
                label = ~NAME) %>%
    addLegend(pal = pal,
              values = ~get(var),
              title = paste("Median", var),
              position = "bottomright")
  maps[[i]] <- map
}

map_1 <- maps[[1]]
map_2 <- maps[[2]]
map_3 <- maps[[3]]

mapshot(map_1, file = "map_1.png")
mapshot(map_2,file = "map_2.png")
mapshot(map_3, file = "map_3.png")

img1 <- image_read("map_1.png")
img2 <- image_read("map_2.png")
img3 <- image_read("map_3.png")

combined_img <- image_append(c(img1, img2, img3))

print(combined_img)

image_write(combined_img, path = "combined_maps.png", format = "png")

Here is how these maps look like (notice the legends):

enter image description here

I would now like to merge all these maps into a single file which allows the user to "toggle" between the different maps - I know how to do this with the following code:

combined_map =  leaflet(data = nc) %>%
    addProviderTiles(providers$OpenStreetMap) %>%
    addPolygons(fillColor = ~pal(median_income),
                fillOpacity = 0.8,
                weight = 1,
                color = "white",
                popup = ~NAME,
                label = ~NAME,
                group = "Median Income") %>%
    addPolygons(fillColor = ~pal2(median_number_of_kids),
                fillOpacity = 0.8,
                weight = 1,
                color = "white",
                popup = ~NAME,
                label = ~NAME,
                group = "Median Number of Kids") %>%
    addPolygons(fillColor = ~pal3(median_weight),
                fillOpacity = 0.8,
                weight = 1,
                color = "white",
                popup = ~NAME,
                label = ~NAME,
                group = "Median Weight (lbs)") %>%
    addLayersControl(overlayGroups = c("Median Income", "Median Number of Kids", "Median Weight (lbs)"),
                     options = layersControlOptions(collapsed = FALSE))

My Problem: The code seems to have run, but the legends have disappeared!

enter image description here

My Question: I tried to learn more about why the legends are disappearing and what I can do to fix this problem - and I learned that it is possible to combine the "leaflet" library with javascript/html functions to modify the displays of the map (e.g. htmlwidgets::onRender("")). Perhaps this could be a strategy to fix the problem of the disappearing legends?

Or have I overcomplicated everything and there is an easier way to do this?

Thanks!

EDIT 1: I found a similar post Add different legends in different layers on leaflet map in R and have been trying to adapt the code from the answer provided to my problem - perhaps this can also solve the problem?

combined_map = leaflet(data = nc) %>%
  addProviderTiles(providers$OpenStreetMap) %>%
  addPolygons(fillColor = ~pal(median_income),
              fillOpacity = 0.8,
              weight = 1,
              color = "white",
              popup = ~NAME,
              label = ~NAME,
              group = "Median Income") %>%
  addPolygons(fillColor = ~pal2(median_number_of_kids),
              fillOpacity = 0.8,
              weight = 1,
              color = "white",
              popup = ~NAME,
              label = ~NAME,
              group = "Median Number of Kids") %>%
  addPolygons(fillColor = ~pal3(median_weight),
              fillOpacity = 0.8,
              weight = 1,
              color = "white",
              popup = ~NAME,
              label = ~NAME,
              group = "Median Weight (lbs)") %>%
  addLegend(pal = pal, values = ~median_income, title = "Median Income", position = "bottomright", group="Median Income") %>%
  addLegend(pal = pal2, values = ~median_number_of_kids, title = "Median Number of Kids", position = "bottomright", group="Median Number of Kids") %>%
  addLegend(pal = pal3, values = ~median_weight, title = "Median Weight (lbs)", position = "bottomright", group="Median Weight (lbs)") %>%
  addLayersControl(overlayGroups = c("Median Income", "Median Number of Kids", "Median Weight (lbs)"),
                   options = layersControlOptions(collapsed = FALSE))

EDIT 2: Based on the suggestions in the comments provided by @Alistaire, I tried to modify the code:

combined_map = leaflet(data = nc) %>%
  addProviderTiles(providers$OpenStreetMap) %>%
  addPolygons(fillColor = ~pal(median_income),
              fillOpacity = 0.8,
              weight = 1,
              color = "white",
              popup = ~NAME,
              label = ~NAME,
              group = "Median Income") %>%
  addPolygons(fillColor = ~pal2(median_number_of_kids),
              fillOpacity = 0.8,
              weight = 1,
              color = "white",
              popup = ~NAME,
              label = ~NAME,
              group = "Median Number of Kids") %>%
  addPolygons(fillColor = ~pal3(median_weight),
              fillOpacity = 0.8,
              weight = 1,
              color = "white",
              popup = ~NAME,
              label = ~NAME,
              group = "Median Weight (lbs)") %>%
  addLegend(pal = pal, values = ~median_income, title = "Median Income", position = "bottomright", group="Median Income") %>%
  addLegend(pal = pal2, values = ~median_number_of_kids, title = "Median Number of Kids", position = "bottomright", group="Median Number of Kids") %>%
  addLegend(pal = pal3, values = ~median_weight, title = "Median Weight (lbs)", position = "bottomright", group="Median Weight (lbs)") %>%
  addLayersControl(baseGroups = c("Median Income", "Median Number of Kids", "Median Weight (lbs)"),
                   options = layersControlOptions(collapsed = FALSE))
stats_noob
  • 5,401
  • 4
  • 27
  • 83
  • 1
    The fact that you have checkboxes instead of radio buttons is suspicious; probably you want `baseGroups` instead of `overlayGroups` in `addLayersControl()` ([docs](https://rstudio.github.io/leaflet/showhide.html)). Not sure if that will help with the legend or not, but it's probably a step in the right direction – alistaire May 01 '23 at 00:24
  • @ alistaire: thank you for your reply! I will take your suggestions into consideration and keep trying to work on this problem! thanks! – stats_noob May 01 '23 at 01:00

1 Answers1

4

I don't think this is a common thing with maps. You usually display all the information for all the layers on the legend. However, you should be able to add an onRender function to apply some logic which will only display the legend if the respective control layer is checked:

Working example: https://rpubs.com/Jumble/legends

leaflet(data = nc) %>%
  addProviderTiles(providers$OpenStreetMap) %>%
  addPolygons(fillColor = ~pal(median_income),
              fillOpacity = 0.8,
              weight = 1,
              color = "white",
              popup = ~NAME,
              label = ~NAME,
              group = "Median Income") %>%
  addPolygons(fillColor = ~pal2(median_number_of_kids),
              fillOpacity = 0.8,
              weight = 1,
              color = "white",
              popup = ~NAME,
              label = ~NAME,
              group = "Median Number of Kids") %>%
  addPolygons(fillColor = ~pal3(median_weight),
              fillOpacity = 0.8,
              weight = 1,
              color = "white",
              popup = ~NAME,
              label = ~NAME,
              group = "Median Weight (lbs)") %>%
  addLegend(pal = pal, values = ~median_income, title = "Median Income", position = "bottomright", group="Median Income") %>%
  addLegend(pal = pal2, values = ~median_number_of_kids, title = "Median Number of Kids", position = "bottomright", group="Median Number of Kids") %>%
  addLegend(pal = pal3, values = ~median_weight, title = "Median Weight (lbs)", position = "bottomright", group="Median Weight (lbs)") %>%
  addLayersControl(baseGroups = c("Median Income", "Median Number of Kids", "Median Weight (lbs)"),
                   options = layersControlOptions(collapsed = FALSE)) %>% 
  htmlwidgets::onRender("function(el, x) {
        let map = this;
        let controls = document.getElementsByTagName('input')
        let legends = document.getElementsByClassName('legend') 
        
        function displayLegend(){
          legends[0].style.display = controls[2].checked ? 'block' : 'none'
          legends[1].style.display = controls[1].checked ? 'block' : 'none'
          legends[2].style.display = controls[0].checked ? 'block' : 'none'
        }

        displayLegend()
        map.on('baselayerchange', displayLegend)
  }")

To answer the question in the title, the reason the legend wasn't appearing is because you omitted the addLegend function, although it looks like you realised this in your edits.

Jumble
  • 1,128
  • 4
  • 10
  • @ Jumble: Thank you so much for your answer! If you have time, could you please show me how I might be able to adapt your code to suit the question I posted? Thank you so much! – stats_noob May 04 '23 at 04:51
  • Hi @stats_noob, I've changed to code to match your example. Is this how you want the map to function? – Jumble May 04 '23 at 08:13