Bubble-grid-maps in R

bubble-grid-maps.R

# BUBBLE-GRID-MAPS
# Jonas Schöley (cc-by)

library(eurostat)  # eurostat data
library(tidyverse) # tidy data transformation
library(lubridate) # date and time support
library(sf)        # simple features GIS

# download eurostat data of population counts by NUTS-3 region
euro_pop <-
  get_eurostat('demo_r_pjanaggr3', stringsAsFactors = FALSE) %>%
  filter(sex == 'T',
         str_length(geo) == 5, # NUTS-3
         age == 'TOTAL')

# download geospatial data for NUTS-3 regions
eu_nuts3_sf <-
  get_eurostat_geospatial(output_class = 'sf',
                          resolution = '60', nuts_level = 3)

# divide the european continent into a 150 by 150 cell grid
euro_grid <-
  st_make_grid(eu_nuts3_sf %>% filter(LEVL_CODE == 3), n = 150)

# Population numbers ------------------------------------------------------

# prepare data and plot bubble-grid-map of EU population numbers
eu_nuts3_sf %>%
  # join population counts from 2017 with geodata
  left_join(y = filter(euro_pop, year(time) == 2017),
            by = c('id' = 'geo')) %>%
  select(values) %>%
  # calculate average population in each grid cell while preserving
  # the observed total (extensive = TRUE)
  st_interpolate_aw(to = euro_grid, extensive = TRUE) %>%
  # return centroid coordinates for each grid cell
  st_centroid() %>%
  cbind(st_coordinates(.)) %>%
  # arrange by value to plot lowest values first so that
  # larger bubbles sit on top of smaller ones
  arrange(values) %>%
  # draw a dot at each grid cell and scale it in area
  # according to population size in that cell
  ggplot() +
  geom_point(aes(x = X, y = Y, size = values),
             shape = 21, color = 'white', fill = 'black', show.legend = FALSE) +
  coord_map(ylim = c(30, 73), xlim = c(-15, 45),
            projection = 'albers', lat0 = 50, lat1 = 51) +
  scale_size_area(max_size = 6) +
  theme_void()

# Population change -------------------------------------------------------

# calculate difference in absolute population numbers from 2012 to 2017
euro_pop_diff <-
  euro_pop %>%
  filter(year(time) %in% c(2012, 2017)) %>%
  spread(time, values) %>%
  mutate(pop_diff = `2017-01-01` - `2012-01-01`)

# prepare data and plot bubble-grid-map of EU population change
eu_nuts3_sf %>%
  left_join(y = euro_pop_diff, by = c('id' = 'geo')) %>%
  select(pop_diff) %>%
  st_interpolate_aw(to = euro_grid, extensive = TRUE) %>%
  st_centroid() %>%
  cbind(st_coordinates(.)) %>%
  arrange(abs(pop_diff)) %>%
  # draw a dot at each grid cell and scale it in area according
  # to absolute size of population change and color it according
  # to direction of population change
  ggplot() +
  geom_point(aes(x = X, y = Y,
                 size = abs(pop_diff),
                 fill = ifelse(pop_diff >= 0, 'pos', 'neg')),
             shape = 21, color = 'white', show.legend = FALSE) +
  coord_map(ylim = c(30, 73), xlim = c(-15, 45),
            projection = 'albers', lat0 = 50, lat1 = 51) +
  scale_size_area(max_size = 8) +
  scale_fill_manual(values = c(pos = '#135cb5', neg = '#c90000')) +
  theme_void()