Mapping multiple trends with confidence
[This article was first published on r.iresmi.net, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
We will use dplyr::nest to create a list-column and will apply a model (with purrr::map) to each row, then we will extract each slope and its p-value with map and broom::tidy.
Setup
library(tidyverse) library(httr) library(sf) library(readxl) library(janitor) library(fs) library(broom) library(scales) library(rnaturalearth) library(rnaturalearthdata) library(rgeos) fk <- function(x) format(x, big.mark = " ")
Data
Map data. Départements polygons from OSM.
if(!file_exists("departements-20140528-100m.shp")) { f <- tempfile() GET("http://osm13.openstreetmap.fr/~cquest/openfla/export/departements-20140528-100m-shp.zip", write_disk(f)) unzip(f) } dep <- st_read("departements-20140528-100m.shp")
Population data by département 1990-2008 from INSEE.
if(!file_exists("pop.xls")) { GET("https://www.insee.fr/fr/statistiques/fichier/2012713/TCRD_004.xls", write_disk("pop.xls")) } pop <- read_xls("pop.xls", skip = 3) %>% clean_names() %>% head(-1) %>% rename(insee_dep = x1, dep = x2, x2018 = x2018_p) %>% select(-4) %>% gather(annee, pop, 3:7) %>% mutate(annee = as.integer(str_replace(annee, "x", "")))
Population trends for each département
pop_model <- function(df) { lm(pop ~ annee, data = df) } trends <- pop %>% group_by(insee_dep, dep) %>% nest() %>% mutate(model = map(data, pop_model), glance = map(model, glance), coeff = map(model, tidy, conf.int = TRUE))
Plot
trends %>% unnest(coeff) %>% filter(term == "annee", !insee_dep %in% c("F", "M")) %>% ggplot(aes(fct_reorder(insee_dep, estimate), estimate, color = if_else(p.value <= .05, if_else(estimate >= 0, "positive", "négative"), "n.s."))) + geom_point() + geom_errorbar(aes(ymin = conf.low, ymax = conf.high), width = .5) + scale_color_manual(name = "Tendance", values = c("positive" = "red", "n.s." = "lightgray", "négative" = "blue")) + scale_y_continuous(labels = fk) + labs(title = "Évolution des populations départementales françaises", subtitle = "1990-2018", x = "dép.", y = bquote(Delta[population] ~ (habitant %.% an^{-1})), caption = "r.iresmi.net\ndonnées INSEE") + guides(color = guide_legend(reverse = TRUE)) + theme(plot.caption = element_text(size = 7))
Map
pop_dep <- trends %>% unnest(coeff) %>% filter(term == "annee") %>% right_join(dep, by = c("insee_dep" = "code_insee")) %>% left_join(filter(pop, annee == 2018, !insee_dep %in% c("F", "M")), by = "insee_dep") %>% st_as_sf() %>% st_transform(2154) moy_fr <- trends %>% unnest(coeff) %>% filter(term == "annee", !insee_dep %in% c("F", "M")) %>% summarise(mean(estimate, na.rm = TRUE)) %>% pull() world <- ne_countries(scale = "medium", returnclass = "sf") %>% filter(continent == "Europe") %>% st_transform(2154) pop_dep %>% ggplot() + geom_sf(data = world, fill = "grey97", color = 0) + geom_sf(color = "lightgrey", fill = "floralwhite", size = .2) + stat_sf_coordinates(data = filter(pop_dep, p.value > .05), aes(size = pop), fill = "lightgrey", color = "lightgrey", shape = 21, alpha = 0.8) + stat_sf_coordinates(data = filter(pop_dep, p.value <= .05), aes(size = pop, fill = estimate), color = "lightgrey", shape = 21, alpha = 0.8) + coord_sf(xlim = c(100000, 1200000), ylim = c(6000000, 7200000)) + scale_fill_gradient2(name = bquote(atop(displaystyle(atop(Delta ~ population[1990-2018], (habitant %.% an^{-1}))), moy. == .(round(moy_fr)) ~ ", en gris : n.s.")), labels = fk, low = "darkblue", mid = "white", high = "darkred", midpoint = moy_fr) + scale_size_area(name = "habitants (2018)", labels = fk, max_size = 10) + labs(title = "Évolution des populations départementales françaises", subtitle = "Métropole, 1990-2018", x = "", y = "", caption = "r.iresmi.net\ndonnées INSEE 2018\nfond cartographique : contributeurs Openstreetmap 2014\nNaturalearth") + theme_bw() + theme(plot.caption = element_text(size = 7), legend.text.align = 1)
To leave a comment for the author, please follow the link and comment on their blog: r.iresmi.net.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.