Created
July 1, 2018 14:35
-
-
Save jschoeley/8a4e02fee202b9456675c2399ac74693 to your computer and use it in GitHub Desktop.
Bubble-grid-maps in R
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| # 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() |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment