prep deprivation - Wales.r

##
## Bespoke Index of Multiple Deprivation for Wales
##
library(tidyverse)
library(httr)
library(readODS)
library(janitor)
library(Hmisc)

source("load lookup tables.r")
lsoa_ward = load_lookup_lsoa_ward(2017)
lsoa_lad = load_lookup_lsoa_msoa_lad()
lad_17_19 = read_csv("data/LAD 2017 to LAD 2019 codes.csv")  # lookup of Local Authority codes from 2017 to 2019


###############################################################################
## Create an index of multiple deprivation for income, employment, barriers and environment
## - using weighting on page 4 of https://gov.wales/sites/default/files/statistics-and-research/2020-02/welsh-index-multiple-deprivation-2019-technical-report.pdf
##
# download 'WIMD 2019 Index and domain scores by small area' from https://gov.wales/welsh-index-multiple-deprivation-full-index-update-ranks-2019
GET("https://gov.wales/sites/default/files/statistics-and-research/2019-12/wimd-2019-index-and-domain-scores-by-small-area_0.ods",
    write_disk(tf <- tempfile(fileext = ".ods")))

imd_wal_scores = read_ods(tf, sheet = "Data", skip = 2)
unlink(tf); rm(tf)

# create the mutiple deprivation index, using recommended weightings
# uncomment the commented lines to replicate the full IMD, to check this process works (it does)
imd_wal_covid = imd_wal_scores %>% 
  select(LSOA11CD = `LSOA Code`, Income, Employment, Barriers = `Access to Services`, Housing, Environment = `Physical Environment`) %>% 
  
  # rather than re-weight based on a subset of domains, the guidance says to set weighting for unused domains to zero, so we'll use the original weights here
  mutate(IMD_score = (Income * 23.5) + (Employment * 23.5) + (Barriers * 10) + (Housing * 5) + (Environment * 5)) %>% 
  
  # calculate IMD rank
  mutate(IMD_rank = nrow(imd_wal_scores) - rank(IMD_score) + 1) %>%   # need to reverse the scoring of R's ranking algorithm to get the same style of ranking as in IMD; add 1 to make it not zero-based
  
  # calculate IMD decile
  mutate(IMD_decile = as.integer(cut2(IMD_rank, g = 10)),
         IMD_quintile = as.integer(cut2(IMD_rank, g = 5)))

write_csv(imd_wal_covid, "output/covid-deprivation-wales-LSOA.csv")


###############################################################################
## Calculate proportion of the most-deprived LSOAs in each ward
##
imd_wal_covid_ward = imd_wal_covid %>% 
  left_join(lsoa_ward, by = "LSOA11CD") %>% 
  
  # label LSOAs by whether they're in top 20% most-deprived then summarise by this label
  mutate(IMD_top20 = ifelse(IMD_decile <= 2, "Top20", "Other")) %>% 
  tabyl(WD17CD, IMD_top20) %>% 
  
  # calculate proportion of most deprived LSOAs
  mutate(Prop_top20 = Top20 / (Top20 + Other)) %>% 
  
  # split into quintiles
  #mutate(Deprivation_q = as.integer(cut2(Prop_top20, g = 5))) %>% 
  brclib::add_risk_quantiles("Prop_top20", "Deprivation", quants = 5, highest.number.is.worst = FALSE) %>% 
  select(WD17CD, Prop_top20, Deprivation_q)

write_csv(imd_wal_covid_ward, "output/covid-deprivation-wales-ward.csv")


###############################################################################
## Calculate proportion of the most-deprived LSOAs in each Local Authority
##
imd_wal_covid_lad = imd_wal_covid %>% 
  left_join(lsoa_lad, by = "LSOA11CD") %>% 
  left_join(lad_17_19, by = "LAD17CD") %>% 
  
  # label LSOAs by whether they're in top 20% most-deprived then summarise by this label
  mutate(IMD_top20 = ifelse(IMD_decile <= 2, "Top20", "Other")) %>% 
  tabyl(LAD19CD, IMD_top20) %>% 
  
  # calculate proportion of most deprived LSOAs
  mutate(Prop_top20 = Top20 / (Top20 + Other)) %>% 
  
  # split into quintiles
  mutate(Deprivation_q = as.integer(cut2(Prop_top20, g = 5))) %>% 
  
  select(-Other, -Top20)

write_csv(imd_wal_covid_lad, "output/covid-deprivation-wales-LA.csv")

rm(imd_wal_scores, lsoa_ward, lsoa_lad, lad_17_19)