Commit 85cb041d authored by Tom Rushby's avatar Tom Rushby
Browse files

Merge branch 'cartograms-example' into 'master'

Cartograms example

See merge request !3
parents 05b986e5 b14cd27b
# Hex-cartograms examples ----
# https://github.com/VictimOfMaths/Maps/blob/master/WFHCartogram.R
# Using hex-map data from https://github.com/houseofcommonslibrary/uk-hex-cartograms-noncontiguous/
# required packages
library(curl)
library(sf)
library(tidyverse)
# not (yet) required
# library(readxl)
# library(extrafont)
# library(scales)
# library(gtools)
# LA example ----
# Carl Baker's (@carlbaker) Local Authority Hex Cartogram
ltla <- tempfile()
source <- ("https://github.com/houseofcommonslibrary/uk-hex-cartograms-noncontiguous/raw/main/geopackages/LocalAuthorities-lowertier.gpkg")
ltla <- curl_download(url=source, destfile=ltla, quiet=FALSE, mode="wb")
# List layers
st_layers(ltla)
Background <- st_read(ltla, layer="7 Background")
ltladata <- st_read(ltla, layer="4 LTLA-2019")
Groups <- st_read(ltla, layer="2 Groups")
Group_labels <- st_read(ltla, layer="1 Group labels") %>%
mutate(just=if_else(LabelPosit=="Left", 0, 1))
ggplot()+
geom_sf(data=Background %>% filter(Name!="Ireland"), aes(geometry=geom))+
#geom_sf(data=ltladata %>% filter(response=="Total"),
# aes(geometry=geom, fill=prop), colour="Black", size=0.1)+
geom_sf(data=Groups %>% filter(RegionNation!="Northern Ireland"),
aes(geometry=geom), fill=NA, colour="Black") +
geom_sf_text(data=Group_labels, aes(geometry=geom, label=Group.labe,
hjust=just), size=rel(2.4), colour="Black")+
#scale_fill_paletteer_c("pals::ocean.haline", direction=-1,
# name="Proportion ever working from home", limits=c(0,NA),
# labels=label_percent(accuracy=1))+
theme_void()+
theme(plot.title=element_text(face="bold", size=rel(1.5)),
legend.position="top")+
guides(fill = guide_colorbar(title.position = 'top', title.hjust = .5,
barwidth = unit(20, 'lines'), barheight = unit(.5, 'lines')))+
labs(title="Local Authorities Hex-Cartogram",
caption="Cartogram from @carlbaker/House of Commons Library\nPlot by @VictimOfMaths")
# MSOA example ----
ltmsoa <- tempfile()
source <- ("https://github.com/houseofcommonslibrary/uk-hex-cartograms-noncontiguous/raw/main/geopackages/MSOA.gpkg")
ltmsoa <- curl_download(url=source, destfile=ltmsoa, quiet=FALSE, mode="wb")
# List layers using st_layers
st_layers(ltmsoa)
# Create data using st_read to read the layers we need ...
background_msoa <- st_read(ltmsoa, layer="5 Background")
msoa_la_outlines <- st_read(ltmsoa, layer="3 Local authority outlines (2019)")
msoa_data <- st_read(ltmsoa, layer="4 MSOA hex")
msoa_groups <- st_read(ltmsoa, layer="2 Groups")
msoa_group_labels <- st_read(ltmsoa, layer="1 Group labels") %>%
mutate(just=if_else(LabelPosit=="Left", 0, 1))
ggplot()+
geom_sf(data=background_msoa %>% filter(Name!="Ireland"), aes(geometry=geom))+
#geom_sf(data=ltladata %>% filter(response=="Total"),
# aes(geometry=geom, fill=prop), colour="Black", size=0.1)+
geom_sf(data=msoa_data %>% filter(RegionNation!="Northern Ireland"),
aes(geometry=geom), fill=NA, colour="Blue") +
geom_sf(data=msoa_la_outlines %>% filter(RegionNation!="Northern Ireland"),
aes(geometry=geom), fill=NA, colour="Black") +
geom_sf(data=msoa_groups %>% filter(RegionNation!="Northern Ireland"),
aes(geometry=geom), fill=NA, colour="Black") +
geom_sf_text(data=msoa_group_labels, aes(geometry=geom, label=Group.labe,
hjust=just), size=rel(2.4), colour="Black") +
#scale_fill_paletteer_c("pals::ocean.haline", direction=-1,
# name="Proportion ever working from home", limits=c(0,NA),
# labels=label_percent(accuracy=1))+
theme_void()+
theme(plot.title=element_text(face="bold", size=rel(1.5)),
legend.position="top")+
guides(fill = guide_colorbar(title.position = 'top', title.hjust = .5,
barwidth = unit(20, 'lines'), barheight = unit(.5, 'lines')))+
labs(title="Middle-layer Super Output Area (MSOA) Hex-Cartogram",
caption="Cartogram from @carlbaker/House of Commons Library\nPlot by @tom_rushby")
# I cannot find LSOA level hex maps but here's a link with a how-to for creating hex maps
# something to try out! See ...
# https://rpubs.com/langton_/worksheet-extras-03
# https://rpubs.com/Hailstone/326118
# https://rstudio-pubs-static.s3.amazonaws.com/342278_51068843182b41ad9e00dfcc35e65247.html
# Other resources ...
# https://docs.evanodell.com/parlitools/
# ODI Leeds ...
# https://odileeds.github.io/covid-19/LocalAuthorities/hexmap.html
# https://github.com/odileeds/hexmaps
---
title: "Non-contiguous hexograms"
subtitle: "Local Authority and Middle-layer Super Output Area exmaples"
author: "Tom Rushby"
date: "25/06/2021"
output:
bookdown::html_document2: default
---
# Setup
```{r setup}
knitr::opts_chunk$set(echo = TRUE)
knitr::opts_chunk$set(out.width = "100%")
```
```{r requiredPackages}
library(curl)
library(sf)
library(tidyverse)
library(ggplot2)
```
# Introduction
One of the problems associated with mapping area-based data is the often highly variable size of geographical areas. With data such as that provided by Census (OA, LSOA, MSOA etc) representing similar populations, the dominance of the largest areas can lead to mis-interpretation (and potential overlooking of smaller areas). Cartograms have been used to resize areas in accordance with other attributes such as population. For more background and creating hexograms in R see [Hexograms: better maps of area based data](https://rstudio-pubs-static.s3.amazonaws.com/342278_51068843182b41ad9e00dfcc35e65247.html).
# Examples
This example follows an example of creating a non-contiguous hexogram (and re-uses code) by [@VictimOfMaths](https://github.com/VictimOfMaths/Maps/blob/master/WFHCartogram.R) using hex-map geometry from [House of Commons Library](https://github.com/houseofcommonslibrary/uk-hex-cartograms-noncontiguous/).
The first example we will look at is plotting a non-contiguous hexogram of Local Authority areas.
## Local Authority areas
```{r downloadHexMaps}
ltla <- tempfile()
source <- ("https://github.com/houseofcommonslibrary/uk-hex-cartograms-noncontiguous/raw/main/geopackages/LocalAuthorities-lowertier.gpkg")
ltla <- curl_download(url=source, destfile=ltla, quiet=FALSE, mode="wb")
```
The file downloaded is a GeoPackage (.gpkg) file, an SQLite Database container (see http://www.geopackage.org/guidance/getting-started.html for more info.). We can examine the layers contained using the `st_layers()` command from the sf package.
```{r examineGeoLayers, message = FALSE, warning = FALSE}
st_layers(ltla)
```
Next we extract the layers we want using the `st_read` command. [Alternative methods](https://olalladiaz.net/blog/2018/11/02/working-with-gpkg-r/) are available.
```{r extractGeoLayers, message = FALSE, warning = FALSE}
Background <- st_read(ltla, layer="7 Background")
Areas <- st_read(ltla, layer="4 LTLA-2019")
Groups <- st_read(ltla, layer="2 Groups")
Group_labels <- st_read(ltla, layer="1 Group labels") %>%
mutate(just=if_else(LabelPosit=="Left", 0, 1))
```
And finally we can make a plot, for example Figure \@ref(fig:plotLocalAuthorities) note the `Groups` geometry provides County-level grouping of local authorities and an outline (appears bold in the plot below). `Areas` provides the local authority outlines.
```{r plotLocalAuthorities, echo = FALSE, fig.cap="Non-contiguous hexogram of local authorities in Great Britain"}
p <- ggplot()+
geom_sf(data=Background %>% filter(Name!="Ireland"), aes(geometry=geom)) +
geom_sf(data=Areas %>% filter(RegionNation != "Northern Ireland"),
aes(geometry=geom), colour="Black", size=0.2)+
geom_sf(data=Groups %>% filter(RegionNation!="Northern Ireland"),
aes(geometry=geom), fill=NA, colour="Black") +
geom_sf_text(data=Group_labels, aes(geometry=geom, label=Group.labe,
hjust=just), size=rel(2.4), colour="Black") +
theme_void() +
theme(plot.title=element_text(face="bold", size=rel(1.5)),
legend.position="top") +
labs(title="Local Authorities Hex-Cartogram",
caption="Cartogram by House of Commons Library\nPlot by @tom_rushby")
# Labels fall off plot area - expand x axis area
# Get axis range for geo data
# https://stackoverflow.com/questions/7705345/how-can-i-extract-plot-axes-ranges-for-a-ggplot2-object?rq=1
x_limits <- ggplot_build(p)$layout$panel_scales_x[[1]]$range$range
x_limits <- ggplot_build(p)$layout$panel_scales_y[[1]]$range$range
# Expand limits
p + xlim(x_limits[1],x_limits[2])
```
# Middle-layer Super Output Areas
Load GeoPackage file ... this time Middle-layer Super Output Areas (MSOAs) in England and Wales only.
```{r}
msoa <- tempfile()
source <- ("https://github.com/houseofcommonslibrary/uk-hex-cartograms-noncontiguous/raw/main/geopackages/MSOA.gpkg")
msoa <- curl_download(url = source, destfile = msoa, quiet = FALSE, mode = "wb")
```
List layers ...
```{r message = FALSE}
st_layers(msoa)
```
Extract layers ...
```{r message = FALSE, warning = FALSE}
background_msoa <- st_read(msoa, layer="5 Background")
msoa_la_outlines <- st_read(msoa, layer="3 Local authority outlines (2019)")
msoa_data <- st_read(msoa, layer="4 MSOA hex")
msoa_groups <- st_read(msoa, layer="2 Groups")
msoa_group_labels <- st_read(msoa, layer="1 Group labels") %>%
mutate(just=if_else(LabelPosit=="Left", 0, 1))
```
Figure \@ref(fig:plotMSOA) As with the local authority example, `msoa_groups` and `msoa_la_outlines` geometries provide County- and Local Authority-level grouping/outlines (black in the plot below). `msoa_data` provides the MSOA outlines (in blue).
```{r plotMSOA, echo = FALSE, fig.cap="Non-contiguous hexogram of local authorities in Great Britain"}
ggplot()+
geom_sf(data=background_msoa %>% filter(Name!="Ireland"), aes(geometry=geom))+
geom_sf(data=msoa_data %>% filter(RegionNation!="Northern Ireland"),
aes(geometry=geom), fill=NA, colour="Blue") +
geom_sf(data=msoa_la_outlines %>% filter(RegionNation!="Northern Ireland"),
aes(geometry=geom), fill=NA, colour="Black") +
geom_sf(data=msoa_groups %>% filter(RegionNation!="Northern Ireland"),
aes(geometry=geom), fill=NA, colour="Black") +
geom_sf_text(data=msoa_group_labels, aes(geometry=geom, label=Group.labe,
hjust=just), size=rel(2.4), colour="Black") +
theme_void() +
theme(plot.title=element_text(face="bold", size=rel(1.5)),
legend.position="top") +
guides(fill = guide_colorbar(title.position = 'top', title.hjust = .5,
barwidth = unit(20, 'lines'), barheight = unit(.5, 'lines'))) +
labs(title="MSOA Hex-Cartogram",
caption="Cartogram by House of Commons Library\nPlot by @tom_rushby")
```
# Further reading and resources
I cannot find LSOA level hex maps but here's some links with a more info on creating hex maps, something to try out!
* Sam Langton: [Data visualisation in R: extras](https://rpubs.com/langton_/worksheet-extras-03)
* Simon Hailstone: [Playing with the hexmapr and fingertipsR packages](https://rpubs.com/Hailstone/326118)
* Richard Harris: [Hexograms: better maps of area based data](https://rstudio-pubs-static.s3.amazonaws.com/342278_51068843182b41ad9e00dfcc35e65247.html)
Other resources ...
* https://docs.evanodell.com/parlitools/ and https://docs.evanodell.com/parlitools/articles/using-cartograms.html
ODI Leeds ...
* https://odileeds.github.io/covid-19/LocalAuthorities/hexmap.html
* https://github.com/odileeds/hexmaps
This diff is collapsed.
---
title: "LSOA mapping (Solent)"
author: "Thomas W Rushby"
date: "24/06/2021"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(sf) # classes and functions for vector data
library(ggplot2)
library(tidyverse)
```
## Geography
```{r loadGeog}
inf <- here::here("data", "boundaries", "lsoa_solent.shp") # use here to specify the data location
message("Loading LSOA geometry from file")
sf_data <- sf::read_sf(inf)
head(sf_data)
```
Draw the map using leaflet ([useful resource](https://rstudio.github.io/leaflet/)) ...
```{r}
# Useful lookup spatial reference for CRS
# https://spatialreference.org/ref/epsg/27700/
st_coord_sys <- st_crs(sf_data) # check coord system
st_coord_sys # current coord system EPSG: 4326 (is what leaflet wants - good)
# transform the coord system if required
if(st_coord_sys$epsg != 4326){
sf_data <- st_transform(sf_data, "+proj=longlat +datum=WGS84")
}
# Create map (using leaflet) ----
# create popup first (using htmltools)
# by adding a column to sf_data object
library(htmltools)
sf_data$popup_text <-
paste("LSOA code: ","<b>", sf_data$LSOA11CD, "</b>",
'<br/>', 'LSOA: ', '<b>', sf_data$LSOA11NM, '</b>', ' ') %>%
lapply(htmltools::HTML)
# plot map
library(leaflet)
leaflet(sf_data %>% filter(LAD11NM == "Southampton")) %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addPolygons(color = "blue", fillColor = "blue", fillOpacity = 0.2, weight = 1.5, popup = ~(LSOA11NM), # popups clicked
label = ~(popup_text), # define labels
labelOptions = labelOptions( # label options
style = list("font-weight" = "normal", padding = "2px 2px"),
direction = "auto"),
highlight = highlightOptions(
weight = 5,
color = "#666",
fillOpacity = 0.7,
bringToFront = TRUE))
```
## Demand model
Start with current electricity demand ... we have stats for LSOAs from 2019:
```{r loadLSOAdata}
# electricity consumption data at MSOA level (pre downloaded)
inFile <- here::here("data", "energy", "LSOA_Dom_Elec", "LSOA_ELEC_2019.csv")
# fix inFile - use path to file ...
inFile <- "/Users/twr1m15/SotonGitLab/Personal/mapping-with-r/data/energy/LSOA_Dom_Elec/LSOA_ELEC_2019.csv"
lsoa_elecData <- readr::read_csv(inFile)
head(lsoa_elecData)
```
Join to geography data ...
```{r}
sf_data_elec <- left_join(sf_data,lsoa_elecData, by = c("LSOA11CD" = "Lower Layer Super Output Area (LSOA) Code"))
```
And re-draw the map ...
```{r}
# create popup first (using htmltools)
sf_data_elec$popup_text <-
paste("LSOA code: ","<b>", sf_data_elec$LSOA11CD, "</b>",
'<br/>', 'LSOA: ', '<b>', sf_data_elec$LSOA11NM, '</b>',
'<br/>', 'kWh/meter (median): ', '<b>', round(sf_data_elec$`Median domestic electricity consumption \n(kWh per meter)`,0), '</b>', 'kWh') %>%
lapply(htmltools::HTML)
# plot map
qpal <- colorQuantile("Reds", sf_data_elec$`Median domestic electricity consumption \n(kWh per meter)`, n = 9)
leaflet(sf_data_elec %>% filter(LAD11NM == "Southampton")) %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addPolygons(color = ~qpal(`Median domestic electricity consumption \n(kWh per meter)`), fillOpacity = 0.7, weight = 1.5, popup = ~(LSOA11NM), # popups clicked
label = ~(popup_text), # define labels
labelOptions = labelOptions( # label options
style = list("font-weight" = "normal", padding = "2px 2px"),
direction = "auto"),
highlight = highlightOptions(
weight = 3,
color = "Red",
fillOpacity = 1,
bringToFront = TRUE))
```
This diff is collapsed.
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment