Create Dorling Cartograms of NZ election results

readme.txt

The idea for these seemed pretty straightforward in my mind, but they took me much longer than I expected to get right.
I did intend to write a blog post about them, and may still do, but until then I thought I'd throw the code up in a gist.
It's not well commented and possibly not intuitive, but it's better than nothing.
Happy to take questions on it, but it's been a year and I'm not sure how much detail I remember. :-)
-- David Friggens, November 2021

Electorate boundary data from Stats NZ Datafinder.
Voting results RDS files from https://github.com/dakvid/election2020/tree/main/data

Main points that I recall:
- I simply shifted the coordinates to get three NZ's, rather than stitch with patchwork etc
- Since it's a cartogram I just jointed the General and Māori electorates together
- I had to experiment with shifting Northland/Auckland up and South Island down to get a more geographic feel after the cartogram blows up the cities

dorling.R

# Create Dorling Cartograms of NZ election results
# For #30DayMapChallenge 2020 days 5-9
# -- David Friggens, November 2020

library(magrittr)
library(glue)
library(readr)
library(dplyr)
library(tidyr)
library(sf)
library(rmapshaper)
library(ggplot2)
library(cartogram)
source("theme_nz_dorling.R")

pnc <- . %>% prettyNum(big.mark = ",")
pnd <- . %>% sprintf(fmt = '%#.1f')

# Constants ---------------------------------------------------------------

SHIFT_NZ_LEFT <- c(-1200000, 0)
SHIFT_AUCKLAND_UP <- c(0, 180000)
SHIFT_SOUTH_DOWN <- c(-10000, -60000)
CRS_NZ <- 2193
CRS_MERCATOR <- "+proj=longlat +datum=WGS84"


electorates <-
  read_csv("electorates/electorates.csv")


# Votes -------------------------------------------------------------------

GED2020 <-
  readRDS("../election2020/data/GE2020.rds") %>% 
  filter(VotingType == "Party",
         Party != "Informal Party Votes") %>% 
  transmute(year = 2020L,
            id = as.integer(id),
            party = Party,
            votes = Votes)

GED2017 <- 
  readRDS("../election2020/data/GE2017.rds") %>% 
  filter(VotingType == "Party",
         Party != "Informal Party Votes") %>% 
  transmute(year = 2017L,
            id = id_14,
            party = Party,
            votes = Votes)

GED2014 <- 
  readRDS("../election2020/data/GE2014.rds") %>% 
  filter(VotingType == "Party",
         Party != "Informal Party Votes") %>% 
  transmute(year = 2014L,
            id = id_14,
            party = Party,
            votes = Votes)

get_party_votes <- function(party_name) {
  bind_rows(
    GED2020 %>% 
      filter(party == party_name) %>% 
      select(-party),
    GED2017 %>% 
      filter(party == party_name) %>% 
      select(-party),
    GED2014 %>% 
      filter(party == party_name) %>% 
      select(-party)
  )
}

electorate_names <- 
  bind_rows(
    electorates %>% 
      transmute(year = 2020L,
                id,
                electorate_name),
    electorates %>% 
      transmute(year = 2017L,
                id = id_14,
                electorate_name = electorate_name_14) %>% 
      drop_na(),
    electorates %>% 
      transmute(year = 2014L,
                id = id_14,
                electorate_name = electorate_name_14) %>% 
      drop_na()
  )

get_party_stats <- function(party_name) {
  
  electorate_stats <- 
    bind_rows(GED2020,
              GED2017,
              GED2014) %>% 
    group_by(year, id) %>% 
    summarise(electorate_party = sum(if_else(party == party_name, votes, 0)),
              electorate_total = sum(votes)) %>% 
    ungroup() %>% 
    inner_join(electorate_names,
               by = c("year", "id"))
  
  nz_stats <- 
    electorate_stats %>% 
    group_by(year) %>% 
    summarise(nz_party = sum(electorate_party),
              nz_total = sum(electorate_total)) %>% 
    ungroup() %>% 
    mutate(nz_pc = round(100 * nz_party / nz_total, 1))
  
  high_stats <- 
    electorate_stats %>% 
    group_by(year) %>% 
    filter(electorate_party == max(electorate_party)) %>% 
    filter(electorate_total == min(electorate_total)) %>% 
    ungroup() %>% 
    transmute(year,
              high_name = electorate_name,
              high_party = electorate_party,
              high_total = electorate_total,
              high_pc = round(100 * high_party / high_total, 1))
  
  low_stats <- 
    electorate_stats %>% 
    group_by(year) %>% 
    filter(electorate_party == min(electorate_party)) %>% 
    filter(electorate_total == max(electorate_total)) %>% 
    ungroup() %>% 
    transmute(year,
              low_name = electorate_name,
              low_party = electorate_party,
              low_total = electorate_total,
              low_pc = round(100 * low_party / low_total, 1))
  
  stats <- 
    nz_stats %>% 
    inner_join(high_stats, by = "year") %>% 
    inner_join(low_stats, by = "year") %>% 
    transmute(year,
              stats_text = glue("New Zealand: {pnc(nz_party)} ({pnd(nz_pc)}%)\n",
                                "{high_name}: {pnc(high_party)} ({pnd(high_pc)}%)\n",
                                "{low_name}: {pnc(low_party)} ({pnd(low_pc)}%)"))
  
  return(stats)
}



votes_labour <- get_party_votes("Labour Party")
votes_green <- get_party_votes("Green Party")
votes_national <- get_party_votes("National Party")
votes_act <- get_party_votes("ACT New Zealand")
votes_nzf <- get_party_votes("New Zealand First Party")

stats_labour <- get_party_stats("Labour Party")
stats_green <- get_party_stats("Green Party")
stats_national <- get_party_stats("National Party")
stats_act <- get_party_stats("ACT New Zealand")
stats_nzf <- get_party_stats("New Zealand First Party")



  

# Geography ---------------------------------------------------------------

simplify_and_remove_chatham_islands <- . %>%
  ms_simplify() %>%
  st_transform(crs = CRS_MERCATOR) %>%
  st_crop(c(xmax = 180, xmin = 100, ymin = -60, ymax = -30)) %>%  # Chatham Islands!
  st_transform(crs = 2193)

med20 <-
  read_sf("electorates/statsnzmaori-electorates-2020-GPKG/maori-electorates-2020.gpkg") %>%
  mutate(id = MED2020_V1_00 %>%
           as.numeric() %>%
           add(65)) %>%
  select(id) %>%
  simplify_and_remove_chatham_islands()
ged20 <-
  read_sf("electorates/statsnzgeneral-electorates-2020-GPKG/general-electorates-2020.gpkg") %>%
  mutate(id = GED2020_V1_00 %>%
           as.numeric()) %>%
  select(id) %>%
  simplify_and_remove_chatham_islands()
med14 <-
  read_sf("electorates/statsnzmaori-electoral-district-2014-GPKG/maori-electoral-district-2014.gpkg") %>%
  mutate(id_14 = MED2014_V1_00 %>%
           as.numeric() %>%
           add(64)) %>%
  select(id_14) %>%
  simplify_and_remove_chatham_islands()
ged14 <-
  read_sf("electorates/statsnzgeneral-electoral-district-2014-GPKG/general-electoral-district-2014.gpkg") %>%
  mutate(id_14 = GED2014_V1_00 %>%
           as.numeric()) %>%
  select(id_14) %>%
  simplify_and_remove_chatham_islands()


geography_2020 <-
  bind_rows(
    ged20,
    med20
  ) %>%
  mutate(year = 2020L) %>%
  inner_join(electorates, by = "id") %>%
  mutate(id = as.integer(id)) %>%
  select(year,
         id,
         abbr,
         electorate_name,
         region)

geography_2014 <-
  bind_rows(
    ged14,
    med14
  ) %>%
  mutate(year = 2014L) %>%
  inner_join(electorates, by = "id_14") %>%
  mutate(id = as.integer(id_14)) %>%
  select(year,
         id,
         abbr = abbr_14,
         electorate_name = electorate_name_14,
         region)

geography_2017 <-
  geography_2014 %>%
  mutate(year = 2017L,
         geom = st_geometry(geography_2014) + SHIFT_NZ_LEFT) %>%
  st_set_crs(CRS_NZ) # gets dropped

geography_2014 <-
  geography_2014 %>%
  mutate(geom = st_geometry(geography_2017) + SHIFT_NZ_LEFT) %>%
  st_set_crs(CRS_NZ)


full_geography <-
  bind_rows(
    geography_2020,
    geography_2017,
    geography_2014
  )

split_north <-
  full_geography %>%
  filter(region %in% c("Northland", "Auckland"))
split_south <-
  full_geography %>%
  filter(region == "South Island")
split_central <-
  full_geography %>%
  filter(! region %in% c("Northland", "Auckland", "South Island"))

full_split_geography <-
  bind_rows(
    split_north %>%
      mutate(geom = st_geometry(split_north) + SHIFT_AUCKLAND_UP),
    split_central,
    split_south %>%
      mutate(geom = st_geometry(split_south) + SHIFT_SOUTH_DOWN)
  ) %>%
  st_set_crs(CRS_NZ)




# Labels ------------------------------------------------------------------

year_label_2020 <- 
  tibble(
    year = "2020",
    longitude = 170.21,
    latitude = -38.23
  ) %>% 
  st_as_sf(coords = c("longitude", "latitude"),
           crs = CRS_MERCATOR,
           agr = "constant") %>% 
  st_transform(crs = CRS_NZ)

year_labels <- 
  bind_rows(
    year_label_2020,
    year_label_2020 %>% 
      mutate(year = "2017",
             geometry = st_geometry(year_label_2020) + SHIFT_NZ_LEFT),
    year_label_2020 %>% 
      mutate(year = "2014",
             geometry = st_geometry(year_label_2020) + SHIFT_NZ_LEFT + SHIFT_NZ_LEFT)
  ) %>% 
  st_set_crs(CRS_NZ)


vote_label_2020 <- 
  tibble(
    year = 2020L,
    longitude = 172.2,
    latitude = -46.6
  ) %>% 
  st_as_sf(coords = c("longitude", "latitude"),
           crs = CRS_MERCATOR,
           agr = "constant") %>% 
  st_transform(crs = CRS_NZ)

vote_labels <- 
  bind_rows(
    vote_label_2020,
    vote_label_2020 %>% 
      mutate(year = 2017L,
             geometry = st_geometry(vote_label_2020) + SHIFT_NZ_LEFT),
    vote_label_2020 %>% 
      mutate(year = 2014L,
             geometry = st_geometry(vote_label_2020) + SHIFT_NZ_LEFT + SHIFT_NZ_LEFT)
  ) %>% 
  st_set_crs(CRS_NZ)




# Map functions ------------------------------------------------------------

produce_map <- 
  function(my_party = NULL,
           my_file = NULL,
           my_geography = NULL,
           my_votes = NULL,
           my_stats = NULL,
           my_colour = "#ff6600",
           my_width = 30,
           my_height = 13.84,
           my_dorling_k = 0.2,
           my_background = "#000000") {
    
    stopifnot(!is.null(my_party) & !is.null(my_file) & !is.null(my_geography) & !is.null(my_votes) & !is.null(my_stats))
    
    oh_my_dorling <- 
      my_geography %>% 
      inner_join(my_votes, by = c("year", "id")) %>% 
      cartogram_dorling("votes", k = my_dorling_k)
    
    g_dorling_full <- 
      ggplot(oh_my_dorling) +
      geom_sf(color = "black",
              fill = my_colour,
              size = 0.2) +
      geom_sf_text(data = oh_my_dorling %>% 
                     filter(votes / max(votes) > if_else(my_dorling_k > 0.25, 0.1, 0.17)),
                   aes(label = abbr),
                   color = if_else(my_background == "#ffffff", my_background, "#000000")) +
      geom_sf_text(data = year_labels,
                   aes(label = year),
                   color = my_colour,
                   hjust = 0.5, family = "Nunito Sans",
                   size = 16) +
      geom_sf_text(data = vote_labels %>% 
                     inner_join(my_stats, by = "year"),
                   aes(label = stats_text),
                   color = my_colour,
                   size = 7,
                   family = "Nunito Sans",
                   hjust = 0) +
      coord_sf(datum = NA) +
      labs(title = glue("New Zealand Elections: Votes for the {my_party} by electorate"),
           caption = "#30DayMapChallenge 2020, David Friggens, @dakvid") +
      theme_nz_dorling(colour_foreground = my_colour,
                       colour_background = my_background)
    
    ggsave(plot = g_dorling_full,
           path = "colours", filename = glue("{my_file}.png"), device = "png",
           width = my_width, height = my_height, dpi = 72)
  }

# Green ----------------------------------------------------------------

green_colour <- "#2CC84D"

produce_map("Green Party", "green_full",
            full_geography,
            votes_green, stats_green, green_colour,
            my_dorling_k = 0.3)
produce_map("Green Party", "green_split",
            full_split_geography,
            votes_green, stats_green, green_colour,
            30, 16.26,
            my_dorling_k = 0.3)
produce_map("Green Party", "07_green",
            full_geography,
            votes_green, stats_green, green_colour,
            30, 14.12,
            my_dorling_k = 0.3)

# ACT ---------------------------------------------------------------------

act_colour <- "#FFD100"

produce_map("ACT Party", "act_full",
            full_geography,
            votes_act, stats_act, act_colour)
produce_map("ACT Party", "act_split",
            full_split_geography,
            votes_act, stats_act, act_colour,
            30, 16.26)
produce_map("ACT Party", "08_act",
            full_geography,
            votes_act, stats_act, act_colour,
            30, 14.27)

# NZF ---------------------------------------------------------------------

nzf_colour <- "#000000"
nzf_bg <- "#ffffff"

produce_map("NZ First Party", "nzf_full",
            full_geography,
            votes_nzf, stats_nzf, nzf_colour,
            my_background = nzf_bg)
produce_map("NZ First Party", "nzf_split",
            full_split_geography,
            votes_nzf, stats_nzf, nzf_colour,
            30, 16.26,
            my_background = nzf_bg)
produce_map("NZ First Party", "09_nzf",
            full_geography,
            votes_nzf, stats_nzf, nzf_colour,
            30, 14.85,
            my_background = nzf_bg)

# National ----------------------------------------------------------------

national_colour <- "#288dcc"

produce_map("National Party", "national_full",
            full_geography,
            votes_national, stats_national, national_colour)
produce_map("National Party", "national_split",
            full_split_geography,
            votes_national, stats_national, national_colour,
            30, 16.26)
produce_map("National Party", "05_national",
            full_split_geography,
            votes_national, stats_national, national_colour,
            30, 16.79)

# Labour ------------------------------------------------------------------

labour_colour <- "#ed0d00" 

produce_map("Labour Party", "labour_full",
            full_geography,
            votes_labour, stats_labour, labour_colour)
produce_map("Labour Party", "labour_split",
            full_split_geography,
            votes_labour, stats_labour, labour_colour,
            30, 16.26)
produce_map("Labour Party", "06_labour",
            full_split_geography,
            votes_labour, stats_labour, labour_colour,
            30, 16.78)

electorates.csv

theme_nz_dorling.R

# adapting hrbrthemes::theme_modern_rc

theme_nz_dorling <- 
function (base_family = "Nunito Sans", base_size = 20, 
          plot_title_family = base_family, plot_title_size = 40, plot_title_face = "bold", 
          plot_title_margin = 10, subtitle_family = "Nunito Sans", 
          subtitle_size = 13, subtitle_face = "plain", subtitle_margin = 15, 
          strip_text_family = base_family, strip_text_size = 12, strip_text_face = "plain", 
          caption_family = "Nunito Sans", 
          caption_size = 16, caption_face = "plain", caption_margin = 10, 
          axis_text_size = base_size, axis_title_family = base_family, 
          axis_title_size = 9, axis_title_face = "plain", axis_title_just = "rt", 
          plot_margin = margin(30, 30, 30, 30), grid = FALSE, axis = FALSE, 
          ticks = FALSE,
          colour_foreground = "#ffffff",
          colour_background = "#000000") 
{
  grid_col <- axis_col <- "#333333"
  ggplot2::update_geom_defaults("point", list(colour = colour_foreground))
  ggplot2::update_geom_defaults("line", list(colour = colour_foreground))
  ggplot2::update_geom_defaults("area", list(colour = colour_foreground, 
                                             fill = colour_foreground))
  ggplot2::update_geom_defaults("rect", list(colour = colour_foreground, 
                                             fill = colour_foreground))
  ggplot2::update_geom_defaults("density", list(colour = colour_foreground, 
                                                fill = colour_foreground))
  ggplot2::update_geom_defaults("bar", list(colour = colour_foreground, 
                                            fill = colour_foreground))
  ggplot2::update_geom_defaults("col", list(colour = colour_foreground, 
                                            fill = colour_foreground))
  ggplot2::update_geom_defaults("sf", list(colour = colour_foreground,
                                           fill = colour_foreground))
  ggplot2::update_geom_defaults("text", list(colour = colour_foreground))
  ret <- ggplot2::theme_minimal(base_family = base_family, 
                                base_size = base_size)
  ret <- ret + theme(legend.background = element_blank())
  ret <- ret + theme(legend.key = element_blank())
  ret <- ret + theme(panel.grid = element_blank())
  ret <- ret + theme(axis.line = element_blank())
  ret <- ret + theme(axis.ticks = element_blank())
  ret <- ret + theme(axis.ticks.x = element_blank())
  ret <- ret + theme(axis.ticks.y = element_blank())
  ret <- ret + theme(axis.text.x = element_blank())
  ret <- ret + theme(axis.text.y = element_blank())
  ret <- ret + theme(axis.title = element_blank())
  ret <- ret + theme(axis.title.x = element_blank())
  ret <- ret + theme(axis.title.y = element_blank())
  ret <- ret + theme(strip.text = element_blank())
  ret <- ret + theme(panel.spacing = grid::unit(2, "lines"))
  ret <- ret + theme(plot.title = element_text(hjust = 0.5, size = plot_title_size, 
                                               margin = margin(b = plot_title_margin), family = plot_title_family, 
                                               face = plot_title_face))
  ret <- ret + theme(plot.subtitle = element_text(hjust = 0.5, 
                                                  size = subtitle_size, margin = margin(b = subtitle_margin), 
                                                  family = subtitle_family, face = subtitle_face))
  ret <- ret + theme(plot.caption = element_text(hjust = 1, 
                                                 size = caption_size, margin = margin(t = caption_margin), 
                                                 family = caption_family, face = caption_face))
  ret <- ret + theme(plot.margin = plot_margin)
  ret <- ret + theme(rect = element_rect(fill = colour_background, color = colour_background)) + 
    theme(plot.background = element_rect(fill = colour_background, color = colour_background)) + 
    theme(panel.background = element_rect(fill = colour_background, 
                                          color = colour_background)) + theme(rect = element_rect(fill = colour_background, 
                                                                                       color = colour_background)) + theme(text = element_text(color = colour_foreground, family = base_family)) + 
    theme(axis.text = element_blank()) + theme(title = element_text(color = colour_foreground, family = base_family)) + 
    theme(plot.title = element_text(color = colour_foreground)) + theme(plot.subtitle = element_text(color = colour_foreground)) + 
    theme(line = element_blank()) + theme(axis.ticks = element_blank())
  ret
}