Adding {ggplot2} charts as popups to {leaflet} maps

Author

Charlie Hadley

Published

July 14, 2022

I delivered a talk for the Failed it to Nailed it: Nailing your Data Visualisation: Training Workshop hosted by the Artificial Intelligence for Scientific Discovery Network+ (AI3SD). My talk was my general purpose R is awesome for interactive dataviz.

The workshop had a hackathon where I was asked about adding popup images to {leaflet} map.

library(tidyverse)
── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
✔ ggplot2 3.3.6      ✔ purrr   0.3.5 
✔ tibble  3.1.8      ✔ dplyr   1.0.10
✔ tidyr   1.2.1      ✔ stringr 1.4.1 
✔ readr   2.1.3      ✔ forcats 0.5.2 
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
library(sf)
Linking to GEOS 3.10.2, GDAL 3.4.2, PROJ 8.2.1; sf_use_s2() is TRUE
library(rnaturalearthdata)
library(leaflet)
library(ggtext)
library(leafpop)
library(png)

countries_sf <- countries110 %>% 
  st_as_sf() %>% 
  filter(!is.na(pop_est)) %>% 
  arrange(desc(pop_est))

ranked_pop_est <- countries_sf %>% 
  st_drop_geometry() %>% 
  select(name, pop_est) %>% 
  mutate(rank_pop = row_number()) %>% 
  mutate(name = fct_reorder(name, pop_est)) %>% 
  as_tibble()

make_relative_pop_gg <- function(country, range_size = 5){
  
  rank_of_country <- ranked_pop_est %>% 
    filter(name == country) %>% 
    pull(rank_pop)
 
  if(rank_of_country <= range_size){
    
    with_zoom_rows <- ranked_pop_est %>% 
      mutate(zoom_rows = ifelse(rank_pop %in% 1:range_size, 1, 0))
    
    print(with_zoom_rows)
    
  } else {
    
      if(rank_of_country < { nrow(ranked_pop_est) - range_size }){
    
    with_zoom_rows <- ranked_pop_est %>% 
      mutate(zoom_rows = ifelse(rank_pop %in% c({rank_of_country - floor(range_size / 2)}:rank_of_country,
                                                rank_of_country:{rank_of_country + floor(range_size / 2)}), 1, 0))
    
  }
  
  if(rank_of_country >= { nrow(ranked_pop_est) - range_size }){
    
    with_zoom_rows <- ranked_pop_est %>% 
      mutate(zoom_rows = ifelse(rank_pop %in% {nrow(ranked_pop_est) - range_size + 1}:nrow(ranked_pop_est), 1, 0))
    
  } 
    
  }
  
  with_zoom_rows %>% 
    filter(zoom_rows == 1) %>% 
    ggplot(aes(x = pop_est,
             y = name)) +
    geom_col(aes(fill = ifelse(name == country, "Target country", "Other country")),
             show.legend = FALSE) +
    geom_text(aes(label = scales::ordinal(rank_pop)),
              hjust = 2) +
    scale_fill_manual(values = c("Target country" = "#6495ED",
                                 "Other country" = "grey")) +
    scale_x_continuous(labels = scales::label_number(big.mark = ",")) +
    labs(title = str_glue("<span style='color:#6495ED'>{country} is the {scales::label_ordinal()(rank_of_country)}</span> most populous country in the world"),
         x = "Population",
         y = "") +
    theme_minimal(base_size = 16) +
    theme(plot.title = element_textbox_simple(padding = margin(t = 10))) %>%
    identity()
}


make_relative_pop_gg("United Kingdom") 

list_gg_populous_charts <- countries_sf %>%

  filter(!is.na(pop_est)) %>% 
  arrange(desc(pop_est)) %>% 
  pull(name) %>% 
  map(~make_relative_pop_gg(.x))
# A tibble: 176 × 4
   name             pop_est rank_pop zoom_rows
   <fct>              <dbl>    <int>     <dbl>
 1 China         1338612970        1         1
 2 India         1166079220        2         1
 3 United States  313973000        3         1
 4 Indonesia      240271522        4         1
 5 Brazil         198739269        5         1
 6 Pakistan       176242949        6         0
 7 Bangladesh     156050883        7         0
 8 Nigeria        149229090        8         0
 9 Russia         140041247        9         0
10 Japan          127078679       10         0
# … with 166 more rows
# A tibble: 176 × 4
   name             pop_est rank_pop zoom_rows
   <fct>              <dbl>    <int>     <dbl>
 1 China         1338612970        1         1
 2 India         1166079220        2         1
 3 United States  313973000        3         1
 4 Indonesia      240271522        4         1
 5 Brazil         198739269        5         1
 6 Pakistan       176242949        6         0
 7 Bangladesh     156050883        7         0
 8 Nigeria        149229090        8         0
 9 Russia         140041247        9         0
10 Japan          127078679       10         0
# … with 166 more rows
# A tibble: 176 × 4
   name             pop_est rank_pop zoom_rows
   <fct>              <dbl>    <int>     <dbl>
 1 China         1338612970        1         1
 2 India         1166079220        2         1
 3 United States  313973000        3         1
 4 Indonesia      240271522        4         1
 5 Brazil         198739269        5         1
 6 Pakistan       176242949        6         0
 7 Bangladesh     156050883        7         0
 8 Nigeria        149229090        8         0
 9 Russia         140041247        9         0
10 Japan          127078679       10         0
# … with 166 more rows
# A tibble: 176 × 4
   name             pop_est rank_pop zoom_rows
   <fct>              <dbl>    <int>     <dbl>
 1 China         1338612970        1         1
 2 India         1166079220        2         1
 3 United States  313973000        3         1
 4 Indonesia      240271522        4         1
 5 Brazil         198739269        5         1
 6 Pakistan       176242949        6         0
 7 Bangladesh     156050883        7         0
 8 Nigeria        149229090        8         0
 9 Russia         140041247        9         0
10 Japan          127078679       10         0
# … with 166 more rows
# A tibble: 176 × 4
   name             pop_est rank_pop zoom_rows
   <fct>              <dbl>    <int>     <dbl>
 1 China         1338612970        1         1
 2 India         1166079220        2         1
 3 United States  313973000        3         1
 4 Indonesia      240271522        4         1
 5 Brazil         198739269        5         1
 6 Pakistan       176242949        6         0
 7 Bangladesh     156050883        7         0
 8 Nigeria        149229090        8         0
 9 Russia         140041247        9         0
10 Japan          127078679       10         0
# … with 166 more rows
list_country_names <- countries_sf %>%
  st_drop_geometry() %>% 
  filter(!is.na(pop_est)) %>% 
  arrange(desc(pop_est)) %>% 
  pull(name)

pwalk(list(list_gg_populous_charts, list_country_names),
     ~ggsave(here::here("posts", "2022-07-14_leafpop-for-ggplot2-charts-in-leaflet-popups", "ggplot2-charts", str_glue("{..2}.png")),
             ..1,
             width = 9,
             height = 5,
             bg = "white"))
# Now generate all the charts?!

pal_pop_est <- colorNumeric("viridis", countries_sf$pop_est, na.color = "pink")

img_paths <- list.files("ggplot2-charts/") %>% 
  tibble(file = .) %>% 
  mutate(country = str_remove(file, ".png")) %>% 
  left_join(st_drop_geometry(countries_sf),
            by = c("country" = "name")) %>% 
  select(file, country, pop_est) %>% 
  arrange(desc(pop_est)) %>% 
  mutate(file = here::here("posts", "2022-07-14_leafpop-for-ggplot2-charts-in-leaflet-popups", "ggplot2-charts", str_glue("{file}"))) %>% 
  pull(file)

leaflet() %>% 
  addPolygons(data = countries_sf,
              color = "white",
              weight = 1,
              fillColor = ~pal_pop_est(pop_est),
              group = "pop_est",
              fillOpacity = 1) %>% 
  addPopupImages(img_paths,
                 group = "pop_est",
                 width = 400) %>% 
  addLegend(data = countries_sf,
            pal = pal_pop_est,
            values = ~pop_est)
Warning: sf layer has inconsistent datum (+proj=longlat +ellps=WGS84 +towgs84=0,0,0,0,0,0,0 +no_defs).
Need '+proj=longlat +datum=WGS84'
+−
pop_est
200,000,000400,000,000600,000,000800,000,0001,000,000,0001,200,000,000

Leaflet

Reuse

https://creativecommons.org/licenses/by/4.0/

Citation

BibTeX citation:
@online{hadley2022,
  author = {Charlie Hadley},
  title = {Adding \{Ggplot2\} Charts as Popups to \{Leaflet\} Maps},
  date = {2022-07-14},
  url = {https://visibledata.co.uk/posts/2022-07-14_leafpop-for-ggplot2-charts-in-leaflet-popups},
  langid = {en}
}
For attribution, please cite this work as:
Charlie Hadley. 2022. “Adding {Ggplot2} Charts as Popups to {Leaflet} Maps.” July 14, 2022. https://visibledata.co.uk/posts/2022-07-14_leafpop-for-ggplot2-charts-in-leaflet-popups.