Search code examples
rleafletr-leaflet

Legend Disappearing on Geographic Map of North Carolina?

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))
Solution

  • 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.