#30DayMapChallenge 2021 - Day 12 - Population

hb_3d.R

# Create a 3d plot of Napier-Hastings population density
# for #30DayMapChallenge 2021 - Day 12 - Population
#   -- David Friggens, November 2021

# Really helped by Iva Brunec to get this to work!
# https://github.com/ivabrunec/30daymapchallenge/blob/main/scripts/day11_3D.R

# Data preparation more general to allow more areas to be done,
# easily adapting this from the Day 11 map.

library(readr)
library(dplyr)
library(stringr)
library(sf)
library(ggplot2)
library(rayshader)
library(wesanderson)

COL_PAL <- wes_palette("FantasticFox1")
COL_BG <- COL_PAL[3]
COL_HI <- COL_PAL[1]
COL_LO <- COL_PAL[2]
COL_GR <- COL_PAL[1]

# from nzdotstat.stats.govt.nz
pop <- 
  read_tsv("population/population_sa2.tsv") %>% 
  filter(YEAR == 2021) %>% 
  select(area_code = AREA,
         area_name = Area,
         population = `Value  Flags`) %>% 
  mutate(area_code = area_code %>% as.integer())


# from datafinder.stats.govt.nz
concordance <- 
  read_csv("statsnz/geographic-areas-table-2021.csv") %>% 
  distinct(TA2021_code, TA2021_name,
           UR2021_code, UR2021_name,
           IUR2021_name,
           SA22021_code, SA22021_name) %>% 
  select(ta_name = TA2021_name,
         urban_name = UR2021_name,
         urban_type = IUR2021_name,
         area_code = SA22021_code,
         area_name = SA22021_name) %>% 
  mutate(area_code = area_code %>% as.integer())


# from datafinder.stats.govt.nz
sa2 <- 
  read_sf("statsnz/statistical-area-2-2021-clipped-generalised.gpkg") %>% 
  select(area_code = SA22021_V1_00,
         land_area = LAND_AREA_SQ_KM) %>% 
  mutate(area_code = area_code %>% as.integer()) %>% 
  inner_join(pop,
             by = "area_code") %>% 
  mutate(density = population / land_area)


# Napier+Hastings ----

hb_sa2 <- 
  sa2 %>% 
  semi_join(concordance %>% 
              filter(ta_name %in% c("Napier City", "Hastings District"))) %>% 
  # Get rid of the large rural areas
  filter(! area_code %in%
           c(208000L, 208100L, 208200L, 208700L, 212200L))

gg_hb <-
  ggplot() +
  geom_sf(data = hb_sa2,
          aes(fill = density),
          color = COL_GR,
          size = .25) +
  scale_fill_gradientn(colors=c(COL_LO, COL_HI)) +
  theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
        axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank(), legend.position="",
        legend.key.height = unit(.15, 'cm'), 
        legend.key.width = unit(.4, 'cm'),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        plot.margin = unit(c(t=4,r=4,b=4,l=4), "cm"),
        plot.background=element_rect(fill = COL_BG, color=NA),
        panel.background = element_rect(fill = COL_BG, color=NA))

plot_gg(gg_hb,
        width = 7,
        height = 5,
        scale = 90,
        windowsize = c(1600,866),
        zoom = 0.16, phi = 50, theta=0,  sunangle = 30)

render_snapshot('Day_12/Day_12_Napier-Hastings_population_density.png', clear = F)