#30DayMapChallenge 2021 - Day 26 - Choropleth

scaleup.R

# Create a choropleth of startups in New Zealand
# For #30DayMapChallenge 2021 - Day 26 - Choropleth
#  -- David Friggens, November 2021

library(readr)
library(dplyr)
library(tidyr)
library(stringr)
library(glue)
library(sf)
library(rmapshaper)
library(ggplot2)
library(ggthemes)
library(ggtext)
library(Manu)

FONT <- "Roboto"

# Data --------------------------------------------------------------------

# From https://www.scaleup.nz/data/explore-the-data
# No 'agri and food technologies'? Seems suspect :-/
startups <- 
  read_csv("data/scale_up_by_region.csv") %>% 
  rename(region = Category) %>% 
  pivot_longer(cols = -region,
               names_to = "sector",
               values_to = "startups") %>% 
  group_by(region) %>% 
  summarise(startups = sum(startups, na.rm = TRUE)) %>% 
  ungroup()

# From https://nzdotstat.stats.govt.nz
businesses <- 
  read_tsv("data/TABLECODE7601_Data.tsv") %>% 
  select(region_code = AREA,
         region = Area,
         businesses = `Value  Flags`) %>% 
  mutate(region_code = region_code %>% str_extract("[0-9]+"),
         region = region %>% str_replace_all(" Region|'|-Wanganui", ""))

regions <- 
  read_sf("statsnz/regional-council-2021-clipped-generalised.gpkg") %>% 
  select(region_code = REGC2021_V1_00,
         region_name = REGC2021_V1_00_NAME) %>% 
  ms_simplify(keep = 0.001, keep_shapes = TRUE) %>% 
  inner_join(businesses,
             by = "region_code") %>% 
  inner_join(startups,
             by = "region") %>% 
  mutate(norm_startups = startups / businesses)


# Choropleth --------------------------------------------------------------

COLOUR_HIGH <- get_pal("Kotare")[2]
COLOUR_LOW <- get_pal("Kotare")[3]

info_box <- 
  tibble(
    x = 1325039, y = 5861395,
    label = glue("How many startup companies are there in each region, proportional to the total number of businesses? ",
                 "The most are in ",
                 "<span style='color:{COLOUR_HIGH};'>",
                 "**{regions %>% st_drop_geometry() %>% arrange(-norm_startups) %>% head(2) %>% pull(region) %>% paste(collapse = ' and ')}**",
                 "</span> ",
                 "and the least are in ",
                 "<span style='color:{COLOUR_LOW};'>",
                 "**{regions %>% st_drop_geometry() %>% arrange(norm_startups) %>% head(2) %>% pull(region) %>% paste(collapse = ' and ')}**",
                 "</span>.")
  ) %>% 
  st_as_sf(coords = c("x", "y"),
           crs = st_crs(regions))

gg_regions <- 
  ggplot(regions) +
  geom_sf(aes(fill = norm_startups),
          colour = "white", size = 0.5) +
  scale_fill_steps(low = COLOUR_LOW,
                   high = COLOUR_HIGH,
                   breaks = c(0.0009, 0.002, 0.003, 0.004, 0.005),
                   labels = c("low", "", "", "", "high")) +
  theme_map(base_family = FONT,
            base_size = 18) +
  geom_textbox(data = info_box,
               stat = "sf_coordinates",
               family = FONT,
               aes(geometry = geometry,
                   label = label),
               size = 12,
               width = unit(7, "inch")
               ) +
  guides(fill = guide_colourbar(barwidth = 2, barheight = 20,ticks = FALSE,
                                frame.colour = "black",title.position = "top",
                                label.theme = element_text(family = FONT, size = 24),
                                title.theme = element_blank()
                                )
         )+
  labs(title = "*Scale-Up NZ* Startup Company Density by Region",
       subtitle = "#30DayMapChallenge 2021 - Day 26 - Choropleth",
       caption = "Map: **David Friggens**, @dakvid. Data: **Callaghan Innovation** and **Stats NZ**") +
  theme(plot.title = element_markdown(size = 48),
        plot.subtitle = element_text(size = 32),
        plot.caption = element_markdown(size = 24),
        legend.position = c(0.9, 0.1), #"right",
        plot.background = element_rect(fill = "white", colour = NA))

ggsave(plot = gg_regions,
       "Day_26/Day_26_scaleup.png",
       width = 20, height = 26)