Showing preview only (2,707K chars total). Download the full file or copy to clipboard to get everything.
Repository: VictimOfMaths/COVID-19
Branch: master
Commit: 715e7c0abe04
Files: 115
Total size: 2.6 MB
Directory structure:
gitextract_eebvnxd3/
├── All Cause Mortality/
│ ├── All Cause Deaths France.R
│ ├── All Cause Deaths Italy.R
│ ├── AllCauseDeaths.R
│ ├── AllCauseDeaths2021.R
│ ├── AllCauseDeathsxAge.R
│ ├── COVIDAgeMortPred.R
│ ├── COVIDCareHomeDeaths.R
│ ├── COVIDDeathsMSOA.R
│ ├── COVIDDeathsxAgeEW.R
│ ├── COVIDDeathsxRegion.R
│ ├── COVIDExcessxLAxCause.R
│ ├── COVIDTotalDeathsPyramid.R
│ ├── EWUSACOVIDDeathsxAgeComparison.R
│ ├── LA All Cause Deaths.R
│ ├── MSOA Deaths.R
│ ├── NRS Excess Deaths by Cause.R
│ ├── ONSDeathsxVaxStatus.R
│ ├── ScottishAllCauseDeathsDetail.R
│ └── readme.md
├── Exposure mapping/
│ ├── COVIDExposures.R
│ ├── SheffieldCOVIDRiskxLSOA.R
│ └── readme.md
├── Heatmaps/
│ ├── COVIDAdmissionsLTLAPhasePlot.R
│ ├── COVIDAdmissionsWithFor.R
│ ├── COVIDAdmissionsxAge.R
│ ├── COVIDAdmissionsxAgeDashboard.R
│ ├── COVIDAgeTrends.R
│ ├── COVIDBivariateCasesxIMD.R
│ ├── COVIDBivariateCasesxVax.R
│ ├── COVIDBoosters.R
│ ├── COVIDBoosters2.R
│ ├── COVIDCFRs.R
│ ├── COVIDCanadaHeatmap.R
│ ├── COVIDCaseCartograms.R
│ ├── COVIDCasesDeathsxIMD.R
│ ├── COVIDCasesLTLAPhasePlot.R
│ ├── COVIDCasesOctHalfTerm.R
│ ├── COVIDCasesPhasePlotHighights.R
│ ├── COVIDCasesSGTFNew.R
│ ├── COVIDCasesSince100k.R
│ ├── COVIDCasesVaxxIMD.R
│ ├── COVIDCasesvsCFR.R
│ ├── COVIDCasesxAgeContours.R
│ ├── COVIDCasesxSex.R
│ ├── COVIDCasesxVaxTadpoles.R
│ ├── COVIDCasesxVaxxAge.R
│ ├── COVIDCycle.R
│ ├── COVIDCycle_US.R
│ ├── COVIDDeathsWithFrom.R
│ ├── COVIDHFRs.R
│ ├── COVIDHKVaxxAge.R
│ ├── COVIDLACaseData.R
│ ├── COVIDLineages.R
│ ├── COVIDMSOACaseRatexIMD.R
│ ├── COVIDMetricsNormalised.R
│ ├── COVIDNHSAbsences.R
│ ├── COVIDNHSAdmissions.R
│ ├── COVIDNHSBolton.R
│ ├── COVIDNHSTrustLakePlots.R
│ ├── COVIDONSDeathIneq.R
│ ├── COVIDONSInfectionSurvey.R
│ ├── COVIDONSInfectionSurveyVariants.R
│ ├── COVIDPHECasesxAgev2.R
│ ├── COVIDPHEPositivity.R
│ ├── COVIDPHESurveillance.R
│ ├── COVIDPHESurveillance2.R
│ ├── COVIDPHEVaxSurveillance.R
│ ├── COVIDPHEVaxxAgexSex.R
│ ├── COVIDPillars.R
│ ├── COVIDReinfections.R
│ ├── COVIDSGTF.R
│ ├── COVIDSpiral.R
│ ├── COVIDSpiralEurope.R
│ ├── COVIDTestingData.R
│ ├── COVIDTotalDeathsPyramid.R
│ ├── COVIDUKUSADeathsxAge.R
│ ├── COVIDUnvaxRisk.R
│ ├── COVIDVaccinationAnimations.R
│ ├── COVIDVaccinationInequalityGB.R
│ ├── COVIDVaccinationMSOACartogram.R
│ ├── COVIDVaccinationPopAndIMD.R
│ ├── COVIDVaccinationStaffCartogram.R
│ ├── COVIDVaccinations.R
│ ├── COVIDVaxHeatmap.R
│ ├── COVIDVaxPyramidxRegion.R
│ ├── COVIDVaxUptakexAge.R
│ ├── COVIDVaxUptakexReg.R
│ ├── COVIDVaxxAgeUKUSA.R
│ ├── COVIDVaxxEthnicityEngScot.R
│ ├── COVIDWaveComparisons.R
│ ├── English LA Heatmaps.R
│ ├── German State Heatmaps.R
│ ├── Irish County Heatmaps.R
│ ├── Misc Case Analysis.R
│ ├── ONSInfectionSurvey.R
│ ├── ScotlandCOVIDCasesxAge.R
│ ├── ScotlandCOVIDHouseParties.R
│ ├── Scottish HB Heatmaps.R
│ ├── UK Hex Animations.R
│ ├── UKIRELA.geojson
│ ├── UKLA.geojson
│ ├── Welsh LA Heatmaps.R
│ ├── WelshLAHeatmap.R
│ ├── YorkshireVaxCartogram.R
│ ├── la_trust_lk.csv
│ └── readme.md
├── Initial Inequality Estimates/
│ ├── Estimated Cases by IMD.R
│ └── readme.md
├── Observed Inequality/
│ ├── COVID-19 vs. Brexit.R
│ ├── COVIDIneqDataSetup.R
│ ├── COVIDScotlandDeathsIneq.R
│ ├── ONS Deaths Ineq 2.R
│ ├── ONS Deaths Ineq.R
│ └── readme.md
└── README.md
================================================
FILE CONTENTS
================================================
================================================
FILE: All Cause Mortality/All Cause Deaths France.R
================================================
rm(list=ls())
library(tidyverse)
library(curl)
library(readxl)
library(lubridate)
library(forcats)
library(ggtext)
library(HMDHFDplus)
library(paletteer)
library(ggthemes)
#Read in historic French mortality data for 2010-18
#Source: https://www.insee.fr/fr/information/4190491
temp <- tempfile()
temp2 <- tempfile()
source <- "https://www.insee.fr/fr/statistiques/fichier/4769950/deces-2010-2018-csv.zip"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
unzip(zipfile=temp, exdir=temp2)
data10 <- read.csv(file.path(temp2, "deces-2010.csv"), sep=";")
data11 <- read.csv(file.path(temp2, "deces-2011.csv"), sep=";")
data12 <- read.csv(file.path(temp2, "deces-2012.csv"), sep=";")
data13 <- read.csv(file.path(temp2, "deces-2013.csv"), sep=";")
data14 <- read.csv(file.path(temp2, "deces-2014.csv"), sep=";")
data15 <- read.csv(file.path(temp2, "deces-2015.csv"), sep=";")
data16 <- read.csv(file.path(temp2, "deces-2016.csv"), sep=";")
data17 <- read.csv(file.path(temp2, "deces-2017.csv"), sep=";")
data <- bind_rows(data10, data11, data12, data13, data14, data15, data16, data17)[,c(2,3,7)]
colnames(data) <- c("sex", "dob", "dod")
#Some dates of Birth, particularly older ones are missing days and months. Allocate these randomly.
data$dob <- as.character(data$dob)
data$yob <- as.numeric(substr(data$dob, 1, 4))
data$dob <- as.Date(data$dob, format=c("%Y%m%d"))
data$temp <- as.Date(paste0(data$yob, "-01-01"))
data$temp2 <- data$temp+round(runif(nrow(data), min=-0.49, max=365.49))
data$dob <- if_else(is.na(data$dob) & data$yob!=0, data$temp2, data$dob)
data$dod <- as.character(data$dod)
#remove very small number of dates of death which are too short
data <- subset(data, nchar(data$dod, type="chars")==8)[,c(1:3)]
data$dod <- as.Date(data$dod, format=c("%Y%m%d"))
data$age <- floor(time_length(difftime(data$dod, data$dob), "years"))
#remove a few other weird cases
data <- subset(data, age>=-1 & age<=120)
#categorise age
data$ageband <- case_when(
data$age<15 ~ "0-14",
data$age<65 ~ "15-64",
data$age<75 ~ "65-74",
data$age<85 ~ "75-84",
TRUE ~ "85+")
#Tidy up sex variable
data$sex <- if_else(data$sex==1, "Male", "Female")
#Bring in deaths data for 2020 from https://www.insee.fr/en/statistiques/4493808?sommaire=4493845 (updated on Fridays)
temp <- tempfile()
temp2 <- tempfile()
source <- "https://www.insee.fr/en/statistiques/fichier/4493808/2020-12-18_detail.zip"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
unzip(zipfile=temp, exdir=temp2)
data18 <- read.csv(file.path(temp2, "DC_2018_det.csv"), sep=";")
data19 <- read.csv(file.path(temp2, "DC_2019_det.csv"), sep=";")
data20 <- read.csv(file.path(temp2, "DC_2020_det.csv"), sep=";")
data1820 <- bind_rows(data18, data19, data20)
#Set up dates
data1820$MNAIS <- as.character(formatC(data1820$MNAIS, width=2, format="d", flag="0"))
data1820$JNAIS <- as.character(formatC(data1820$JNAIS, width=2, format="d", flag="0"))
data1820$dob <- as.Date(paste0(data1820$ANAIS, data1820$MNAIS, data1820$JNAIS), format=c("%Y%m%d"))
data1820$MDEC <- as.character(formatC(data1820$MDEC, width=2, format="d", flag="0"))
data1820$JDEC <- as.character(formatC(data1820$JDEC, width=2, format="d", flag="0"))
data1820$dod <- as.Date(paste0(data1820$ADEC, data1820$MDEC, data1820$JDEC), format=c("%Y%m%d"))
data1820$age <- floor(time_length(difftime(data1820$dod, data1820$dob), "years"))
data1820$sex <- if_else(data1820$SEXE=="M", "Male", "Female")
data1820 <- data1820[,c(12:15)]
#categorise age
data1820$ageband <- case_when(
data1820$age<15 ~ "0-14",
data1820$age<65 ~ "15-64",
data1820$age<75 ~ "65-74",
data1820$age<85 ~ "75-84",
TRUE ~ "85+")
#Check latest date in deaths data aligns with the end of a week
maxdate <- max(data1820$dod)
maxweek <- week(maxdate)
#Merge all years
fulldata <- bind_rows(data, data1820)
fulldata$year <- year(fulldata$dod)
fulldata$week <- week(fulldata$dod+days(1))
#Aggregate to weekly data
aggdata <- fulldata %>%
group_by(ageband, year, week, sex) %>%
filter(year>=2010) %>%
summarise(deaths=n())
#Combines sexes for saving later
data.FR <- aggdata %>%
group_by(ageband, year, week) %>%
summarise(deaths=sum(deaths))
#Save data
write.csv(data.FR, "Data/deaths_age_France.csv")
#Draw overall plot
data.full <- aggdata %>%
group_by(year, week) %>%
summarise(deaths=sum(deaths))
hist.full <- data.full %>%
filter(year!=2020) %>%
group_by(week) %>%
summarise(mean_d=mean(deaths), max_d=max(deaths), min_d=min(deaths))
data.full <- merge(hist.full, subset(data.full, year==2020 & week<=maxweek), all.x=TRUE, all.y=TRUE)
#Calculate excess deaths in 2020 vs. historic mean
excess.full <- data.full %>%
filter(!is.na(deaths)) %>%
summarise(deaths=sum(deaths), mean=sum(mean_d))
excess.full$excess <- excess.full$deaths-excess.full$mean
excess.full$prop <- excess.full$excess/excess.full$mean
tiff("Outputs/ExcessDeathsFrance.tiff", units="in", width=8, height=6, res=300)
ggplot(subset(data.full, week<53))+
geom_ribbon(aes(x=week, ymin=min_d, ymax=max_d), fill="Skyblue2")+
geom_ribbon(aes(x=week, ymin=mean_d, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(aes(x=week, y=mean_d), colour="Grey50", linetype=2)+
geom_line(aes(x=week, y=deaths), colour="Red")+
scale_x_continuous(name="Week number")+
scale_y_continuous("Weekly deaths recorded")+
annotate(geom="text", x=19, y=17000, label=paste0("+", round(excess.full$excess, 0),
" more deaths in 2020 than average (+",
round(excess.full$prop*100, 0),"%)"), colour="Red", hjust=0)+
annotate(geom="text", x=30, y=12000, label="Historic maximum", colour="Skyblue4")+
annotate(geom="text", x=30, y=9200, label="Historic minimum", colour="Skyblue4")+
annotate(geom="text", x=46, y=9200, label="Historic mean", colour="grey30")+
geom_curve(aes(x=48, y=9400, xend=47, yend=11200), colour="grey30", curvature=0.15,
arrow=arrow(length=unit(0.1, "cm"), type="closed"), lineend="round")+
theme_classic()+
theme(plot.subtitle =element_markdown(), plot.title=element_text(face="bold", size=rel(1.2)))+
labs(title="France's 'second wave' has been as deadly as the first",
subtitle="Weekly deaths in <span style='color:red;'>2020</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>.",
caption="Date from Insee | Plot by @VictimOfMaths")
dev.off()
#Calculate 2010-19 average, min and max
hist.data <- aggdata %>%
filter(year!=2020) %>%
group_by(ageband, sex, week) %>%
summarise(mean_d=mean(deaths), max_d=max(deaths), min_d=min(deaths))
aggdata <- merge(hist.data, subset(aggdata, year==2020 & week<=maxweek), all.x=TRUE, all.y=TRUE)
#Calculate excess deaths in 2020 vs. historic mean
excess <- aggdata %>%
group_by(ageband, sex) %>%
filter(!is.na(deaths)) %>%
summarise(deaths=sum(deaths), mean=sum(mean_d))
excess$excess <- excess$deaths-excess$mean
excess$prop <- excess$excess/excess$mean
ann_text <- data.frame(week=rep(18, times=10),
position=c(600,300,1000,1700,1100,1600,1800,2000,5000,3300),
sex=rep(c("Female", "Male"), times=5),
ageband=rep(c("0-14", "15-64", "65-74", "75-84", "85+"), each=2))
tiff("Outputs/ExcessDeathsFrancexAge.tiff", units="in", width=14, height=8, res=300)
ggplot(aggdata)+
geom_ribbon(aes(x=week, ymin=min_d, ymax=max_d), fill="Skyblue2")+
geom_ribbon(aes(x=week, ymin=mean_d, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(aes(x=week, y=mean_d), colour="Grey50", linetype=2)+
geom_line(aes(x=week, y=deaths), colour="Red")+
scale_x_continuous(name="Week number")+
scale_y_continuous("Weekly deaths recorded")+
facet_grid(sex~ageband, scales="free_y")+
geom_text(data=ann_text, aes(x=week, y=position), label=c(
paste0(round(excess[1,5],0)," excess deaths in 2020\nvs. 2010-19 mean (", round(excess[1,6]*100,0),"%)"),
paste0(round(excess[2,5],0)," deaths (", round(excess[2,6]*100,0),"%)"),
paste0(round(excess[3,5],0)," deaths (", round(excess[3,6]*100,0),"%)"),
paste0(round(excess[4,5],0)," deaths (", round(excess[4,6]*100,0),"%)"),
paste0("+",round(excess[5,5],0)," deaths (+", round(excess[5,6]*100,0),"%)"),
paste0("+",round(excess[6,5],0)," deaths (+", round(excess[6,6]*100,0),"%)"),
paste0(round(excess[7,5],0)," deaths (", round(excess[7,6]*100,0),"%)"),
paste0("+",round(excess[8,5],0)," deaths (+", round(excess[8,6]*100,0),"%)"),
paste0("+",round(excess[9,5],0)," deaths (+", round(excess[9,6]*100,0),"%)"),
paste0("+",round(excess[10,5],0)," deaths (+", round(excess[10,6]*100,0),"%)")),
size=3.5, colour="Red", hjust=0)+
theme_classic()+
theme(strip.background=element_blank(), strip.text=element_text(size=rel(1), face="bold"),
plot.subtitle =element_markdown(), plot.title=element_text(face="bold", size=rel(1.2)))+
labs(title="Both 'waves' in France high the oldest age groups hardest",
subtitle="Weekly deaths in <span style='color:red;'>2020</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>.",
caption="Date from Insee | Plot by @VictimOfMaths")
dev.off()
#Find latest year in 2020 data
temp <- fulldata %>%
filter(year==2020) %>%
summarise (maxweek2020=max(week))
maxweek20 <- temp[1,1]
#Collapse data for the pandemic period only
agedata <- fulldata %>%
filter(year>=2010 & week>9 & week<=maxweek20 & age>=0 & age<100) %>%
group_by(age, year, sex) %>%
summarise(deaths=n())
#Import population size
#Bring in French population from HMD (need to register and put your details in here)
username <- ""
password <- ""
FraPop <- readHMDweb(CNTRY="FRATNP", "Exposures_1x1", username, password)
FraPop <- subset(FraPop, Year>=2010)
#Replicate 2017 populations for 2018+
temp <- subset(FraPop, Year==2017)
temp2 <- temp
temp3 <- temp
temp$Year <- 2018
temp2$Year <- 2019
temp3$Year <- 2020
FraPop <- bind_rows(FraPop, temp, temp2, temp3)
FraPop_long <- gather(FraPop, sex, pop, c(3,4))
agedata <- merge(agedata, FraPop_long[,-c(3,4)], by.x=c("sex", "age", "year"), by.y=c("sex", "Age", "Year"))
agedata$mortrate <- agedata$deaths*100000/agedata$pop
#Look at 2010-19 data
olddata <- agedata %>%
filter(year<2020) %>%
group_by(age, sex) %>%
summarise(mean_d=mean(deaths), min_d=min(deaths), max_d=max(deaths), mean_r=mean(mortrate),
min_r=min(mortrate), max_r=max(mortrate))
newdata <- merge(olddata, subset(agedata, year==2020))
newdata$excess <- newdata$mortrate-newdata$mean_r
newdata$propexcess <- newdata$excess/newdata$mean_r
write.csv(newdata, "Data/FrenchDeathsByAge.csv")
newdata <- read.csv("Data/FrenchDeathsByAge.csv")
tiff("Outputs/AgeSpecificDeathsFr.tiff", units="in", width=12, height=7, res=300)
ggplot(newdata)+
geom_ribbon(aes(x=age, ymin=log10(min_r), ymax=log10(max_r)), fill="Skyblue2")+
geom_line(aes(x=age, y=log10(mean_r)), colour="Grey50", linetype=2)+
geom_point(aes(x=age, y=log10(mortrate)), colour="red")+
scale_x_continuous(name="Age", breaks=seq(0,100, by=10))+
scale_y_continuous(name="Log mortality rate\n(deaths/100,000 | base 10)")+
facet_wrap(~sex)+
theme_classic()+
theme(strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
plot.subtitle=element_markdown())+
labs(title="Age-specific mortality rates in France during the pandemic",
subtitle=paste0("Deaths in weeks 9-", maxweek, " in <span style='color:red;'>2020</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>."),
caption="Data from Insee and Human Mortality Database | Plot by @VictimOfMaths")
dev.off()
tiff("Outputs/AgeSpecificDeathsPropFr.tiff", units="in", width=12, height=7, res=300)
ggplot(newdata)+
geom_bar(stat="identity", aes(x=age, y=propexcess, fill=propexcess), show.legend=FALSE)+
scale_fill_paletteer_c("ggthemes::Classic Red-White-Green", direction=-1, limit=c(-1,1)*max(abs(newdata$propexcess)))+
scale_x_continuous(name="Age", breaks=seq(0,100, by=10))+
scale_y_continuous(name="Proportional change in mortality rate in 2020 vs. 2010-19 average",
breaks=seq(-0.5, 1, by=0.5), labels=c("-50%", "0%", "+50%", "+100%"))+
facet_wrap(~sex)+
theme_classic()+
theme(strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
plot.subtitle=element_markdown())+
labs(title="Age-specific variation in mortality rates in France during the pandemic",
subtitle=paste0("Relative change in all-cause mortality rates in weeks 9-", maxweek, " of 2020 versus the average between 2010-19"),
caption="Data from Insee and Human Mortality Database | Plot by @VictimOfMaths")
dev.off()
================================================
FILE: All Cause Mortality/All Cause Deaths Italy.R
================================================
rm(list=ls())
library(tidyverse)
library(curl)
library(paletteer)
library(lubridate)
library(ggtext)
#Download Italian deaths data from Istat (link helpfully provided by @MazzucoStefano)
#From this web page: https://www.istat.it/it/archivio/240401
temp <- tempfile()
temp2 <- tempfile()
source <- "https://www.istat.it/it/files//2020/03/Dataset-decessi-comunali-giornalieri_dati_mortalita_fino_31Ottobre2020.zip"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
unzip(zipfile=temp, exdir=temp2)
rawdata <- read.csv(file.path(temp2, "Dataset decessi comunali giornalieri e tracciato record/comuni_giornaliero_31ottobre.csv"))
#Tidy up data
rawdata$age <- case_when(
rawdata$CL_ETA==0 ~ "0",
rawdata$CL_ETA==1 ~ "1-4",
rawdata$CL_ETA==2 ~ "5-9",
rawdata$CL_ETA==3 ~ "10-14",
rawdata$CL_ETA==4 ~ "15-19",
rawdata$CL_ETA==5 ~ "20-24",
rawdata$CL_ETA==6 ~ "25-29",
rawdata$CL_ETA==7 ~ "30-34",
rawdata$CL_ETA==8 ~ "35-39",
rawdata$CL_ETA==9 ~ "40-44",
rawdata$CL_ETA==10 ~ "45-49",
rawdata$CL_ETA==11 ~ "50-54",
rawdata$CL_ETA==12 ~ "55-59",
rawdata$CL_ETA==13 ~ "60-64",
rawdata$CL_ETA==14 ~ "65-69",
rawdata$CL_ETA==15 ~ "70-74",
rawdata$CL_ETA==16 ~ "75-79",
rawdata$CL_ETA==17 ~ "80-84",
rawdata$CL_ETA==18 ~ "85-89",
rawdata$CL_ETA==19 ~ "90-94",
rawdata$CL_ETA==20 ~ "95-99",
rawdata$CL_ETA==21 ~ "100+")
rawdata$day <- if_else(nchar(rawdata$GE)==3, as.integer(substr(rawdata$GE, 2,3)), as.integer(substr(rawdata$GE, 3,4)))
rawdata$month <- if_else(nchar(rawdata$GE)==3, as.integer(substr(rawdata$GE, 1,1)), as.integer(substr(rawdata$GE, 1,2)))
#Set missing values to NA
rawdata$M_20 <- as.numeric(as.character(rawdata$M_20))
rawdata$F_20 <- as.numeric(as.character(rawdata$F_20))
rawdata$T_20 <- as.numeric(as.character(rawdata$T_20))
data <- pivot_longer(rawdata, c(10:27), names_to=c("sex", "year"), names_sep="_", values_to="deaths")
data$year <- as.numeric(paste0("20", data$year))
data$date <- as.Date(paste0(data$year,"-", data$month, "-", data$day), format="%Y-%m-%d")
#Remove missing dates (weirdly the data has a load of 29th of Februarys in non-leap years)
data <- subset(data, !is.na(data$date))
data$week <- week(data$date)
data$sex <- case_when(
data$sex=="M" ~ "Male",
data$sex=="F" ~ "Female",
TRUE ~ "Total"
)
data$sex <- factor(data$sex, levels=c("Male", "Female", "Total"))
data$age <- factor(data$age, levels=c("0", "1-4", "5-9", "10-14", "15-19", "20-24", "25-29", "30-34", "35-39", "40-44",
"45-49", "50-54", "55-59", "60-64", "65-69", "70-74", "75-79", "80-84", "85-89",
"90-94", "95-99", "100+"))
#Explore missingness in the deaths data
test <- as.data.frame(data)
test$test <- if_else(is.na(data$deaths),0,1)
test <- test %>%
select(date, test) %>%
group_by(date) %>%
summarise(measure=mean(test))
#Looking at this, a clear jump in missingness after 31st October 2020, so censor the data here
cut <- week(as.Date("2020-11-01"))-1
data_prov <- data %>%
filter(sex!="Total" & !(year==2020 & week>cut)) %>%
group_by(age, sex, year, week, NOME_REGIONE, NOME_PROVINCIA) %>%
summarise(deaths=sum(deaths, na.rm=TRUE))
data_reg <- data_prov %>%
group_by(age, sex, year, week, NOME_REGIONE) %>%
summarise(deaths=sum(deaths, na.rm=TRUE))
data_nat <- data_prov %>%
group_by(age, sex, year, week) %>%
summarise(deaths=sum(deaths, na.rm=TRUE))
#Save national level data
write.csv(data_nat, "Data/deaths_age_Italy.csv")
#National plots
tempdata <- data_nat %>%
group_by(year, week) %>%
summarise(deaths=sum(deaths))
#Calculate 2010-19 average, min and max
hist.data <- tempdata %>%
filter(year!=2020) %>%
group_by(week) %>%
summarise(mean_d=mean(deaths), max_d=max(deaths), min_d=min(deaths))
tempdata <- merge(hist.data, subset(tempdata, year==2020), all.x=TRUE, all.y=TRUE)
#Calculate excess deaths in 2020 vs. historic mean
excess <- tempdata %>%
filter(!is.na(deaths)) %>%
summarise(deaths=sum(deaths), mean=sum(mean_d))
excess$excess <- excess$deaths-excess$mean
excess$prop <- excess$excess/excess$mean
#Overall plot
tiff("Outputs/ExcessDeathsItaly.tiff", units="in", width=10, height=8, res=300)
ggplot(subset(tempdata, week<53))+
geom_ribbon(aes(x=week, ymin=min_d, ymax=max_d), fill="Skyblue2")+
geom_ribbon(aes(x=week, ymin=mean_d, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(aes(x=week, y=mean_d), colour="Grey50", linetype=2)+
geom_line(aes(x=week, y=deaths), colour="Red")+
scale_x_continuous(name="Week number")+
scale_y_continuous("Weekly deaths recorded")+
theme_classic()+
theme(plot.subtitle =element_markdown(), plot.title=element_text(face="bold", size=rel(1.2)))+
expand_limits(y=0)+
labs(title="All-cause mortality in Italy during the pandemic",
subtitle="Weekly deaths in <span style='color:red;'>2020</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>.<br>Data up to 31st August 2020.",
caption="Date from ISTAT | Plot by @VictimOfMaths")+
annotate(geom="text", x=20, y=18000, label=paste0("+", round(excess$excess, 0),
" more deaths in 2020 than average (+",
round(excess$prop*100, 0),"%)"), colour="Red", hjust=0)+
annotate(geom="text", x=32, y=15000, label="Historic maximum", colour="Skyblue4")+
annotate(geom="text", x=32, y=10000, label="Historic minimum", colour="Skyblue4")+
annotate(geom="text", x=48, y=11000, label="Historic mean", colour="grey30")+
geom_curve(aes(x=50, y=11300, xend=49, yend=12500), colour="grey30", curvature=0.15,
arrow=arrow(length=unit(0.1, "cm"), type="closed"), lineend="round")
dev.off()
#Plot by sex
tempdata.sex <- data_nat %>%
group_by(year, week, sex) %>%
summarise(deaths=sum(deaths))
#Calculate 2010-19 average, min and max
hist.data.sex <- tempdata.sex %>%
filter(year!=2020) %>%
group_by(week, sex) %>%
summarise(mean_d=mean(deaths), max_d=max(deaths), min_d=min(deaths))
tempdata.sex <- merge(hist.data.sex, subset(tempdata.sex, year==2020), all.x=TRUE, all.y=TRUE)
#Calculate excess deaths in 2020 vs. historic mean
excess.sex <- tempdata.sex %>%
filter(!is.na(deaths)) %>%
group_by(sex) %>%
summarise(deaths=sum(deaths), mean=sum(mean_d))
excess.sex$excess <- excess.sex$deaths-excess.sex$mean
excess.sex$prop <- excess.sex$excess/excess.sex$mean
ann_text <- data.frame(week=rep(cut-20.5, times=2), sex=as.factor(c("Male", "Female")), position=c(9000,9000))
tiff("Outputs/ExcessDeathsItalyxSex.tiff", units="in", width=10, height=8, res=300)
ggplot(subset(tempdata.sex, week<53))+
geom_ribbon(aes(x=week, ymin=min_d, ymax=max_d), fill="Skyblue2")+
geom_ribbon(aes(x=week, ymin=mean_d, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(aes(x=week, y=mean_d), colour="Grey50", linetype=2)+
geom_line(aes(x=week, y=deaths), colour="Red")+
scale_x_continuous(name="Week number")+
scale_y_continuous("Weekly deaths recorded")+
facet_wrap(~sex)+
theme_classic()+
theme(plot.subtitle =element_markdown(), strip.background=element_blank(),
strip.text=element_text(face="bold", size=rel(1)))+
expand_limits(y=0)+
labs(title="Excess deaths are almost twice as high in Italian men compared to women",
subtitle="Weekly deaths in <span style='color:red;'>2020</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>.<br>Data up to 24th June 2020.",
caption="Date from ISTAT | Plot by @VictimOfMaths")+
geom_text(data=ann_text, aes(x=week, y=position),
label=c(paste0(round(excess.sex[1,4],0)," excess deaths in 2020\nvs. 2010-19 mean (+", round(excess.sex[1,5]*100,0),"%)"),
paste0(round(excess.sex[2,4],0)," deaths (+", round(excess.sex[2,5]*100,0),"%)")), colour="Red", size=3.5, hjust=0)
dev.off()
#Plot by region
tempdata.reg <- data_reg %>%
group_by(year, week, NOME_REGIONE) %>%
summarise(deaths=sum(deaths))
#Calculate 2010-19 average, min and max
hist.data.reg <- tempdata.reg %>%
filter(year!=2020) %>%
group_by(week, NOME_REGIONE) %>%
summarise(mean_d=mean(deaths), max_d=max(deaths), min_d=min(deaths))
tempdata.reg <- merge(hist.data.reg, subset(tempdata.reg, year==2020), all.x=TRUE, all.y=TRUE)
#Calculate excess deaths in 2020 vs. historic mean
excess.reg <- tempdata.reg %>%
filter(!is.na(deaths)) %>%
group_by(NOME_REGIONE) %>%
summarise(deaths=sum(deaths), mean=sum(mean_d))
excess.reg$excess <- excess.reg$deaths-excess.reg$mean
excess.reg$prop <- excess.reg$excess/excess.reg$mean
excess.reg$NOME_REGIONE <- fct_reorder(excess.reg$NOME_REGIONE, -excess.reg$prop)
excess.reg <- arrange(excess.reg, NOME_REGIONE)
tempdata.reg$NOME_REGIONE <- factor(tempdata.reg$NOME_REGIONE, levels=levels(excess.reg$NOME_REGIONE))
tempdata.reg <- arrange(tempdata.reg, NOME_REGIONE)
#labpos <- tempdata.reg$mean_d[tempdata.reg$week==cut]*1.5
labpos <- tempdata.reg$mean_d[tempdata.reg$week==cut]*1.5+400
ann_text2 <- data.frame(week=rep(22, times=20), NOME_REGIONE=as.factor(levels(tempdata.reg$NOME_REGIONE)), position=labpos)
tiff("Outputs/ExcessDeathsItalyxReg.tiff", units="in", width=16, height=9, res=300)
ggplot(subset(tempdata.reg, week<53))+
geom_ribbon(aes(x=week, ymin=min_d, ymax=max_d), fill="Skyblue2")+
geom_ribbon(aes(x=week, ymin=mean_d, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(aes(x=week, y=mean_d), colour="Grey50", linetype=2)+
geom_line(aes(x=week, y=deaths), colour="Red")+
scale_x_continuous(name="Week number")+
scale_y_continuous("Weekly deaths recorded")+
#facet_wrap(~NOME_REGIONE, scales="free_y")+
facet_wrap(~NOME_REGIONE)+
theme_classic()+
theme(plot.subtitle =element_markdown(), strip.background=element_blank(),
strip.text=element_text(face="bold", size=rel(1)))+
expand_limits(y=0)+
labs(title="Excess deaths in Italy are very heavily concentrated in the Northern regions",
subtitle="Weekly deaths in <span style='color:red;'>2020</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>.<br>Data up to 24th June 2020.",
caption="Date from ISTAT | Plot by @VictimOfMaths")+
geom_text(data=ann_text2, aes(x=week, y=position),
label=c(paste0(round(excess.reg[1,4],0)," excess deaths in 2020\nvs. 2010-19 mean (+", round(excess.reg[1,5]*100,0),"%)"),
paste0(round(excess.reg[2,4],0)," deaths (+", round(excess.reg[2,5]*100,0),"%)"),
paste0(round(excess.reg[3,4],0)," deaths (+", round(excess.reg[3,5]*100,0),"%)"),
paste0(round(excess.reg[4,4],0)," deaths (+", round(excess.reg[4,5]*100,0),"%)"),
paste0(round(excess.reg[5,4],0)," deaths (+", round(excess.reg[5,5]*100,0),"%)"),
paste0(round(excess.reg[6,4],0)," deaths (+", round(excess.reg[6,5]*100,0),"%)"),
paste0(round(excess.reg[7,4],0)," deaths (+", round(excess.reg[7,5]*100,0),"%)"),
paste0(round(excess.reg[8,4],0)," deaths (+", round(excess.reg[8,5]*100,0),"%)"),
paste0(round(excess.reg[9,4],0)," deaths (", round(excess.reg[9,5]*100,0),"%)"),
paste0(round(excess.reg[10,4],0)," deaths (", round(excess.reg[10,5]*100,0),"%)"),
paste0(round(excess.reg[11,4],0)," deaths (", round(excess.reg[11,5]*100,0),"%)"),
paste0(round(excess.reg[12,4],0)," deaths (", round(excess.reg[12,5]*100,0),"%)"),
paste0(round(excess.reg[13,4],0)," deaths (", round(excess.reg[13,5]*100,0),"%)"),
paste0(round(excess.reg[14,4],0)," deaths (", round(excess.reg[14,5]*100,0),"%)"),
paste0(round(excess.reg[15,4],0)," deaths (", round(excess.reg[15,5]*100,0),"%)"),
paste0(round(excess.reg[16,4],0)," deaths (", round(excess.reg[16,5]*100,0),"%)"),
paste0(round(excess.reg[17,4],0)," deaths (", round(excess.reg[17,5]*100,0),"%)"),
paste0(round(excess.reg[18,4],0)," deaths (", round(excess.reg[18,5]*100,0),"%)"),
paste0(round(excess.reg[19,4],0)," deaths (", round(excess.reg[19,5]*100,0),"%)"),
paste0(round(excess.reg[20,4],0)," deaths (", round(excess.reg[20,5]*100,0),"%)")),
colour="Red", size=3, hjust=0)
dev.off()
#Extract Lazio only
tiff("Outputs/ExcessDeathsLazio.tiff", units="in", width=10, height=8, res=300)
ggplot(subset(tempdata.reg, week<53 & NOME_REGIONE=="Lazio"))+
geom_ribbon(aes(x=week, ymin=min_d, ymax=max_d), fill="Skyblue2")+
geom_ribbon(aes(x=week, ymin=mean_d, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(aes(x=week, y=mean_d), colour="Grey50", linetype=2)+
geom_line(aes(x=week, y=deaths), colour="Red")+
scale_x_continuous(name="Week number")+
scale_y_continuous("Weekly deaths recorded")+
theme_classic()+
theme(plot.subtitle=element_markdown(), plot.title=element_markdown())+
expand_limits(y=0)+
labs(title="All-cause deaths in the Italian capital are <i style='color:black'>lower</i> than in previous years",
subtitle="Weekly deaths in the Lazio region in <span style='color:red;'>2020</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>.<br>Data up to 31st May 2020.",
caption="Date from ISTAT | Plot by @VictimOfMaths")+
annotate(geom="text", x=cut-10, y=850, label=paste0(abs(round(excess.reg[7,4], 0)),
" fewer deaths in 2020 than average (",
round(excess.reg[7,5]*100, 0),"%)"), colour="Red", hjust=0)
dev.off()
================================================
FILE: All Cause Mortality/AllCauseDeaths.R
================================================
rm(list=ls())
library(tidyverse)
library(paletteer)
library(curl)
library(readxl)
library(lubridate)
library(forcats)
library(ggtext)
#A gold star to anyone who can make the range updates for the 3 different Excel files for E&W, Scotland & NI automatic.
#Latest date in the country-specific data
EWDate <- "1st January"
ScotDate <- "3rd January"
NIDate <- "1st January"
#Locations for latest data. Links for historical data don't move, so keep them further down
Eng2020 <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2020/publishedweek532020.xlsx"
Scot2020 <- "https://www.nrscotland.gov.uk/files//statistics/covid19/covid-deaths-data-week-53.xlsx"
#https://data.gov.scot/coronavirus-covid-19/data.html
Scot2020v2 <- "https://data.gov.scot/coronavirus-covid-19/download/Scottish%20Government%20COVID-19%20data%20(28%20October%202020).xlsx"
NI2020 <- "https://www.nisra.gov.uk/sites/nisra.gov.uk/files/publications/Weekly_Deaths.xlsx"
#Stupid Excel range controls
EngRange <- "BC" #increment by one letter each week
ScotRange <- "BC" #
#These next two bookend the range for the weeks inbetween NRS's now monthly reports
ScotRangev2.1 <- "46" #update after each new monthly report
ScotRangev2.2 <- "47" #increment by one number each week
NIRange <- "57" #increment by one number each week
#Flag weeks with an NRS report
NRSweek <- TRUE
#Also need to manually add the next row of data for the deaths by location at the end.
####################################
#Read in English & Welsh data first#
####################################
#The ONS published weekly all-cause deaths data into a new Excel file each week on a Tuesday here:
#https://www.ons.gov.uk/peoplepopulationandcommunity/birthsdeathsandmarriages/deaths/datasets/weeklyprovisionalfiguresondeathsregisteredinenglandandwales
#Start with 2020 - data up to 8th May, updated on 19th May
temp <- tempfile()
temp <- curl_download(url=Eng2020, destfile=temp, quiet=FALSE, mode="wb")
#By age
data2020.age.EW <- read_excel(temp, sheet="Weekly figures 2020", range=paste0("B22:", EngRange, "41"), col_names=FALSE)
colnames(data2020.age.EW) <- c("Age", format(seq.Date(from=as.Date("2020-01-03"), by="7 days",
length.out=ncol(data2020.age.EW)-1), "%d/%m/%y"))
#Compress age bands to match earlier years
data2020.age.EW$age <- case_when(
data2020.age.EW$Age=="<1" ~ "Under 1 year",
data2020.age.EW$Age %in% c("1-4", "5-9", "10-14") ~ "01-14",
data2020.age.EW$Age %in% c("15-19", "20-24", "25-29", "30-34", "35-39", "40-44") ~ "15-44",
data2020.age.EW$Age %in% c("45-49", "50-54", "55-59", "60-64") ~ "45-64",
data2020.age.EW$Age %in% c("65-69", "70-74") ~ "65-74",
data2020.age.EW$Age %in% c("75-79", "80-84") ~ "75-84",
TRUE ~ "85+"
)
data2020.age.EW <- data2020.age.EW %>%
group_by(age) %>%
summarise_at(c(2:(ncol(data2020.age.EW)-1)), sum)
data2020.age.EW$age <- factor(data2020.age.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64",
"65-74", "75-84", "85+"))
data2020.age.EW <- arrange(data2020.age.EW, age)
#By sex
data2020.male.EW <- read_excel(temp, sheet="Weekly figures 2020", range=paste0("B44:", EngRange,"63"), col_names=FALSE)
colnames(data2020.male.EW) <- c("Age", format(seq.Date(from=as.Date("2020-01-03"), by="7 days",
length.out=ncol(data2020.male.EW)-1), "%d/%m/%y"))
data2020.male.EW$sex <- "Male"
data2020.female.EW <- read_excel(temp, sheet="Weekly figures 2020", range=paste0("B66:", EngRange, "85"), col_names=FALSE)
colnames(data2020.female.EW) <- c("Age", format(seq.Date(from=as.Date("2020-01-03"), by="7 days",
length.out=ncol(data2020.female.EW)-1), "%d/%m/%y"))
data2020.female.EW$sex <- "Female"
data2020.sex.EW <- bind_rows(data2020.male.EW, data2020.female.EW)
#Compress age bands to match earlier years
data2020.sex.EW$age <- case_when(
data2020.sex.EW$Age=="<1" ~ "Under 1 year",
data2020.sex.EW$Age %in% c("1-4", "5-9", "10-14") ~ "01-14",
data2020.sex.EW$Age %in% c("15-19", "20-24", "25-29", "30-34", "35-39", "40-44") ~ "15-44",
data2020.sex.EW$Age %in% c("45-49", "50-54", "55-59", "60-64") ~ "45-64",
data2020.sex.EW$Age %in% c("65-69", "70-74") ~ "65-74",
data2020.sex.EW$Age %in% c("75-79", "80-84") ~ "75-84",
TRUE ~ "85+"
)
data2020.sex.EW <- data2020.sex.EW %>%
group_by(age, sex) %>%
summarise_at(c(2:(ncol(data2020.sex.EW)-2)), sum)
data2020.sex.EW$age <- factor(data2020.sex.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64",
"65-74", "75-84", "85+"))
data2020.sex.EW$sex <- factor(data2020.sex.EW$sex, levels=c("Male", "Female"))
data2020.sex.EW <- arrange(data2020.sex.EW, age, sex)
#Add total rows
data2020.sex.EW <- data2020.sex.EW %>%
group_by(sex) %>%
summarise_at(c(2:(ncol(data2020.sex.EW)-1)), sum) %>%
mutate(age="Total") %>%
bind_rows(data2020.sex.EW)
#By region
data2020.reg.EW <- read_excel(temp, sheet="Weekly figures 2020", range=paste0("B87:", EngRange, "96"), col_names=FALSE)
colnames(data2020.reg.EW) <- c("reg", format(seq.Date(from=as.Date("2020-01-03"), by="7 days",
length.out=ncol(data2020.reg.EW)-1), "%d/%m/%y"))
#2019 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2019/publishedweek522019.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age
data2019.age.EW <- read_excel(temp, sheet="Weekly figures 2019", range="B16:BB22", col_names=FALSE)
colnames(data2019.age.EW) <- c("age", format(seq.Date(from=as.Date("2019-01-04"), by="7 days",
length.out=ncol(data2019.age.EW)-1), "%d/%m/%y"))
data2019.age.EW$age <- factor(data2019.age.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64", "65-74",
"75-84", "85+"))
data2019.age.EW <- arrange(data2019.age.EW, age)
#By sex
data2019.male.EW <- read_excel(temp, sheet="Weekly figures 2019", range="B25:BB31", col_names=FALSE)
colnames(data2019.male.EW) <- c("age", format(seq.Date(from=as.Date("2019-01-04"), by="7 days",
length.out=ncol(data2019.male.EW)-1), "%d/%m/%y"))
data2019.male.EW$sex <- "Male"
data2019.female.EW <- read_excel(temp, sheet="Weekly figures 2019", range="B34:BB40", col_names=FALSE)
colnames(data2019.female.EW) <- c("age", format(seq.Date(from=as.Date("2019-01-04"), by="7 days",
length.out=ncol(data2019.female.EW)-1), "%d/%m/%y"))
data2019.female.EW$sex <- "Female"
data2019.sex.EW <- bind_rows(data2019.male.EW, data2019.female.EW)
data2019.sex.EW$age <- factor(data2019.sex.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64",
"65-74", "75-84", "85+"))
data2019.sex.EW$sex <- factor(data2019.sex.EW$sex, levels=c("Male", "Female"))
data2019.sex.EW <- arrange(data2019.sex.EW, age, sex)
#Add total rows
data2019.sex.EW <- data2019.sex.EW %>%
group_by(sex) %>%
summarise_at(c(2:(ncol(data2019.sex.EW)-1)), sum) %>%
mutate(age="Total") %>%
bind_rows(data2019.sex.EW)
#By region
data2019.reg.EW <- read_excel(temp, sheet="Weekly figures 2019", range="B43:BB52", col_names=FALSE)
colnames(data2019.reg.EW) <- c("reg", format(seq.Date(from=as.Date("2019-01-04"), by="7 days",
length.out=ncol(data2019.reg.EW)-1), "%d/%m/%y"))
#2018 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2018/publishedweek522018withupdatedrespiratoryrow.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age
data2018.age.EW <- read_excel(temp, sheet="Weekly figures 2018", range="B16:BB22", col_names=FALSE)
colnames(data2018.age.EW) <- c("age", format(seq.Date(from=as.Date("2018-01-05"), by="7 days",
length.out=ncol(data2018.age.EW)-1), "%d/%m/%y"))
data2018.age.EW$age <- factor(data2018.age.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64", "65-74",
"75-84", "85+"))
data2018.age.EW <- arrange(data2018.age.EW, age)
#By sex
data2018.male.EW <- read_excel(temp, sheet="Weekly figures 2018", range="B25:BB31", col_names=FALSE)
colnames(data2018.male.EW) <- c("age", format(seq.Date(from=as.Date("2018-01-05"), by="7 days",
length.out=ncol(data2018.male.EW)-1), "%d/%m/%y"))
data2018.male.EW$sex <- "Male"
data2018.female.EW <- read_excel(temp, sheet="Weekly figures 2018", range="B34:BB40", col_names=FALSE)
colnames(data2018.female.EW) <- c("age", format(seq.Date(from=as.Date("2018-01-05"), by="7 days",
length.out=ncol(data2018.female.EW)-1), "%d/%m/%y"))
data2018.female.EW$sex <- "Female"
data2018.sex.EW <- bind_rows(data2018.male.EW, data2018.female.EW)
data2018.sex.EW$age <- factor(data2018.sex.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64",
"65-74", "75-84", "85+"))
data2018.sex.EW$sex <- factor(data2018.sex.EW$sex, levels=c("Male", "Female"))
data2018.sex.EW <- arrange(data2018.sex.EW, age, sex)
#Add total rows
data2018.sex.EW <- data2018.sex.EW %>%
group_by(sex) %>%
summarise_at(c(2:(ncol(data2018.sex.EW)-1)), sum) %>%
mutate(age="Total") %>%
bind_rows(data2018.sex.EW)
#By region
data2018.reg.EW <- read_excel(temp, sheet="Weekly figures 2018", range="B43:BB52", col_names=FALSE)
colnames(data2018.reg.EW) <- c("reg", format(seq.Date(from=as.Date("2018-01-05"), by="7 days",
length.out=ncol(data2018.reg.EW)-1), "%d/%m/%y"))
#2017 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2017/publishedweek522017.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age
data2017.age.EW <- read_excel(temp, sheet="Weekly figures 2017", range="B16:BB22", col_names=FALSE)
colnames(data2017.age.EW) <- c("age", format(seq.Date(from=as.Date("2017-01-06"), by="7 days",
length.out=ncol(data2017.age.EW)-1), "%d/%m/%y"))
data2017.age.EW$age <- factor(data2017.age.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64", "65-74",
"75-84", "85+"))
data2017.age.EW <- arrange(data2017.age.EW, age)
#By sex
data2017.male.EW <- read_excel(temp, sheet="Weekly figures 2017", range="B25:BB31", col_names=FALSE)
colnames(data2017.male.EW) <- c("age", format(seq.Date(from=as.Date("2017-01-06"), by="7 days",
length.out=ncol(data2017.male.EW)-1), "%d/%m/%y"))
data2017.male.EW$sex <- "Male"
data2017.female.EW <- read_excel(temp, sheet="Weekly figures 2017", range="B34:BB40", col_names=FALSE)
colnames(data2017.female.EW) <- c("age", format(seq.Date(from=as.Date("2017-01-06"), by="7 days",
length.out=ncol(data2017.female.EW)-1), "%d/%m/%y"))
data2017.female.EW$sex <- "Female"
data2017.sex.EW <- bind_rows(data2017.male.EW, data2017.female.EW)
data2017.sex.EW$age <- factor(data2017.sex.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64",
"65-74", "75-84", "85+"))
data2017.sex.EW$sex <- factor(data2017.sex.EW$sex, levels=c("Male", "Female"))
data2017.sex.EW <- arrange(data2017.sex.EW, age, sex)
#Add total rows
data2017.sex.EW <- data2017.sex.EW %>%
group_by(sex) %>%
summarise_at(c(2:(ncol(data2017.sex.EW)-1)), sum) %>%
mutate(age="Total") %>%
bind_rows(data2017.sex.EW)
#By region
data2017.reg.EW <- read_excel(temp, sheet="Weekly figures 2017", range="B43:BB52", col_names=FALSE)
colnames(data2017.reg.EW) <- c("reg", format(seq.Date(from=as.Date("2017-01-06"), by="7 days",
length.out=ncol(data2017.reg.EW)-1), "%d/%m/%y"))
#2016 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2016/publishedweek522016.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age
data2016.age.EW <- read_excel(temp, sheet="Weekly figures 2016", range="B16:BB22", col_names=FALSE)
colnames(data2016.age.EW) <- c("age", format(seq.Date(from=as.Date("2016-01-08"), by="7 days",
length.out=ncol(data2016.age.EW)-1), "%d/%m/%y"))
data2016.age.EW$age <- factor(data2016.age.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64", "65-74",
"75-84", "85+"))
data2016.age.EW <- arrange(data2016.age.EW, age)
#By sex
data2016.male.EW <- read_excel(temp, sheet="Weekly figures 2016", range="B25:BB31", col_names=FALSE)
colnames(data2016.male.EW) <- c("age", format(seq.Date(from=as.Date("2016-01-08"), by="7 days",
length.out=ncol(data2016.male.EW)-1), "%d/%m/%y"))
data2016.male.EW$sex <- "Male"
data2016.female.EW <- read_excel(temp, sheet="Weekly figures 2016", range="B34:BB40", col_names=FALSE)
colnames(data2016.female.EW) <- c("age", format(seq.Date(from=as.Date("2016-01-08"), by="7 days",
length.out=ncol(data2016.female.EW)-1), "%d/%m/%y"))
data2016.female.EW$sex <- "Female"
data2016.sex.EW <- bind_rows(data2016.male.EW, data2016.female.EW)
data2016.sex.EW$age <- factor(data2016.sex.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64",
"65-74", "75-84", "85+"))
data2016.sex.EW$sex <- factor(data2016.sex.EW$sex, levels=c("Male", "Female"))
data2016.sex.EW <- arrange(data2016.sex.EW, age, sex)
#Add total rows
data2016.sex.EW <- data2016.sex.EW %>%
group_by(sex) %>%
summarise_at(c(2:(ncol(data2016.sex.EW)-1)), sum) %>%
mutate(age="Total") %>%
bind_rows(data2016.sex.EW)
#By region
data2016.reg.EW <- read_excel(temp, sheet="Weekly figures 2016", range="B43:BB52", col_names=FALSE)
colnames(data2016.reg.EW) <- c("reg", format(seq.Date(from=as.Date("2016-01-08"), by="7 days",
length.out=ncol(data2016.reg.EW)-1), "%d/%m/%y"))
#2015 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2015/publishedweek2015.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age
data2015.age.EW <- read_excel(temp, sheet="Weekly Figures 2015", range="A16:BB22", col_names=FALSE)
colnames(data2015.age.EW) <- c("age", format(seq.Date(from=as.Date("2015-01-02"), by="7 days",
length.out=ncol(data2015.age.EW)-1), "%d/%m/%y"))
data2015.age.EW$age <- factor(data2015.age.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64", "65-74",
"75-84", "85+"))
data2015.age.EW <- arrange(data2015.age.EW, age)
#By sex
data2015.male.EW <- read_excel(temp, sheet="Weekly Figures 2015", range="A25:BB31", col_names=FALSE)
colnames(data2015.male.EW) <- c("age", format(seq.Date(from=as.Date("2015-01-02"), by="7 days",
length.out=ncol(data2015.male.EW)-1), "%d/%m/%y"))
data2015.male.EW$sex <- "Male"
data2015.female.EW <- read_excel(temp, sheet="Weekly Figures 2015", range="A34:BB40", col_names=FALSE)
colnames(data2015.female.EW) <- c("age", format(seq.Date(from=as.Date("2015-01-02"), by="7 days",
length.out=ncol(data2015.female.EW)-1), "%d/%m/%y"))
data2015.female.EW$sex <- "Female"
data2015.sex.EW <- bind_rows(data2015.male.EW, data2015.female.EW)
data2015.sex.EW$age <- factor(data2015.sex.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64",
"65-74", "75-84", "85+"))
data2015.sex.EW$sex <- factor(data2015.sex.EW$sex, levels=c("Male", "Female"))
data2015.sex.EW <- arrange(data2015.sex.EW, age, sex)
#Add total rows
data2015.sex.EW <- data2015.sex.EW %>%
group_by(sex) %>%
summarise_at(c(2:(ncol(data2015.sex.EW)-1)), sum) %>%
mutate(age="Total") %>%
bind_rows(data2015.sex.EW)
#By region
data2015.reg.EW <- read_excel(temp, sheet="Weekly Figures 2015", range="A43:BB52", col_names=FALSE)
colnames(data2015.reg.EW) <- c("reg", format(seq.Date(from=as.Date("2015-01-02"), by="7 days",
length.out=ncol(data2015.reg.EW)-1), "%d/%m/%y"))
#2014 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2014/publishedweek2014.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age
data2014.age.EW <- read_excel(temp, sheet="Weekly Figures 2014", range="A16:BA22", col_names=FALSE)
colnames(data2014.age.EW) <- c("age", format(seq.Date(from=as.Date("2014-01-03"), by="7 days",
length.out=ncol(data2014.age.EW)-1), "%d/%m/%y"))
data2014.age.EW$age <- factor(data2014.age.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64", "65-74",
"75-84", "85+"))
data2014.age.EW <- arrange(data2014.age.EW, age)
#By sex
data2014.male.EW <- read_excel(temp, sheet="Weekly Figures 2014", range="A25:BA31", col_names=FALSE)
colnames(data2014.male.EW) <- c("age", format(seq.Date(from=as.Date("2014-01-03"), by="7 days",
length.out=ncol(data2014.male.EW)-1), "%d/%m/%y"))
data2014.male.EW$sex <- "Male"
data2014.female.EW <- read_excel(temp, sheet="Weekly Figures 2014", range="A34:BA40", col_names=FALSE)
colnames(data2014.female.EW) <- c("age", format(seq.Date(from=as.Date("2014-01-03"), by="7 days",
length.out=ncol(data2014.female.EW)-1), "%d/%m/%y"))
data2014.female.EW$sex <- "Female"
data2014.sex.EW <- bind_rows(data2014.male.EW, data2014.female.EW)
data2014.sex.EW$age <- factor(data2014.sex.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64",
"65-74", "75-84", "85+"))
data2014.sex.EW$sex <- factor(data2014.sex.EW$sex, levels=c("Male", "Female"))
data2014.sex.EW <- arrange(data2014.sex.EW, age, sex)
#Add total rows
data2014.sex.EW <- data2014.sex.EW %>%
group_by(sex) %>%
summarise_at(c(2:(ncol(data2014.sex.EW)-1)), sum) %>%
mutate(age="Total") %>%
bind_rows(data2014.sex.EW)
#By region
data2014.reg.EW <- read_excel(temp, sheet="Weekly Figures 2014", range="A43:BA52", col_names=FALSE)
colnames(data2014.reg.EW) <- c("reg", format(seq.Date(from=as.Date("2014-01-03"), by="7 days",
length.out=ncol(data2014.reg.EW)-1), "%d/%m/%y"))
#2013 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2013/publishedweek2013.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age
data2013.age.EW <- read_excel(temp, sheet="Weekly Figures 2013", range="A16:BA22", col_names=FALSE)
colnames(data2013.age.EW) <- c("age", format(seq.Date(from=as.Date("2013-01-04"), by="7 days",
length.out=ncol(data2013.age.EW)-1), "%d/%m/%y"))
data2013.age.EW$age <- factor(data2013.age.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64", "65-74",
"75-84", "85+"))
data2013.age.EW <- arrange(data2013.age.EW, age)
#By sex
data2013.male.EW <- read_excel(temp, sheet="Weekly Figures 2013", range="A25:BA31", col_names=FALSE)
colnames(data2013.male.EW) <- c("age", format(seq.Date(from=as.Date("2013-01-04"), by="7 days",
length.out=ncol(data2013.male.EW)-1), "%d/%m/%y"))
data2013.male.EW$sex <- "Male"
data2013.female.EW <- read_excel(temp, sheet="Weekly Figures 2013", range="A34:BA40", col_names=FALSE)
colnames(data2013.female.EW) <- c("age", format(seq.Date(from=as.Date("2013-01-04"), by="7 days",
length.out=ncol(data2013.female.EW)-1), "%d/%m/%y"))
data2013.female.EW$sex <- "Female"
data2013.sex.EW <- bind_rows(data2013.male.EW, data2013.female.EW)
data2013.sex.EW$age <- factor(data2013.sex.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64",
"65-74", "75-84", "85+"))
data2013.sex.EW$sex <- factor(data2013.sex.EW$sex, levels=c("Male", "Female"))
data2013.sex.EW <- arrange(data2013.sex.EW, age, sex)
#Add total rows
data2013.sex.EW <- data2013.sex.EW %>%
group_by(sex) %>%
summarise_at(c(2:(ncol(data2013.sex.EW)-1)), sum) %>%
mutate(age="Total") %>%
bind_rows(data2013.sex.EW)
#By region
data2013.reg.EW <- read_excel(temp, sheet="Weekly Figures 2013", range="A43:BA52", col_names=FALSE)
colnames(data2013.reg.EW) <- c("reg", format(seq.Date(from=as.Date("2013-01-04"), by="7 days",
length.out=ncol(data2013.reg.EW)-1), "%d/%m/%y"))
#2012 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2012/publishedweek2012.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age
data2012.age.EW <- read_excel(temp, sheet="Weekly Figures 2012", range="A16:BA22", col_names=FALSE)
colnames(data2012.age.EW) <- c("age", format(seq.Date(from=as.Date("2012-01-06"), by="7 days",
length.out=ncol(data2012.age.EW)-1), "%d/%m/%y"))
data2012.age.EW$age <- factor(data2012.age.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64", "65-74",
"75-84", "85+"))
data2012.age.EW <- arrange(data2012.age.EW, age)
#By sex
data2012.male.EW <- read_excel(temp, sheet="Weekly Figures 2012", range="A25:BA31", col_names=FALSE)
colnames(data2012.male.EW) <- c("age", format(seq.Date(from=as.Date("2012-01-06"), by="7 days",
length.out=ncol(data2012.male.EW)-1), "%d/%m/%y"))
data2012.male.EW$sex <- "Male"
data2012.female.EW <- read_excel(temp, sheet="Weekly Figures 2012", range="A34:BA40", col_names=FALSE)
colnames(data2012.female.EW) <- c("age", format(seq.Date(from=as.Date("2012-01-06"), by="7 days",
length.out=ncol(data2012.female.EW)-1), "%d/%m/%y"))
data2012.female.EW$sex <- "Female"
data2012.sex.EW <- bind_rows(data2012.male.EW, data2012.female.EW)
data2012.sex.EW$age <- factor(data2012.sex.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64",
"65-74", "75-84", "85+"))
data2012.sex.EW$sex <- factor(data2012.sex.EW$sex, levels=c("Male", "Female"))
data2012.sex.EW <- arrange(data2012.sex.EW, age, sex)
#Add total rows
data2012.sex.EW <- data2012.sex.EW %>%
group_by(sex) %>%
summarise_at(c(2:(ncol(data2012.sex.EW)-1)), sum) %>%
mutate(age="Total") %>%
bind_rows(data2012.sex.EW)
#By region
data2012.reg.EW <- read_excel(temp, sheet="Weekly Figures 2012", range="A43:BA52", col_names=FALSE)
colnames(data2012.reg.EW) <- c("reg", format(seq.Date(from=as.Date("2012-01-06"), by="7 days",
length.out=ncol(data2012.reg.EW)-1), "%d/%m/%y"))
#2011 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2011/publishedweek2011.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age
data2011.age.EW <- read_excel(temp, sheet="Weekly Figures 2011", range="A17:BA23", col_names=FALSE)
colnames(data2011.age.EW) <- c("age", format(seq.Date(from=as.Date("2011-01-07"), by="7 days",
length.out=ncol(data2011.age.EW)-1), "%d/%m/%y"))
data2011.age.EW$age <- factor(data2011.age.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64", "65-74",
"75-84", "85+"))
data2011.age.EW <- arrange(data2011.age.EW, age)
#By sex
data2011.male.EW <- read_excel(temp, sheet="Weekly Figures 2011", range="A26:BA32", col_names=FALSE)
colnames(data2011.male.EW) <- c("age", format(seq.Date(from=as.Date("2011-01-07"), by="7 days",
length.out=ncol(data2011.male.EW)-1), "%d/%m/%y"))
data2011.male.EW$sex <- "Male"
data2011.female.EW <- read_excel(temp, sheet="Weekly Figures 2011", range="A35:BA41", col_names=FALSE)
colnames(data2011.female.EW) <- c("age", format(seq.Date(from=as.Date("2011-01-07"), by="7 days",
length.out=ncol(data2011.female.EW)-1), "%d/%m/%y"))
data2011.female.EW$sex <- "Female"
data2011.sex.EW <- bind_rows(data2011.male.EW, data2011.female.EW)
data2011.sex.EW$age <- factor(data2011.sex.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64",
"65-74", "75-84", "85+"))
data2011.sex.EW$sex <- factor(data2011.sex.EW$sex, levels=c("Male", "Female"))
data2011.sex.EW <- arrange(data2011.sex.EW, age, sex)
#Add total rows
data2011.sex.EW <- data2011.sex.EW %>%
group_by(sex) %>%
summarise_at(c(2:(ncol(data2011.sex.EW)-1)), sum) %>%
mutate(age="Total") %>%
bind_rows(data2011.sex.EW)
#By region
data2011.reg.EW <- read_excel(temp, sheet="Weekly Figures 2011", range="A44:BA53", col_names=FALSE)
colnames(data2011.reg.EW) <- c("reg", format(seq.Date(from=as.Date("2011-01-07"), by="7 days",
length.out=ncol(data2011.reg.EW)-1), "%d/%m/%y"))
#2010 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2010/publishedweek2010.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age
data2010.age.EW <- read_excel(temp, sheet="Weekly Figures 2010", range="A16:BA22", col_names=FALSE)
colnames(data2010.age.EW) <- c("age", format(seq.Date(from=as.Date("2010-01-08"), by="7 days",
length.out=ncol(data2010.age.EW)-1), "%d/%m/%y"))
data2010.age.EW$age <- factor(data2010.age.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64", "65-74",
"75-84", "85+"))
data2010.age.EW <- arrange(data2010.age.EW, age)
#By sex
data2010.male.EW <- read_excel(temp, sheet="Weekly Figures 2010", range="A25:BA31", col_names=FALSE)
colnames(data2010.male.EW) <- c("age", format(seq.Date(from=as.Date("2010-01-08"), by="7 days",
length.out=ncol(data2010.male.EW)-1), "%d/%m/%y"))
data2010.male.EW$sex <- "Male"
data2010.female.EW <- read_excel(temp, sheet="Weekly Figures 2010", range="A34:BA40", col_names=FALSE)
colnames(data2010.female.EW) <- c("age", format(seq.Date(from=as.Date("2010-01-08"), by="7 days",
length.out=ncol(data2010.female.EW)-1), "%d/%m/%y"))
data2010.female.EW$sex <- "Female"
data2010.sex.EW <- bind_rows(data2010.male.EW, data2010.female.EW)
data2010.sex.EW$age <- factor(data2010.sex.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64",
"65-74", "75-84", "85+"))
data2010.sex.EW$sex <- factor(data2010.sex.EW$sex, levels=c("Male", "Female"))
data2010.sex.EW <- arrange(data2010.sex.EW, age, age)
#Add total rows
data2010.sex.EW <- data2010.sex.EW %>%
group_by(sex) %>%
summarise_at(c(2:(ncol(data2010.sex.EW)-1)), sum) %>%
mutate(age="Total") %>%
bind_rows(data2010.sex.EW)
#By region
data2010.reg.EW <- read_excel(temp, sheet="Weekly Figures 2010", range="A43:BA52", col_names=FALSE)
colnames(data2010.reg.EW) <- c("reg", format(seq.Date(from=as.Date("2010-01-08"), by="7 days",
length.out=ncol(data2010.reg.EW)-1), "%d/%m/%y"))
#Combine into overall 2010-20 datasets
#For age
data_wide.age.EW <- bind_cols(data2010.age.EW, data2011.age.EW[,-c(1)], data2012.age.EW[,-c(1)], data2013.age.EW[,-c(1)], data2014.age.EW[,-c(1)],
data2015.age.EW[,-c(1)], data2016.age.EW[,-c(1)], data2017.age.EW[,-c(1)], data2018.age.EW[,-c(1)], data2019.age.EW[,-c(1)],
data2020.age.EW[,-c(1)])
data.age.EW <- gather(data_wide.age.EW, week, deaths, c(2:ncol(data_wide.age.EW)))
data.age.EW <- subset(data.age.EW, substr(data.age.EW$week,1,3)!="age")
data.age.EW$deaths <- as.numeric(data.age.EW$deaths)
#Add total row
data.age.EW <- data.age.EW %>%
group_by(week) %>%
summarise(deaths=sum(deaths)) %>%
mutate(age="Total") %>%
bind_rows(data.age.EW)
data.age.EW$week <- as.Date(data.age.EW$week, "%d/%m/%y")
data.age.EW$year <- as.numeric(format(data.age.EW$week, "%Y"))
data.age.EW$weekno <- week(data.age.EW$week)
data.age.EW$reg <- "England & Wales"
#For sex
data2010.sex.EW <- data2010.sex.EW %>%
select(age, everything())
data_wide.sex.EW <- bind_cols(data2010.sex.EW, data2011.sex.EW[,-c(1,54)], data2012.sex.EW[,-c(1,54)], data2013.sex.EW[,-c(1,54)], data2014.sex.EW[,-c(1,54)],
data2015.sex.EW[,-c(1,55)], data2016.sex.EW[,-c(1,54)], data2017.sex.EW[,-c(1,54)], data2018.sex.EW[,-c(1,54)], data2019.sex.EW[,-c(1,54)],
data2020.sex.EW[,-c(1,ncol(data2020.sex.EW))])
data.sex.EW <- gather(data_wide.sex.EW, week, deaths, c(3:ncol(data_wide.sex.EW)))
data.sex.EW <- subset(data.sex.EW, !substr(data.sex.EW$week,1,3) %in% c("age", "sex"))
data.sex.EW$deaths <- as.numeric(data.sex.EW$deaths)
data.sex.EW$week <- as.Date(data.sex.EW$week, "%d/%m/%y")
data.sex.EW$year <- as.numeric(format(data.sex.EW$week, "%Y"))
data.sex.EW$weekno <- week(data.sex.EW$week)
data.sex.EW$reg <- "England & Wales"
data.sex.EW$age <- factor(data.sex.EW$age, levels=c("Under 1 year", "01-14", "15-44", "45-64", "65-74", "75-84", "85+", "Total"))
#For region
data_wide.reg.EW <- bind_cols(data2010.reg.EW, data2011.reg.EW[,-c(1)], data2012.reg.EW[,-c(1)], data2013.reg.EW[,-c(1)], data2014.reg.EW[,-c(1)],
data2015.reg.EW[,-c(1)], data2016.reg.EW[,-c(1)], data2017.reg.EW[,-c(1)], data2018.reg.EW[,-c(1)], data2019.reg.EW[,-c(1)],
data2020.reg.EW[,-c(1)])
data.reg.EW <- gather(data_wide.reg.EW, week, deaths, c(2:ncol(data_wide.reg.EW)))
data.reg.EW <- subset(data.reg.EW, substr(data.reg.EW$week,1,3)!="reg")
data.reg.EW$deaths <- as.numeric(data.reg.EW$deaths)
data.reg.EW$date <- as.Date(data.reg.EW$week, "%d/%m/%y")
data.reg.EW$year <- as.numeric(format(data.reg.EW$date, "%Y"))
data.reg.EW$weekno <- week(data.reg.EW$date)
data.reg.EW <- data.reg.EW[,-c(2)]
#Tidy up
rm(data_wide.age.EW, data_wide.reg.EW, data_wide.sex.EW, data2010.age.EW, data2010.female.EW, data2010.male.EW, data2010.reg.EW, data2010.sex.EW,
data2011.age.EW, data2011.female.EW, data2011.male.EW, data2011.reg.EW, data2011.sex.EW,
data2012.age.EW, data2012.female.EW, data2012.male.EW, data2012.reg.EW, data2012.sex.EW,
data2013.age.EW, data2013.female.EW, data2013.male.EW, data2013.reg.EW, data2013.sex.EW,
data2014.age.EW, data2014.female.EW, data2014.male.EW, data2014.reg.EW, data2014.sex.EW,
data2015.age.EW, data2015.female.EW, data2015.male.EW, data2015.reg.EW, data2015.sex.EW,
data2016.age.EW, data2016.female.EW, data2016.male.EW, data2016.reg.EW, data2016.sex.EW,
data2017.age.EW, data2017.female.EW, data2017.male.EW, data2017.reg.EW, data2017.sex.EW,
data2018.age.EW, data2018.female.EW, data2018.male.EW, data2018.reg.EW, data2018.sex.EW,
data2019.age.EW, data2019.female.EW, data2019.male.EW, data2019.reg.EW, data2019.sex.EW,
data2020.age.EW, data2020.female.EW, data2020.male.EW, data2020.reg.EW, data2020.sex.EW)
#######################
#Read in Scottish data#
#######################
#Historic weekly deaths data for Scotland is published by National Records of Scotland
temp <- tempfile()
source <- "https://www.nrscotland.gov.uk/files//statistics/weekly-monthly-births-deaths-data/2020/mar/weekly-march-20.xlsx"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
data2004.S <- read_excel(temp, sheet="2004", range="A6:D57", col_names=FALSE)
data2005.S <- read_excel(temp, sheet="2005", range="A6:D58", col_names=FALSE)
data2006.S <- read_excel(temp, sheet="2006", range="A6:D57", col_names=FALSE)
data2007.S <- read_excel(temp, sheet="2007", range="A6:D57", col_names=FALSE)
data2008.S <- read_excel(temp, sheet="2008", range="A6:D57", col_names=FALSE)
data2009.S <- read_excel(temp, sheet="2009", range="A6:D57", col_names=FALSE)
data2010.S <- read_excel(temp, sheet="2010", range="A6:D57", col_names=FALSE)
data2011.S <- read_excel(temp, sheet="2011", range="A6:D58", col_names=FALSE)
data2012.S <- read_excel(temp, sheet="2012", range="A6:D57", col_names=FALSE)
data2013.S <- read_excel(temp, sheet="2013", range="A6:D57", col_names=FALSE)
data2014.S <- read_excel(temp, sheet="2014", range="A6:D57", col_names=FALSE)
data2015.S <- read_excel(temp, sheet="2015 ", range="A6:D58", col_names=FALSE)
data2016.S <- read_excel(temp, sheet="2016", range="E6:G57", col_names=FALSE)
data2017.S <- read_excel(temp, sheet="2017", range="E6:G57", col_names=FALSE)
data2018.S <- read_excel(temp, sheet="2018", range="E6:G57", col_names=FALSE)
data2019.S <- read_excel(temp, sheet="2019", range="E6:G57", col_names=FALSE)
#Weekly data for 2020 is published in a different Excel file each week on a Wednesday,
#so need to update the link each time from this page https://www.nrscotland.gov.uk/covid19stats
#Need to manually update the cell range when reading data in.
#Take 2020 data from dedicated COVID-19 page, which is updated more regularly
temp <- tempfile()
temp <- curl_download(url=Scot2020, destfile=temp, quiet=FALSE, mode="wb")
data2020.S <- data.frame(t(read_excel(temp, sheet="Table 2 ", range=paste0("C6:", ScotRange, "7"), col_names=FALSE))[,c(2)])
date <- data.frame(date=format(seq.Date(from=as.Date("2019-12-30"), by="7 days", length.out=nrow(data2020.S)), "%d/%m/%y"))
data2020.S <- cbind(date, data2020.S)
colnames(data2020.S) <- c("date", "deaths")
data2020.S$date <- as.Date(data2020.S$date, "%d/%m/%y")
data2020.S$weekno <- week(data2020.S$date)
#Stick together 2004-15 which share the same structure
data0415.S <- bind_rows(data2004.S, data2005.S, data2006.S, data2007.S, data2008.S, data2009.S, data2010.S,
data2011.S, data2012.S, data2013.S, data2014.S, data2015.S)
colnames(data0415.S) <- c("weekno", "date", "births", "deaths")
data0415.S$date <- as.Date(data0415.S$date)
#Then 2016-19 data
data1619.S <- bind_rows(data2016.S, data2017.S, data2018.S, data2019.S)
colnames(data1619.S) <- c("weekno", "date", "deaths")
data1619.S$date <- as.Date(data1619.S$date)
data.S <- bind_rows(data0415.S, data1619.S, data2020.S)
#Recalculate dates to align with ONS data (which uses week to, not w/c)
data.S$date <- data.S$date+days(6)
data.S$weekno <- week(data.S$date)
data.S$year <- year(data.S$date)
data.S$reg <- "Scotland"
data.S <- data.S[,-c(3)]
if(NRSweek==FALSE){
#NRS stopped publishing detailed weekly deaths data after week 32,
#so get data after that from elsewhere:
#https://data.gov.scot/coronavirus-covid-19/data.html
temp <- tempfile()
temp <- curl_download(url=Scot2020v2, destfile=temp, quiet=FALSE, mode="wb")
data.Sv2 <- read_excel(temp, sheet="2.2_excess", range=paste0("A", ScotRangev2.1,":C", ScotRangev2.2), col_names=FALSE)
colnames(data.Sv2) <- c("weekno", "date", "deaths")
data.Sv2$date <- data.Sv2$date+days(6)
data.Sv2$year <- rep(2020, times=length(data.Sv2$weekno))
data.Sv2$reg <- rep("Scotland", times=length(data.Sv2$weekno))
data.S <- bind_rows(data.S, data.Sv2)
rm(data.Sv2)
}
#Tidy up
rm(date, data2004.S, data2005.S, data2006.S, data2007.S, data2008.S, data2009.S, data2010.S, data2011.S,
data2012.S, data2013.S, data2014.S, data2015.S, data2016.S, data2017.S, data2018.S, data2019.S,
data2020.S, data0415.S, data1619.S)
#############################
#Read in Northern Irish data#
#############################
#NI data from NISRA is published to the same Excel file (so no need to update link) each Friday
temp <- tempfile()
temp <- curl_download(url=NI2020, destfile=temp, quiet=FALSE, mode="wb")
data2020.NI <- read_excel(temp, sheet="Table 1", range=paste0("B6:C", NIRange), col_names=FALSE)
colnames(data2020.NI) <- c("date", "deaths")
temp <- tempfile()
source <- "https://www.nisra.gov.uk/sites/nisra.gov.uk/files/publications/Weekly%20Deaths%20by%20Age%20and%20Respiratory%20Deaths%2C%202011-2019.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
data2019.NI <- read_excel(temp, sheet="Weekly Deaths_2019", range="C5:D56", col_names=FALSE)
colnames(data2019.NI) <- c("date", "deaths")
data2018.NI <- read_excel(temp, sheet="Weekly Deaths_2018", range="C5:D56", col_names=FALSE)
colnames(data2018.NI) <- c("date", "deaths")
data2017.NI <- read_excel(temp, sheet="Weekly Deaths_2017", range="C5:D57", col_names=FALSE)
colnames(data2017.NI) <- c("date", "deaths")
data2016.NI <- read_excel(temp, sheet="Weekly Deaths_2016", range="C5:D56", col_names=FALSE)
colnames(data2016.NI) <- c("date", "deaths")
data2015.NI <- read_excel(temp, sheet="Weekly Deaths_2015", range="C5:D57", col_names=FALSE)
colnames(data2015.NI) <- c("date", "deaths")
data2014.NI <- read_excel(temp, sheet="Weekly Deaths_2014", range="C5:D56", col_names=FALSE)
colnames(data2014.NI) <- c("date", "deaths")
data2013.NI <- read_excel(temp, sheet="Weekly Deaths_2013", range="C5:D56", col_names=FALSE)
colnames(data2013.NI) <- c("date", "deaths")
data2012.NI <- read_excel(temp, sheet="Weekly Deaths_2012", range="C5:D56", col_names=FALSE)
colnames(data2012.NI) <- c("date", "deaths")
data2011.NI <- read_excel(temp, sheet="Weekly Deaths_2011", range="C5:D56", col_names=FALSE)
colnames(data2011.NI) <- c("date", "deaths")
data.NI <- bind_rows(data2011.NI, data2012.NI, data2013.NI, data2014.NI, data2015.NI, data2016.NI,
data2017.NI, data2018.NI, data2019.NI, data2020.NI)
data.NI$date <- as.Date(data.NI$date)
data.NI$weekno <- week(data.NI$date)
data.NI$year <- year(data.NI$date)
data.NI$reg <- "Northern Ireland"
#Tidy up
rm(data2011.NI, data2012.NI, data2013.NI, data2014.NI, data2015.NI, data2016.NI, data2017.NI,
data2018.NI, data2019.NI, data2020.NI)
#Stick regional data together for whole of UK
data.reg.UK <- bind_rows(data.reg.EW, data.S, data.NI)
#Temporary hack until I work out a propoer solution for the 2020-201 bridge
data.reg.UK <- data.reg.UK %>%
mutate(weekno=if_else(year==2021 & weekno==1, 53, weekno),
year=if_else(year==2021, 2020, year))
data.age.EW <- data.age.EW %>%
mutate(weekno=if_else(year==2021 & weekno==1, 53, weekno),
year=if_else(year==2021, 2020, year))
data.sex.EW <- data.sex.EW %>%
mutate(weekno=if_else(year==2021 & weekno==1, 53, weekno),
year=if_else(year==2021, 2020, year))
data.reg.EW <- data.reg.EW %>%
mutate(weekno=if_else(year==2021 & weekno==1, 53, weekno),
year=if_else(year==2021, 2020, year))
data.S <- data.S %>%
mutate(weekno=if_else(year==2021 & weekno==1, 53, weekno),
year=if_else(year==2021, 2020, year))
data.NI <- data.NI %>%
mutate(weekno=if_else(year==2021 & weekno==1, 53, as.double(weekno)),
year=if_else(year==2021, 2020, as.double(year)))
#Pull out latest week numbers for label placement
EWmaxweek <- max(subset(data.reg.UK, reg=="London" & year==2020)$weekno)
Scotmaxweek <- max(subset(data.reg.UK, reg=="Scotland" & year==2020)$weekno)
NImaxweek <- max(subset(data.reg.UK, reg=="Northern Ireland" & year==2020)$weekno)
###########
#Save data#
###########
#E&W data by age
write.csv(data.age.EW, "Data/deaths_age_EW.csv")
#E&W data by sex
write.csv(data.sex.EW, "Data/deaths_sex_EW.csv")
#UK data by region
write.csv(data.reg.UK, "Data/deaths_reg_UK.csv")
################
#E&W only plots#
################
#Overall plot
#Extract max/min values
#split off 2020 data
data.age.EW.new <- subset(data.age.EW, year==2020 & age=="Total")
data.age.EW.old <- subset(data.age.EW, year<2020 & age=="Total")
data.age.EW.old <- data.age.EW.old %>%
group_by(weekno, reg) %>%
summarise(max=max(deaths), min=min(deaths), mean=mean(deaths))
data.age.EW.new <- merge(data.age.EW.new, data.age.EW.old, by=c("weekno"))
#Calculate excess deaths vs. mean so far this year
data.age.EW.new$excess <- data.age.EW.new$deaths-data.age.EW.new$mean
EW.excess <- data.age.EW.new %>%
summarise(excess=sum(excess), total=sum(mean), percexcess=excess/total)
#Extract y=axis placement for excess deaths figure
labpos <- 14000
tiff("Outputs/ONSWeeklyDeaths.tiff", units="in", width=10, height=8, res=300)
ggplot()+
geom_ribbon(data=data.age.EW.old, aes(x=weekno, ymin=min, ymax=max), fill="Skyblue2")+
geom_ribbon(data=data.age.EW.new, aes(x=weekno, ymin=mean, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(data=data.age.EW.old, aes(x=weekno, y=mean), colour="Grey50", linetype=2)+
geom_line(data=data.age.EW.new, aes(x=weekno, y=deaths), colour="Red")+
theme_classic()+
scale_x_continuous(name="Week number", breaks=c(0,10,20,30,40,50))+
scale_y_continuous(name="Deaths registered")+
expand_limits(y=0)+
labs(title="All-cause deaths in England & Wales are still higher than 'normal'",
subtitle=paste0("Weekly deaths in <span style='color:red;'>2020</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>. Data up to ", EWDate, "."),
caption="Data from ONS | Plot by @VictimOfMaths")+
annotate(geom="text", x=22, y=labpos, label=paste0("+", round(EW.excess$excess, 0),
" more deaths in 2020 than average (+",
round(EW.excess$percexcess*100, 0),"%)"), colour="Red", hjust=0)+
annotate(geom="text", x=9, y=13600, label="Historic maximum", colour="Skyblue4")+
annotate(geom="text", x=9, y=9100, label="Historic minimum", colour="Skyblue4")+
annotate(geom="text", x=48, y=8800, label="Historic mean", colour="grey30")+
geom_curve(aes(x=48, y=9000, xend=47, yend=9800), colour="grey30", curvature=0.15,
arrow=arrow(length=unit(0.1, "cm"), type="closed"), lineend="round")+
theme(plot.subtitle =element_markdown(), plot.title=element_text(face="bold", size=rel(1.2)))
dev.off()
#Plot by sex
#Extract max/min values
#split off 2020 data
data.sex.EW.new <- subset(data.sex.EW, year==2020 & age=="Total")
data.sex.EW.old <- subset(data.sex.EW, year<2020 & age=="Total")
data.sex.EW.old <- data.sex.EW.old %>%
group_by(weekno, sex) %>%
summarise(max=max(deaths), min=min(deaths), mean=mean(deaths))
data.sex.EW.new <- merge(data.sex.EW.new, data.sex.EW.old, by=c("weekno", "sex"))
#Calculate excess deaths vs. mean so far this year
data.sex.EW.new$excess <- data.sex.EW.new$deaths-data.sex.EW.new$mean
sex.EW.excess <- data.sex.EW.new %>%
group_by(sex) %>%
summarise(excess=sum(excess), total=sum(mean), percexcess=excess/total)
#Extract label positions for excess deaths
labpos <- data.sex.EW.new %>%
filter(weekno==EWmaxweek) %>%
group_by(sex) %>%
summarise(pos=max(deaths, max+1000))
ann_text1 <- data.frame(weekno=rep(26, times=2), deaths=labpos$pos, sex=c("Male", "Female"))
tiff("Outputs/ONSWeeklyDeathsxSex.tiff", units="in", width=12, height=8, res=300)
ggplot()+
geom_ribbon(data=data.sex.EW.old, aes(x=weekno, ymin=min, ymax=max), fill="Skyblue2")+
geom_ribbon(data=data.sex.EW.new, aes(x=weekno, ymin=mean, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(data=data.sex.EW.old, aes(x=weekno, y=mean), colour="Grey50", linetype=2)+
geom_line(data=data.sex.EW.new, aes(x=weekno, y=deaths), colour="Red")+
theme_classic()+
facet_wrap(~sex)+
scale_x_continuous(name="Week number", breaks=c(0,10,20,30,40,50))+
scale_y_continuous(name="Deaths registered")+
expand_limits(y=0)+
labs(title="Excess deaths are currently higher among men",
subtitle=paste0("Weekly deaths in <span style='color:red;'>2020</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>. Data up to ", EWDate, "."),
caption="Data from ONS | Plot by @VictimOfMaths")+
theme(strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
plot.subtitle =element_markdown(), plot.title=element_text(face="bold", size=rel(1.2)))+
geom_text(data=ann_text1, aes(x=weekno, y=deaths), label=c(paste0("+", round(sex.EW.excess[1,2],0)," excess deaths in 2020\nvs. 2010-19 average (+",
round(sex.EW.excess[1,4]*100, 0),"%)"),
paste0("+", round(sex.EW.excess[2,2],0)," deaths (+",
round(sex.EW.excess[2,4]*100, 0),"%)")),
size=3, colour=c("Red", "Red"), hjust=0)
dev.off()
#By sex and age
#Extract max/min values
#split off 2020 data
data.sex.age.EW.new <- subset(data.sex.EW, year==2020 & !age %in% c("Total", "Under 1 year", "01-14", "15-44"))
data.sex.age.EW.old <- subset(data.sex.EW, year<2020 & !age %in% c("Total", "Under 1 year", "01-14", "15-44"))
data.sex.age.EW.old <- data.sex.age.EW.old %>%
group_by(weekno, sex, age) %>%
summarise(max=max(deaths), min=min(deaths), mean=mean(deaths))
data.sex.age.EW.new <- merge(data.sex.age.EW.new, data.sex.age.EW.old, by=c("weekno", "sex", "age"))
#Calculate excess deaths vs. mean so far this year
data.sex.age.EW.new$excess <- data.sex.age.EW.new$deaths-data.sex.age.EW.new$mean
sex.age.EW.excess <- data.sex.age.EW.new %>%
group_by(sex, age) %>%
summarise(excess=sum(excess), total=sum(mean), percexcess=excess/total)
#Extract label positions for excess deaths
labpos <- data.sex.age.EW.new %>%
filter(weekno==EWmaxweek) %>%
group_by(sex, age) %>%
summarise(pos=max(deaths, max+500))
ann_text2 <- data.frame(weekno=rep(25, times=8), deaths=labpos$pos,
sex=rep(c("Male", "Female"), each=4),
age=rep(c("45-64", "65-74", "75-84", "85+"), times=2))
tiff("Outputs/ONSWeeklyDeathsxSexxAge.tiff", units="in", width=12, height=8, res=300)
ggplot()+
geom_ribbon(data=data.sex.age.EW.old, aes(x=weekno, ymin=min, ymax=max), fill="Skyblue2")+
geom_ribbon(data=data.sex.age.EW.new, aes(x=weekno, ymin=mean, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(data=data.sex.age.EW.old, aes(x=weekno, y=mean), colour="Grey50", linetype=2)+
geom_line(data=data.sex.age.EW.new, aes(x=weekno, y=deaths), colour="Red")+
theme_classic()+
facet_grid(age~sex)+
scale_x_continuous(name="Week number", breaks=c(0,10,20,30,40,50))+
scale_y_continuous(name="Deaths registered")+
expand_limits(y=0)+
labs(title="Excess deaths are clearest among men over 75",
subtitle=paste0("Weekly deaths in <span style='color:red;'>2020</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>. Data up to ", EWDate, "."),
caption="Data from ONS | Plot by @VictimOfMaths")+
theme(strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
plot.subtitle =element_markdown(), plot.title=element_text(face="bold", size=rel(1.2)))+
geom_text(data=ann_text2, aes(x=weekno, y=deaths), label=c(paste0(round(sex.age.EW.excess[1,3],0)," excess deaths in 2020 vs. 2010-19 average (+",
round(sex.age.EW.excess[1,5]*100, 0),"%)"),
paste0("+", round(sex.age.EW.excess[2,3],0)," deaths (+",
round(sex.age.EW.excess[2,5]*100, 0),"%)"),
paste0("+", round(sex.age.EW.excess[3,3],0)," deaths (+",
round(sex.age.EW.excess[3,5]*100, 0),"%)"),
paste0("+", round(sex.age.EW.excess[4,3],0)," deaths (+",
round(sex.age.EW.excess[4,5]*100, 0),"%)"),
paste0("+", round(sex.age.EW.excess[5,3],0)," deaths (+",
round(sex.age.EW.excess[5,5]*100, 0),"%)"),
paste0("+", round(sex.age.EW.excess[6,3],0)," deaths (+",
round(sex.age.EW.excess[6,5]*100, 0),"%)"),
paste0("+", round(sex.age.EW.excess[7,3],0)," deaths (+",
round(sex.age.EW.excess[7,5]*100, 0),"%)"),
paste0("+", round(sex.age.EW.excess[8,3],0)," deaths (+",
round(sex.age.EW.excess[8,5]*100, 0),"%)")),
size=3, colour=rep("red", times=8), hjust=0)
dev.off()
#Plot by age
#Compress age groups under 45
data.age.EW$age2 <- case_when(
data.age.EW$age %in% c("Under 1 year", "01-14", "15-44") ~ "Under 45",
data.age.EW$age!="Total" ~ data.age.EW$age
)
data.age.EW$age2 <- factor(data.age.EW$age2, levels=c("Under 45", "45-64", "65-74", "75-84", "85+"))
data.age.EW <- data.age.EW %>%
group_by(weekno, age2, year) %>%
mutate(deaths=sum(deaths))
#Extract max/min values
#split off 2020 data
data.age.EW.new <- subset(data.age.EW, year==2020 & !is.na(age2))
data.age.EW.old <- subset(data.age.EW, year<2020 & !is.na(age2))
data.age.EW.old <- data.age.EW.old %>%
group_by(weekno, age2) %>%
summarise(max=max(deaths), min=min(deaths), mean=mean(deaths))
data.age.EW.new <- merge(data.age.EW.new, data.age.EW.old, by=c("weekno", "age2"))
#Calculate excess deaths vs. mean so far this year
data.age.EW.new$excess <- data.age.EW.new$deaths-data.age.EW.new$mean
age.EW.excess <- data.age.EW.new %>%
group_by(age2) %>%
summarise(excess=sum(excess), total=sum(mean), percexcess=excess/total)
#Extract label positions for excess deaths
labpos <- data.age.EW.new %>%
filter(weekno==EWmaxweek) %>%
group_by(age2) %>%
summarise(pos=max(mean+(deaths-mean)/1.4, max+600))
#Manually adjust up Under45s label to handle text wrapping
labpos[1,2] <- labpos[1,2]+500
ann_text3 <- data.frame(weekno=rep(26, times=5), deaths=labpos$pos,
age2=c("Under 45", "45-64", "65-74", "75-84", "85+")) %>%
mutate(age2=factor(age2, levels=c("Under 45", "45-64", "65-74", "75-84", "85+")))
tiff("Outputs/ONSWeeklyDeathsxAge.tiff", units="in", width=12, height=8, res=300)
ggplot()+
geom_ribbon(data=data.age.EW.old, aes(x=weekno, ymin=min, ymax=max), fill="Skyblue2")+
geom_ribbon(data=data.age.EW.new, aes(x=weekno, ymin=mean, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(data=data.age.EW.old, aes(x=weekno, y=mean), colour="Grey50", linetype=2)+
geom_line(data=data.age.EW.new, aes(x=weekno, y=deaths), colour="Red")+
theme_classic()+
facet_wrap(~age2)+
scale_x_continuous(name="Week number", breaks=c(0,10,20,30,40,50))+
scale_y_continuous(name="Deaths registered")+
expand_limits(y=0)+
labs(title="All-cause mortality remains further above 'normal' in the oldest age groups",
subtitle=paste0("Weekly deaths in <span style='color:red;'>2020</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>. Data up to ", EWDate, "."),
caption="Data from ONS | Plot by @VictimOfMaths")+
theme(strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
plot.subtitle =element_markdown(), plot.title=element_text(face="bold", size=rel(1.2)))+
geom_text(data=ann_text3, aes(x=weekno, y=deaths), label=c(paste0(round(age.EW.excess[1,2],0)," excess deaths in 2020\nvs. 2010-19 average (",
round(age.EW.excess[1,4]*100, 1),"%)"),
paste0("+", round(age.EW.excess[2,2],0)," deaths (+",
round(age.EW.excess[2,4]*100, 0),"%)"),
paste0("+", round(age.EW.excess[3,2],0)," deaths (+",
round(age.EW.excess[3,4]*100, 0),"%)"),
paste0("+", round(age.EW.excess[4,2],0)," deaths (+",
round(age.EW.excess[4,4]*100, 0),"%)"),
paste0("+", round(age.EW.excess[5,2],0)," deaths (+",
round(age.EW.excess[5,4]*100, 0),"%)")),
size=3, colour=rep("red", times=5), hjust=0)
dev.off()
###################
#Plot for Scotland#
###################
#Overall plot
#Extract max/min values
#split off 2020 data
data.S.new <- subset(data.S, year>=2020)
data.S.old <- subset(data.S, year<2020 & year>=2010)
data.S.old <- data.S.old %>%
group_by(weekno) %>%
summarise(max=max(deaths), min=min(deaths), mean=mean(deaths))
data.S.new <- merge(data.S.new, data.S.old, by=c("weekno"))
#Calculate excess deaths vs. mean so far this year
data.S.new$excess <- data.S.new$deaths-data.S.new$mean
S.excess <- data.S.new %>%
summarise(excess=sum(excess), total=sum(mean), percexcess=excess/total)
#Extract y=axis placement for excess deaths figure
labpos <- 1700
tiff("Outputs/NRSWeeklyDeaths.tiff", units="in", width=10, height=8, res=300)
ggplot()+
geom_ribbon(data=data.S.old, aes(x=weekno, ymin=min, ymax=max), fill="Skyblue2")+
geom_ribbon(data=data.S.new, aes(x=weekno, ymin=mean, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(data=data.S.old, aes(x=weekno, y=mean), colour="Grey50", linetype=2)+
geom_line(data=data.S.new, aes(x=weekno, y=deaths), colour="Red")+
theme_classic()+
scale_x_continuous(name="Week number", breaks=c(0,10,20,30,40,50))+
scale_y_continuous(name="Deaths registered")+
expand_limits(y=0)+
labs(title="All-cause deaths in Scotland have stayed within 'normal' levels",
subtitle=paste0("Weekly deaths in <span style='color:red;'>2020</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>. Data up to ", ScotDate, "."),
caption="Data from NRS | Plot by @VictimOfMaths")+
annotate(geom="text", x=22, y=labpos, label=paste0(round(S.excess$excess, 0),
" more deaths in 2020 than average (+", round(S.excess$percexcess*100, 0),"%)"), colour="Red", hjust=0)+
annotate(geom="text", x=30, y=1150, label="Historic maximum", colour="Skyblue4")+
annotate(geom="text", x=30, y=800, label="Historic minimum", colour="Skyblue4")+
annotate(geom="text", x=48, y=850, label="Historic mean", colour="grey30")+
geom_curve(aes(x=48, y=900, xend=47, yend=1050), colour="grey30", curvature=0.15,
arrow=arrow(length=unit(0.1, "cm"), type="closed"), lineend="round")+
theme(plot.subtitle =element_markdown(), plot.title=element_text(face="bold", size=rel(1.2)))
dev.off()
###########################
#Plot for Northern Ireland#
###########################
#Overall plot
#Extract max/min values
#split off 2020 data
data.NI.new <- subset(data.NI, year==2020)
data.NI.old <- subset(data.NI, year<2020)
data.NI.old <- data.NI.old %>%
group_by(weekno) %>%
summarise(max=max(deaths), min=min(deaths), mean=mean(deaths))
data.NI.new <- merge(data.NI.new, data.NI.old, by=c("weekno"))
#Calculate excess deaths vs. mean so far this year
data.NI.new$excess <- data.NI.new$deaths-data.NI.new$mean
NI.excess <- data.NI.new %>%
summarise(excess=sum(excess), total=sum(mean), percexcess=excess/total)
#Extract y=axis placement for excess deaths figure
labpos <- max(data.NI.new$mean[data.NI.new$weekno==NImaxweek]+(data.NI.new$deaths[data.NI.new$weekno==NImaxweek]-
data.NI.new$mean[data.NI.new$weekno==NImaxweek])/1.4, 400)
tiff("Outputs/NISRAWeeklyDeaths.tiff", units="in", width=10, height=8, res=300)
ggplot()+
geom_ribbon(data=data.NI.old, aes(x=weekno, ymin=min, ymax=max), fill="Skyblue2")+
geom_ribbon(data=data.NI.new, aes(x=weekno, ymin=mean, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(data=data.NI.old, aes(x=weekno, y=mean), colour="Grey50", linetype=2)+
geom_line(data=data.NI.new, aes(x=weekno, y=deaths), colour="Red")+
theme_classic()+
scale_x_continuous(name="Week number", breaks=c(0,10,20,30,40,50))+
scale_y_continuous(name="Deaths registered")+
expand_limits(y=0)+
labs(title="Deaths in Northern Ireland are still above average",
subtitle=paste0("Weekly all-cause deaths in <span style='color:red;'>2020</span> compared to <span style='color:Skyblue4;'>the range in 2011-19</span>. Data up to ", NIDate, "."),
caption="Data from NISRA | Plot by @VictimOfMaths")+
annotate(geom="text", x=23, y=labpos, label=paste0(round(NI.excess$excess, 0),
" more deaths in 2020 than average (+",
round(NI.excess$percexcess*100, 0),"%)"),
colour="Red", hjust=0)+
annotate(geom="text", x=30, y=320, label="Historic maximum", colour="Skyblue4")+
annotate(geom="text", x=30, y=160, label="Historic minimum", colour="Skyblue4")+
annotate(geom="text", x=47, y=220, label="Historic mean", colour="grey30")+
geom_curve(aes(x=48, y=230, xend=47, yend=285), colour="grey30", curvature=0.15,
arrow=arrow(length=unit(0.1, "cm"), type="closed"), lineend="round")+
theme(plot.subtitle =element_markdown(), plot.title=element_text(face="bold", size=rel(1.5)))
dev.off()
###############################
#Plots for the whole of the UK#
###############################
#Extract max/min values
#split off 2020 data
data.reg.UK.new <- subset(data.reg.UK, year==2020)
data.reg.UK.old <- subset(data.reg.UK, year<2020 & year>=2010)
data.reg.UK.old <- data.reg.UK.old %>%
group_by(weekno, reg) %>%
summarise(max=max(deaths), min=min(deaths), mean=mean(deaths))
data.reg.UK.new <- merge(data.reg.UK.new, data.reg.UK.old, by=c("weekno", "reg"))
#Calculate excess deaths vs. mean so far this year
data.reg.UK.new$excess <- data.reg.UK.new$deaths-data.reg.UK.new$mean
reg.UK.excess <- data.reg.UK.new %>%
group_by(reg) %>%
summarise(excess=sum(excess), total=sum(mean), percexcess=excess/total)
data.reg.UK.new <- data.reg.UK.new %>%
group_by(reg) %>%
mutate(maxexcess=max(excess))
data.reg.UK.new$reg <- fct_reorder(data.reg.UK.new$reg, -data.reg.UK.new$maxexcess)
data.reg.UK.old$reg <- factor(data.reg.UK.old$reg, levels=levels(data.reg.UK.new$reg))
reg.UK.excess$reg <-factor(reg.UK.excess$reg, levels=levels(data.reg.UK.new$reg))
reg.UK.excess <- arrange(reg.UK.excess, reg.UK.excess$reg)
#Extract label positions for excess deaths
labpos <- data.reg.UK.new %>%
filter(weekno==case_when(
reg=="Scotland" ~ if_else(Scotmaxweek<EWmaxweek, Scotmaxweek, EWmaxweek),
reg=="Northern Ireland" ~ if_else(NImaxweek<EWmaxweek, NImaxweek, EWmaxweek),
TRUE ~EWmaxweek)) %>%
group_by(reg) %>%
summarise(pos=max(mean+(deaths-mean)/1.6, max+800))
#Sort out subtitle
subtitle <- ifelse(EWDate==NIDate, paste0("Weekly deaths in <span style='color:red;'>2020</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>.<br>England, Wales and Northern Ireland data to ", EWDate, ".<br>Scotland data to ", ScotDate, "."),
paste0("Weekly deaths in <span style='color:red;'>2020</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span><br>England and Wales data to ", EWDate, ".<br>Northern Ireland data to ", NIDate, ".<br>Scotland data to ", ScotDate, "."))
#Add labels to each facet w/ excess deaths
ann_text4 <- data.frame(weekno=rep(24, times=12), deaths=labpos$pos, reg=unique(labpos$reg))
RegPlot <- ggplot()+
geom_ribbon(data=data.reg.UK.old, aes(x=weekno, ymin=min, ymax=max), fill="Skyblue2")+
geom_ribbon(data=data.reg.UK.new, aes(x=weekno, ymin=mean, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(data=data.reg.UK.old, aes(x=weekno, y=mean), colour="Grey50", linetype=2)+
geom_line(data=data.reg.UK.new, aes(x=weekno, y=deaths), colour="Red")+
theme_classic()+
facet_wrap(~reg)+
scale_x_continuous(name="Week number", breaks=c(0,10,20,30,40,50))+
scale_y_continuous(name="Deaths registered")+
expand_limits(y=0)+
labs(title="Regional variation in all-cause mortality in the UK",
subtitle=subtitle,
caption="Data from ONS, NRS & NISRA | Plot by @VictimOfMaths")+
theme(strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
plot.subtitle =element_markdown(), plot.title=element_text(face="bold", size=rel(1.2)))+
geom_text(data=ann_text4, aes(x=weekno, y=deaths), label=c(paste0(round(reg.UK.excess[1,2], 0),
" excess deaths in 2020\nvs. 2010-19 average (+",
round(reg.UK.excess[1,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[2,2], 0),
" deaths (+",
round(reg.UK.excess[2,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[3,2], 0),
" deaths (+",
round(reg.UK.excess[3,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[4,2], 0),
" deaths (+",
round(reg.UK.excess[4,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[5,2], 0),
" deaths (+",
round(reg.UK.excess[5,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[6,2], 0),
" deaths (+",
round(reg.UK.excess[6,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[7,2], 0),
" deaths (+",
round(reg.UK.excess[7,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[8,2], 0),
" deaths (+",
round(reg.UK.excess[8,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[9,2], 0),
" deaths (+",
round(reg.UK.excess[9,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[10,2], 0),
" deaths (+",
round(reg.UK.excess[10,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[11,2], 0),
" deaths (+",
round(reg.UK.excess[11,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[12,2], 0),
" deaths (+",
round(reg.UK.excess[12,4]*100, 0),"%)")),
size=3, colour="Red", hjust=0)
tiff("Outputs/ONSNRSNISRAWeeklyDeathsxReg.tiff", units="in", width=12, height=9, res=300)
RegPlot
dev.off()
png("Outputs/ONSNRSNISRAWeeklyDeathsxReg.png", units="in", width=12, height=9, res=300)
RegPlot
dev.off()
RegPlot2 <- ggplot()+
geom_ribbon(data=data.reg.UK.old, aes(x=weekno, ymin=min, ymax=max), fill="Skyblue2")+
geom_ribbon(data=data.reg.UK.new, aes(x=weekno, ymin=mean, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(data=data.reg.UK.old, aes(x=weekno, y=mean), colour="Grey50", linetype=2)+
geom_line(data=data.reg.UK.new, aes(x=weekno, y=deaths), colour="Red")+
theme_classic()+
facet_wrap(~reg, scales="free_y")+
scale_x_continuous(name="Week number", breaks=c(0,10,20,30,40,50))+
scale_y_continuous(name="Deaths registered")+
expand_limits(y=0)+
labs(title="Regional variation in all-cause mortality in the UK",
subtitle=subtitle,
caption="Data from ONS, NRS & NISRA | Plot by @VictimOfMaths")+
theme(strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
plot.subtitle =element_markdown(), plot.title=element_text(face="bold", size=rel(1.2)))+
geom_text(data=ann_text4, aes(x=weekno, y=deaths), label=c(paste0(round(reg.UK.excess[1,2], 0),
" excess deaths in 2020\nvs. 2010-19 average (+",
round(reg.UK.excess[1,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[2,2], 0),
" deaths (+",
round(reg.UK.excess[2,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[3,2], 0),
" deaths (+",
round(reg.UK.excess[3,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[4,2], 0),
" deaths (+",
round(reg.UK.excess[4,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[5,2], 0),
" deaths (+",
round(reg.UK.excess[5,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[6,2], 0),
" deaths (+",
round(reg.UK.excess[6,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[7,2], 0),
" deaths (+",
round(reg.UK.excess[7,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[8,2], 0),
" deaths (+",
round(reg.UK.excess[8,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[9,2], 0),
" deaths (+",
round(reg.UK.excess[9,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[10,2], 0),
" deaths (+",
round(reg.UK.excess[10,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[11,2], 0),
" deaths (+",
round(reg.UK.excess[11,4]*100, 0),"%)"),
paste0("+", round(reg.UK.excess[12,2], 0),
" deaths (+",
round(reg.UK.excess[12,4]*100, 0),"%)")),
size=3, colour="Red", hjust=0)
tiff("Outputs/ONSNRSNISRAWeeklyDeathsxReg2.tiff", units="in", width=13, height=9, res=300)
RegPlot2
dev.off()
#Generate cumulative death counts by year
data.reg.UK <- data.reg.UK %>%
group_by(reg, year) %>%
arrange(reg, year, weekno) %>%
mutate(cumul_deaths=cumsum(deaths))
ann_text5 <- data.frame(weekno=EWmaxweek,
cumul_deaths=data.reg.UK$cumul_deaths[data.reg.UK$reg=="London" & data.reg.UK$weekno==EWmaxweek & data.reg.UK$year==2020]+5000,
reg="London")
tiff("Outputs/ONSNRSNISRAWeeklyCumulDeaths_reg.tiff", units="in", width=12, height=8, res=300)
ggplot()+
geom_line(data=subset(data.reg.UK, year!=2020 & year>=2010), aes(x=weekno, y=cumul_deaths, group=as.factor(year)), colour="Grey80")+
geom_line(data=subset(data.reg.UK, year==2020), aes(x=weekno, y=cumul_deaths), colour="Red")+
theme_classic()+
facet_wrap(~reg)+
facet_wrap(~reg)+
scale_x_continuous(name="Week number")+
scale_y_continuous(name="Deaths registered")+
theme(strip.background=element_blank(), strip.text=element_text(face="bold"),
plot.title =element_markdown())+
labs(title="Cumulative deaths from all causes in <span style='color:red;'>2020</span> compared to <span style='color:Grey60;'>the range in 2010-19</span>",
caption="Data from ONS, NRS & NISRA | Plot by @VictimOfMaths")+
geom_text(data=ann_text5, aes(x=weekno, y=cumul_deaths), label=c("2020"), size=3, colour="Red")
dev.off()
###############################################################
#Plot similar charts for death by location for England & Wales#
###############################################################
#Read in historic average deaths by place
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=/peoplepopulationandcommunity/birthsdeathsandmarriages/deaths/adhocs/11622fiveyearaverageweeklydeathsbyplaceofdeathenglandandwalesdeathsoccurringbetween2015and2019/fiveyearavgweeklydeaths2015to2019podfinal.xlsx"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
data1519 <- read_excel(temp, sheet="Table", range="A4:G56")
data1519$week <- as.numeric(substr(data1519$...1, 6,7))
data1519_long <- gather(data1519, location, deaths, c(2:7))[,-c(1)]
data1519_long$year <- "hist"
#Read in 2020 figures, which are formatted in a *hideous* way, thanks ONS
temp <- tempfile()
temp <- curl_download(url=Eng2020, destfile=temp, quiet=FALSE, mode="wb")
temp1 <- as.data.frame(t(read_excel(temp, sheet=11, range="A9:B14", col_names=FALSE)))
temp2 <- as.data.frame(t(read_excel(temp, sheet=11, range="H9:H14", col_names=FALSE)))
temp3 <- as.data.frame(t(read_excel(temp, sheet=11, range="N9:N14", col_names=FALSE)))
temp4 <- as.data.frame(t(read_excel(temp, sheet=11, range="T9:T14", col_names=FALSE)))
temp5 <- as.data.frame(t(read_excel(temp, sheet=11, range="Z9:Z14", col_names=FALSE)))
temp6 <- as.data.frame(t(read_excel(temp, sheet=11, range="AF9:AF14", col_names=FALSE)))
temp7 <- as.data.frame(t(read_excel(temp, sheet=11, range="AL9:AL14", col_names=FALSE)))
temp8 <- as.data.frame(t(read_excel(temp, sheet=11, range="AR9:AR14", col_names=FALSE)))
temp9 <- as.data.frame(t(read_excel(temp, sheet=11, range="AX9:AX14", col_names=FALSE)))
temp10 <- as.data.frame(t(read_excel(temp, sheet=11, range="BD9:BD14", col_names=FALSE)))
temp11 <- as.data.frame(t(read_excel(temp, sheet=11, range="BJ9:BJ14", col_names=FALSE)))
temp12 <- as.data.frame(t(read_excel(temp, sheet=11, range="BP9:BP14", col_names=FALSE)))
temp13 <- as.data.frame(t(read_excel(temp, sheet=11, range="BV9:BV14", col_names=FALSE)))
temp14 <- as.data.frame(t(read_excel(temp, sheet=11, range="CB9:CB14", col_names=FALSE)))
temp15 <- as.data.frame(t(read_excel(temp, sheet=11, range="CH9:CH14", col_names=FALSE)))
temp16 <- as.data.frame(t(read_excel(temp, sheet=11, range="CN9:CN14", col_names=FALSE)))
temp17 <- as.data.frame(t(read_excel(temp, sheet=11, range="CT9:CT14", col_names=FALSE)))
temp18 <- as.data.frame(t(read_excel(temp, sheet=11, range="CZ9:CZ14", col_names=FALSE)))
temp19 <- as.data.frame(t(read_excel(temp, sheet=11, range="DF9:DF14", col_names=FALSE)))
temp20 <- as.data.frame(t(read_excel(temp, sheet=11, range="DL9:DL14", col_names=FALSE)))
temp21 <- as.data.frame(t(read_excel(temp, sheet=11, range="DR9:DR14", col_names=FALSE)))
temp22 <- as.data.frame(t(read_excel(temp, sheet=11, range="DX9:DX14", col_names=FALSE)))
temp23 <- as.data.frame(t(read_excel(temp, sheet=11, range="ED9:ED14", col_names=FALSE)))
temp24 <- as.data.frame(t(read_excel(temp, sheet=11, range="EJ9:EJ14", col_names=FALSE)))
temp25 <- as.data.frame(t(read_excel(temp, sheet=11, range="EP9:EP14", col_names=FALSE)))
temp26 <- as.data.frame(t(read_excel(temp, sheet=11, range="EV9:EV14", col_names=FALSE)))
temp27 <- as.data.frame(t(read_excel(temp, sheet=11, range="FB9:FB14", col_names=FALSE)))
temp28 <- as.data.frame(t(read_excel(temp, sheet=11, range="FH9:FH14", col_names=FALSE)))
temp29 <- as.data.frame(t(read_excel(temp, sheet=11, range="FN9:FN14", col_names=FALSE)))
temp30 <- as.data.frame(t(read_excel(temp, sheet=11, range="FT9:FT14", col_names=FALSE)))
temp31 <- as.data.frame(t(read_excel(temp, sheet=11, range="FZ9:FZ14", col_names=FALSE)))
temp32 <- as.data.frame(t(read_excel(temp, sheet=11, range="GF9:GF14", col_names=FALSE)))
temp33 <- as.data.frame(t(read_excel(temp, sheet=11, range="GL9:GL14", col_names=FALSE)))
temp34 <- as.data.frame(t(read_excel(temp, sheet=11, range="GR9:GR14", col_names=FALSE)))
temp35 <- as.data.frame(t(read_excel(temp, sheet=11, range="GX9:GX14", col_names=FALSE)))
temp36 <- as.data.frame(t(read_excel(temp, sheet=11, range="HD9:HD14", col_names=FALSE)))
temp37 <- as.data.frame(t(read_excel(temp, sheet=11, range="HJ9:HJ14", col_names=FALSE)))
temp38 <- as.data.frame(t(read_excel(temp, sheet=11, range="HP9:HP14", col_names=FALSE)))
temp39 <- as.data.frame(t(read_excel(temp, sheet=11, range="HV9:HV14", col_names=FALSE)))
temp40 <- as.data.frame(t(read_excel(temp, sheet=11, range="IB9:IB14", col_names=FALSE)))
temp41 <- as.data.frame(t(read_excel(temp, sheet=11, range="IH9:IH14", col_names=FALSE)))
temp42 <- as.data.frame(t(read_excel(temp, sheet=11, range="IN9:IN14", col_names=FALSE)))
temp43 <- as.data.frame(t(read_excel(temp, sheet=11, range="IT9:IT14", col_names=FALSE)))
colnames(temp1) <- temp1 %>% slice(1) %>% unlist()
temp1 <- temp1 %>% slice(-1)
temp1$week <- 11
temp1 <- temp1 %>% mutate_if(is.factor, as.character) %>% mutate_if(is.character, as.numeric)
data20 <- bind_rows(temp2, temp3, temp4, temp5, temp6, temp7, temp8, temp9, temp10, temp11,
temp12, temp13, temp14, temp15, temp16, temp17, temp18, temp19, temp20,
temp21, temp22, temp23, temp24, temp25, temp26, temp27, temp28, temp29,
temp30, temp31, temp32, temp33, temp34, temp35, temp36, temp37, temp38,
temp39, temp40, temp41, temp42, temp43)
data20$week <- c(12:EWmaxweek)
colnames(data20) <- colnames(temp1)
data20 <- bind_rows(temp1, data20)
data20_long <- gather(data20, location, deaths, c(1:6))
data20_long$year <- "curr"
#Align location names
data20_long$location <- case_when(
data20_long$location=="Hospital (acute or community, not psychiatric)" ~ "Hospital",
data20_long$location=="Care Home" ~ "Care home",
TRUE ~ data20_long$location
)
#Merge old and 2020 data
data <- bind_rows(data1519_long, data20_long)
#extract peak deaths to order facets
data <- data %>%
group_by(location) %>%
mutate(max=max(deaths))
data$location <- fct_reorder(data$location, -data$max)
tiff("Outputs/ONSWeeklyDeathsxLocation.tiff", units="in", width=12, height=8, res=300)
ggplot()+
geom_line(data=subset(data, year=="hist"), aes(x=week, y=deaths), colour="skyblue4")+
geom_line(data=subset(data, year=="curr"), aes(x=week, y=deaths), colour="red")+
scale_x_continuous(name="Week")+
scale_y_continuous(name="Deaths registered")+
facet_wrap(~location)+
theme_classic()+
theme(strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
plot.subtitle =element_markdown(), plot.title=element_text(face="bold", size=rel(1.2)))+
labs(title="All cause deaths have fallen across all settings",
subtitle=paste0("Registered weekly deaths in England & Wales in <span style='color:red;'>2020</span> compared to <span style='color:Skyblue4;'>the average for 2015-19</span>. Data up to ", EWDate, "."),
caption="Data from ONS | Plot by @VictimOfMaths")
dev.off()
##############################
#COVID vs. non-COVID excess deaths
temp <- tempfile()
temp <- curl_download(url=Eng2020, destfile=temp, quiet=FALSE, mode="wb")
EngCause <- as.data.frame(t(read_excel(temp, sheet=5, range=paste0("C9:", EngRange, "19"),
col_names=FALSE)))[,c(1,3,11)]
colnames(EngCause) <- c("Total2020", "Mean1519", "COVID")
EngCause$week <- seq(1:nrow(EngCause))
EngCause$other <- EngCause$Total2020-EngCause$COVID
EngCause$excess <- EngCause$other-EngCause$Mean1519
EngCause$allexcess <- EngCause$Total2020-EngCause$Mean1519
EngCause_long <- gather(EngCause, cause, deaths, c(6,3,7))
tiff("Outputs/ONSExcessxCause.tiff", units="in", width=8, height=6, res=500)
ggplot()+
geom_col(data=subset(EngCause_long, cause!="allexcess"),
aes(x=week, y=deaths, fill=cause), position="stack")+
geom_segment(aes(x=0.5, xend=max(EngCause$week)+0.5, y=0, yend=0), colour="Grey30")+
geom_line(data=subset(EngCause_long, cause=="allexcess"),
aes(x=week, y=deaths, colour=cause))+
scale_x_continuous(name="Week")+
scale_y_continuous(name="Excess deaths vs. 2015-19 mean")+
scale_fill_paletteer_d("LaCroixColoR::PinaFraise", name="Cause", labels=c("COVID-19", "Other causes"))+
scale_colour_manual(values="NavyBlue", name="", labels="Net excess deaths")+
theme_classic()+
labs(title="The number of confirmed COVID-19 deaths rose while excess deaths fell overall",
subtitle="Excess deaths vs. 2015-19 average by cause for England & Wales",
caption="Data from ONS | Plot by @VictimOfMaths")+
theme(plot.title=element_text(face="bold", size=rel(1.2)))
dev.off()
================================================
FILE: All Cause Mortality/AllCauseDeaths2021.R
================================================
rm(list=ls())
library(tidyverse)
library(paletteer)
library(curl)
library(readxl)
library(lubridate)
library(forcats)
library(ggtext)
library(ragg)
library(extrafont)
#Latest date in the country-specific data
EWDate <- "29th October"
ScotDate <- "7th November"
NIDate <- "5th November"
#Locations for 2020/21 data
#England, released at 9:30 on Tuesday mornings
#https://www.ons.gov.uk/peoplepopulationandcommunity/birthsdeathsandmarriages/deaths/datasets/weeklyprovisionalfiguresondeathsregisteredinenglandandwales
Eng2021 <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2021/publishedweek432021.xlsx"
#Scotland, released at noon on Wednesdays
#https://www.nrscotland.gov.uk/covid19stats
Scot2021 <- "https://www.nrscotland.gov.uk/files//statistics/covid19/covid-deaths-21-data-week-44.xlsx"
#Northern Ireland, released on Fridays
#https://www.nisra.gov.uk/publications/weekly-deaths
NI2021 <- "https://www.nisra.gov.uk/system/files/statistics/Weekly_Deaths%20-%20w%20e%205th%20November%202021.XLSX"
#Stupid Excel range controls
#These need to be incremented by one letter each week
EngRange <- "AS"
ScotRange <- "AT"
NIRange <- "44"
##############################
#Read in English & Welsh data#
##############################
#Archive version with 2020 data in it
Eng2020 <- "https://www.ons.gov.uk/file?uri=/peoplepopulationandcommunity/birthsdeathsandmarriages/deaths/datasets/weeklyprovisionalfiguresondeathsregisteredinenglandandwales/2020/publishedweek532020.xlsx"
#Start with 2021
temp <- tempfile()
temp <- curl_download(url=Eng2021, destfile=temp, quiet=FALSE, mode="wb")
#By age & sex
data2021.as.EW <- read_excel(temp, sheet="Weekly figures 2021",
range=paste0("B40:", EngRange, "81"), col_names=FALSE) %>%
slice(-c(21,22)) %>%
mutate(sex=rep(c("Male", "Female"), each=20)) %>%
gather(index, deaths, c(2:(ncol(.)-1))) %>%
rename(age=`...1`) %>%
mutate(date=as.Date("2021-01-08")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date-days(1))) %>%
select(-index) %>%
mutate(age=case_when(
age=="<1" ~ "Under 1 year",
age %in% c("1-4", "5-9", "10-14") ~ "01-14",
age %in% c("15-19", "20-24", "25-29", "30-34", "35-39", "40-44") ~ "15-44",
age %in% c("45-49", "50-54", "55-59", "60-64") ~ "45-64",
age %in% c("65-69", "70-74") ~ "65-74",
age %in% c("75-79", "80-84") ~ "75-84",
TRUE ~ "85+"
)) %>%
group_by(date, week, year, sex, age) %>%
summarise(deaths=sum(deaths)) %>%
ungroup()
#By region
data2021.reg.EW <- read_excel(temp, sheet="Weekly figures 2021",
range=paste0("B83:", EngRange, "92"), col_names=FALSE) %>%
gather(index, deaths, c(2:ncol(.))) %>%
rename(region=`...1`) %>%
mutate(date=as.Date("2021-01-08")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date-days(1))) %>%
select(-index)
#2020
temp <- tempfile()
temp <- curl_download(url=Eng2020, destfile=temp, quiet=FALSE, mode="wb")
#By age & sex
data2020.as.EW <- read_excel(temp, sheet="Weekly figures 2020",
range="B44:BC85", col_names=FALSE) %>%
slice(-c(21,22)) %>%
mutate(sex=rep(c("Male", "Female"), each=20)) %>%
gather(index, deaths, c(2:(ncol(.)-1))) %>%
rename(age=`...1`) %>%
mutate(date=as.Date("2020-01-03")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date-days(1))) %>%
select(-index) %>%
mutate(age=case_when(
age=="<1" ~ "Under 1 year",
age %in% c("1-4", "5-9", "10-14") ~ "01-14",
age %in% c("15-19", "20-24", "25-29", "30-34", "35-39", "40-44") ~ "15-44",
age %in% c("45-49", "50-54", "55-59", "60-64") ~ "45-64",
age %in% c("65-69", "70-74") ~ "65-74",
age %in% c("75-79", "80-84") ~ "75-84",
TRUE ~ "85+"
)) %>%
group_by(date, week, year, sex, age) %>%
summarise(deaths=sum(deaths)) %>%
ungroup()
#By region
data2020.reg.EW <- read_excel(temp, sheet="Weekly figures 2020",
range="B87:BC96", col_names=FALSE) %>%
gather(index, deaths, c(2:ncol(.))) %>%
rename(region=`...1`) %>%
mutate(date=as.Date("2020-01-03")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date-days(1))) %>%
select(-index)
#2019
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2019/publishedweek522019.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age & sex
data19.as.EW <- read_excel(temp, sheet="Weekly figures 2019",
range="B25:BB40", col_names=FALSE) %>%
slice(-c(8,9)) %>%
mutate(sex=rep(c("Male", "Female"), each=7)) %>%
gather(index, deaths, c(2:(ncol(.)-1))) %>%
rename(age=`...1`) %>%
mutate(date=as.Date("2019-01-04")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#By region
data19.reg.EW <- read_excel(temp, sheet="Weekly figures 2019",
range=paste0("B43:", EngRange, "52"), col_names=FALSE) %>%
gather(index, deaths, c(2:ncol(.))) %>%
rename(region=`...1`) %>%
mutate(date=as.Date("2019-01-04")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#2019
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2019/publishedweek522019.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age & sex
data19.as.EW <- read_excel(temp, sheet="Weekly figures 2019",
range="B25:BB40", col_names=FALSE) %>%
slice(-c(8,9)) %>%
mutate(sex=rep(c("Male", "Female"), each=7)) %>%
gather(index, deaths, c(2:(ncol(.)-1))) %>%
rename(age=`...1`) %>%
mutate(date=as.Date("2019-01-04")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#By region
data19.reg.EW <- read_excel(temp, sheet="Weekly figures 2019",
range=paste0("B43:BB52"), col_names=FALSE) %>%
gather(index, deaths, c(2:ncol(.))) %>%
rename(region=`...1`) %>%
mutate(date=as.Date("2019-01-04")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#2018 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2018/publishedweek522018withupdatedrespiratoryrow.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age & sex
data18.as.EW <- read_excel(temp, sheet="Weekly figures 2018",
range="B25:BB40", col_names=FALSE) %>%
slice(-c(8,9)) %>%
mutate(sex=rep(c("Male", "Female"), each=7)) %>%
gather(index, deaths, c(2:(ncol(.)-1))) %>%
rename(age=`...1`) %>%
mutate(date=as.Date("2018-01-05")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#By region
data18.reg.EW <- read_excel(temp, sheet="Weekly figures 2018",
range=paste0("B43:BB52"), col_names=FALSE) %>%
gather(index, deaths, c(2:ncol(.))) %>%
rename(region=`...1`) %>%
mutate(date=as.Date("2018-01-05")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#2017 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2017/publishedweek522017.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age & sex
data17.as.EW <- read_excel(temp, sheet="Weekly figures 2017",
range="B25:BB40", col_names=FALSE) %>%
slice(-c(8,9)) %>%
mutate(sex=rep(c("Male", "Female"), each=7)) %>%
gather(index, deaths, c(2:(ncol(.)-1))) %>%
rename(age=`...1`) %>%
mutate(date=as.Date("2017-01-06")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#By region
data17.reg.EW <- read_excel(temp, sheet="Weekly figures 2017",
range=paste0("B43:BB52"), col_names=FALSE) %>%
gather(index, deaths, c(2:ncol(.))) %>%
rename(region=`...1`) %>%
mutate(date=as.Date("2017-01-06")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#2016 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2016/publishedweek522016.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age & sex
data16.as.EW <- read_excel(temp, sheet="Weekly figures 2016",
range="B25:BB40", col_names=FALSE) %>%
slice(-c(8,9)) %>%
mutate(sex=rep(c("Male", "Female"), each=7)) %>%
gather(index, deaths, c(2:(ncol(.)-1))) %>%
rename(age=`...1`) %>%
mutate(date=as.Date("2016-01-08")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#By region
data16.reg.EW <- read_excel(temp, sheet="Weekly figures 2016",
range=paste0("B43:BB52"), col_names=FALSE) %>%
gather(index, deaths, c(2:ncol(.))) %>%
rename(region=`...1`) %>%
mutate(date=as.Date("2016-01-08")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#2015 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2015/publishedweek2015.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age & sex
data15.as.EW <- read_excel(temp, sheet="Weekly Figures 2015",
range="A25:BB40", col_names=FALSE) %>%
slice(-c(8,9)) %>%
mutate(sex=rep(c("Male", "Female"), each=7)) %>%
gather(index, deaths, c(2:(ncol(.)-1))) %>%
rename(age=`...1`) %>%
mutate(date=as.Date("2015-01-02")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date-days(1))) %>%
select(-index)
#By region
data15.reg.EW <- read_excel(temp, sheet="Weekly Figures 2015",
range=paste0("A43:BB52"), col_names=FALSE) %>%
gather(index, deaths, c(2:ncol(.))) %>%
rename(region=`...1`) %>%
mutate(date=as.Date("2015-01-02")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date-days(1))) %>%
select(-index)
#2014 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2014/publishedweek2014.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age & sex
data14.as.EW <- read_excel(temp, sheet="Weekly Figures 2014",
range="A25:BA40", col_names=FALSE) %>%
slice(-c(8,9)) %>%
mutate(sex=rep(c("Male", "Female"), each=7)) %>%
gather(index, deaths, c(2:(ncol(.)-1))) %>%
rename(age=`...1`) %>%
mutate(date=as.Date("2014-01-03")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#By region
data14.reg.EW <- read_excel(temp, sheet="Weekly Figures 2014",
range=paste0("A43:BA52"), col_names=FALSE) %>%
gather(index, deaths, c(2:ncol(.))) %>%
rename(region=`...1`) %>%
mutate(date=as.Date("2014-01-03")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#2013 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2013/publishedweek2013.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age & sex
data13.as.EW <- read_excel(temp, sheet="Weekly Figures 2013",
range="A25:BA40", col_names=FALSE) %>%
slice(-c(8,9)) %>%
mutate(sex=rep(c("Male", "Female"), each=7)) %>%
gather(index, deaths, c(2:(ncol(.)-1))) %>%
rename(age=`...1`) %>%
mutate(date=as.Date("2013-01-04")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#By region
data13.reg.EW <- read_excel(temp, sheet="Weekly Figures 2013",
range=paste0("A43:BA52"), col_names=FALSE) %>%
gather(index, deaths, c(2:ncol(.))) %>%
rename(region=`...1`) %>%
mutate(date=as.Date("2013-01-04")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#2012 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2012/publishedweek2012.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age & sex
data12.as.EW <- read_excel(temp, sheet="Weekly Figures 2012",
range="A25:BA40", col_names=FALSE) %>%
slice(-c(8,9)) %>%
mutate(sex=rep(c("Male", "Female"), each=7)) %>%
gather(index, deaths, c(2:(ncol(.)-1))) %>%
rename(age=`...1`) %>%
mutate(date=as.Date("2012-01-06")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#By region
data12.reg.EW <- read_excel(temp, sheet="Weekly Figures 2012",
range=paste0("A43:BA52"), col_names=FALSE) %>%
gather(index, deaths, c(2:ncol(.))) %>%
rename(region=`...1`) %>%
mutate(date=as.Date("2012-01-06")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#2011 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2011/publishedweek2011.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age & sex
data11.as.EW <- read_excel(temp, sheet="Weekly Figures 2011",
range="A26:BA41", col_names=FALSE) %>%
slice(-c(8,9)) %>%
mutate(sex=rep(c("Male", "Female"), each=7)) %>%
gather(index, deaths, c(2:(ncol(.)-1))) %>%
rename(age=`...1`) %>%
mutate(date=as.Date("2011-01-07")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#By region
data11.reg.EW <- read_excel(temp, sheet="Weekly Figures 2011",
range=paste0("A44:BA53"), col_names=FALSE) %>%
gather(index, deaths, c(2:ncol(.))) %>%
rename(region=`...1`) %>%
mutate(date=as.Date("2011-01-07")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#2010 data
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=%2fpeoplepopulationandcommunity%2fbirthsdeathsandmarriages%2fdeaths%2fdatasets%2fweeklyprovisionalfiguresondeathsregisteredinenglandandwales%2f2010/publishedweek2010.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
#By age & sex
data10.as.EW <- read_excel(temp, sheet="Weekly Figures 2010",
range="A25:BA40", col_names=FALSE) %>%
slice(-c(8,9)) %>%
mutate(sex=rep(c("Male", "Female"), each=7)) %>%
gather(index, deaths, c(2:(ncol(.)-1))) %>%
rename(age=`...1`) %>%
mutate(date=as.Date("2010-01-08")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#By region
data10.reg.EW <- read_excel(temp, sheet="Weekly Figures 2010",
range=paste0("A43:BA52"), col_names=FALSE) %>%
gather(index, deaths, c(2:ncol(.))) %>%
rename(region=`...1`) %>%
mutate(date=as.Date("2010-01-08")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date)) %>%
select(-index)
#Merge together
data.as.EW <- bind_rows(data10.as.EW, data11.as.EW, data12.as.EW, data13.as.EW,
data14.as.EW, data15.as.EW, data16.as.EW, data17.as.EW,
data18.as.EW, data19.as.EW, data2020.as.EW, data2021.as.EW) %>%
#Join <1 and 1-14 age bands
mutate(age=case_when(
age %in% c("Under 1 year", "01-14") ~ "Under 15",
TRUE ~ age)) %>%
group_by(age, sex, date, week, year) %>%
summarise(deaths=sum(deaths)) %>%
ungroup()
#Add total rows, by age, sex and overall
agetot <- data.as.EW %>%
group_by(age, date, week, year) %>%
summarise(deaths=sum(deaths)) %>%
mutate(sex="Total") %>%
ungroup()
sextot <- data.as.EW %>%
group_by(sex, date, week, year) %>%
summarise(deaths=sum(deaths)) %>%
mutate(age="Total") %>%
ungroup()
alltot <- data.as.EW %>%
group_by(date, week, year) %>%
summarise(deaths=sum(deaths)) %>%
mutate(age="Total", sex="Total") %>%
ungroup()
data.as.EW <- bind_rows(data.as.EW, agetot, sextot, alltot)
data.reg.EW <- bind_rows(data10.reg.EW, data11.reg.EW, data12.reg.EW, data13.reg.EW,
data14.reg.EW, data15.reg.EW, data16.reg.EW, data17.reg.EW,
data18.reg.EW, data19.reg.EW, data2020.reg.EW, data2021.reg.EW)
rm(data10.as.EW, data11.as.EW, data12.as.EW, data13.as.EW, data14.as.EW, data15.as.EW,
data16.as.EW, data17.as.EW, data18.as.EW, data19.as.EW, data2021.as.EW, data10.reg.EW,
data11.reg.EW, data12.reg.EW, data13.reg.EW, data14.reg.EW, data15.reg.EW,
data16.reg.EW, data17.reg.EW, data18.reg.EW, data19.reg.EW, data2021.reg.EW,
agetot, sextot, alltot, data2020.as.EW, data2020.reg.EW)
#Bring in data by location for 20/21 which is *horribly* formatted
temp <- tempfile()
temp <- curl_download(url=Eng2020, destfile=temp, quiet=FALSE, mode="wb")
#2020
temp1 <- as.data.frame(t(read_excel(temp, sheet=11, range="B9:B14", col_names=FALSE)))
temp2 <- as.data.frame(t(read_excel(temp, sheet=11, range="H9:H14", col_names=FALSE)))
temp3 <- as.data.frame(t(read_excel(temp, sheet=11, range="N9:N14", col_names=FALSE)))
temp4 <- as.data.frame(t(read_excel(temp, sheet=11, range="T9:T14", col_names=FALSE)))
temp5 <- as.data.frame(t(read_excel(temp, sheet=11, range="Z9:Z14", col_names=FALSE)))
temp6 <- as.data.frame(t(read_excel(temp, sheet=11, range="AF9:AF14", col_names=FALSE)))
temp7 <- as.data.frame(t(read_excel(temp, sheet=11, range="AL9:AL14", col_names=FALSE)))
temp8 <- as.data.frame(t(read_excel(temp, sheet=11, range="AR9:AR14", col_names=FALSE)))
temp9 <- as.data.frame(t(read_excel(temp, sheet=11, range="AX9:AX14", col_names=FALSE)))
temp10 <- as.data.frame(t(read_excel(temp, sheet=11, range="BD9:BD14", col_names=FALSE)))
temp11 <- as.data.frame(t(read_excel(temp, sheet=11, range="BJ9:BJ14", col_names=FALSE)))
temp12 <- as.data.frame(t(read_excel(temp, sheet=11, range="BP9:BP14", col_names=FALSE)))
temp13 <- as.data.frame(t(read_excel(temp, sheet=11, range="BV9:BV14", col_names=FALSE)))
temp14 <- as.data.frame(t(read_excel(temp, sheet=11, range="CB9:CB14", col_names=FALSE)))
temp15 <- as.data.frame(t(read_excel(temp, sheet=11, range="CH9:CH14", col_names=FALSE)))
temp16 <- as.data.frame(t(read_excel(temp, sheet=11, range="CN9:CN14", col_names=FALSE)))
temp17 <- as.data.frame(t(read_excel(temp, sheet=11, range="CT9:CT14", col_names=FALSE)))
temp18 <- as.data.frame(t(read_excel(temp, sheet=11, range="CZ9:CZ14", col_names=FALSE)))
temp19 <- as.data.frame(t(read_excel(temp, sheet=11, range="DF9:DF14", col_names=FALSE)))
temp20 <- as.data.frame(t(read_excel(temp, sheet=11, range="DL9:DL14", col_names=FALSE)))
temp21 <- as.data.frame(t(read_excel(temp, sheet=11, range="DR9:DR14", col_names=FALSE)))
temp22 <- as.data.frame(t(read_excel(temp, sheet=11, range="DX9:DX14", col_names=FALSE)))
temp23 <- as.data.frame(t(read_excel(temp, sheet=11, range="ED9:ED14", col_names=FALSE)))
temp24 <- as.data.frame(t(read_excel(temp, sheet=11, range="EJ9:EJ14", col_names=FALSE)))
temp25 <- as.data.frame(t(read_excel(temp, sheet=11, range="EP9:EP14", col_names=FALSE)))
temp26 <- as.data.frame(t(read_excel(temp, sheet=11, range="EV9:EV14", col_names=FALSE)))
temp27 <- as.data.frame(t(read_excel(temp, sheet=11, range="FB9:FB14", col_names=FALSE)))
temp28 <- as.data.frame(t(read_excel(temp, sheet=11, range="FH9:FH14", col_names=FALSE)))
temp29 <- as.data.frame(t(read_excel(temp, sheet=11, range="FN9:FN14", col_names=FALSE)))
temp30 <- as.data.frame(t(read_excel(temp, sheet=11, range="FT9:FT14", col_names=FALSE)))
temp31 <- as.data.frame(t(read_excel(temp, sheet=11, range="FZ9:FZ14", col_names=FALSE)))
temp32 <- as.data.frame(t(read_excel(temp, sheet=11, range="GF9:GF14", col_names=FALSE)))
temp33 <- as.data.frame(t(read_excel(temp, sheet=11, range="GL9:GL14", col_names=FALSE)))
temp34 <- as.data.frame(t(read_excel(temp, sheet=11, range="GR9:GR14", col_names=FALSE)))
temp35 <- as.data.frame(t(read_excel(temp, sheet=11, range="GX9:GX14", col_names=FALSE)))
temp36 <- as.data.frame(t(read_excel(temp, sheet=11, range="HD9:HD14", col_names=FALSE)))
temp37 <- as.data.frame(t(read_excel(temp, sheet=11, range="HJ9:HJ14", col_names=FALSE)))
temp38 <- as.data.frame(t(read_excel(temp, sheet=11, range="HP9:HP14", col_names=FALSE)))
temp39 <- as.data.frame(t(read_excel(temp, sheet=11, range="HV9:HV14", col_names=FALSE)))
temp40 <- as.data.frame(t(read_excel(temp, sheet=11, range="IB9:IB14", col_names=FALSE)))
temp41 <- as.data.frame(t(read_excel(temp, sheet=11, range="IH9:IH14", col_names=FALSE)))
temp42 <- as.data.frame(t(read_excel(temp, sheet=11, range="IN9:IN14", col_names=FALSE)))
temp43 <- as.data.frame(t(read_excel(temp, sheet=11, range="IT9:IT14", col_names=FALSE)))
#2021
temp <- tempfile()
temp <- curl_download(url=Eng2021, destfile=temp, quiet=FALSE, mode="wb")
temp44 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="B10:B15", col_names=FALSE)))
temp45 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="H10:H15", col_names=FALSE)))
temp46 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="N10:N15", col_names=FALSE)))
temp47 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="T10:T15", col_names=FALSE)))
temp48 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="Z10:Z15", col_names=FALSE)))
temp49 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="AF10:AF15", col_names=FALSE)))
temp50 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="AL10:AL15", col_names=FALSE)))
temp51 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="AR10:AR15", col_names=FALSE)))
temp52 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="AX10:AX15", col_names=FALSE)))
temp53 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="BD10:BD15", col_names=FALSE)))
temp54 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="BJ10:BJ15", col_names=FALSE)))
temp55 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="BP10:BP15", col_names=FALSE)))
temp56 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="BV10:BV15", col_names=FALSE)))
temp57 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="CB10:CB15", col_names=FALSE)))
temp58 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="CH10:CH15", col_names=FALSE)))
temp59 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="CN10:CN15", col_names=FALSE)))
temp60 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="CT10:CT15", col_names=FALSE)))
temp61 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="CZ10:CZ15", col_names=FALSE)))
temp62 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="DF10:DF15", col_names=FALSE)))
temp63 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="DL10:DL15", col_names=FALSE)))
temp64 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="DR10:DR15", col_names=FALSE)))
temp65 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="DX10:DX15", col_names=FALSE)))
temp66 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="ED10:ED15", col_names=FALSE)))
temp67 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="EJ10:EJ15", col_names=FALSE)))
temp68 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="EP10:EP15", col_names=FALSE)))
temp69 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="EV10:EV15", col_names=FALSE)))
temp70 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="FB10:FB15", col_names=FALSE)))
temp71 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="FH10:FH15", col_names=FALSE)))
temp72 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="FN10:FN15", col_names=FALSE)))
temp73 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="FT10:FT15", col_names=FALSE)))
temp74 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="FZ10:FZ15", col_names=FALSE)))
temp75 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="GF10:GF15", col_names=FALSE)))
temp76 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="GL10:GL15", col_names=FALSE)))
temp77 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="GR10:GR15", col_names=FALSE)))
temp78 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="GX10:GX15", col_names=FALSE)))
temp79 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="HD10:HD15", col_names=FALSE)))
temp80 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="HJ10:HJ15", col_names=FALSE)))
temp81 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="HP10:HP15", col_names=FALSE)))
temp82 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="HV10:HV15", col_names=FALSE)))
temp83 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="IB10:IB15", col_names=FALSE)))
temp84 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="IH10:IH15", col_names=FALSE)))
temp85 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="IN10:IN15", col_names=FALSE)))
temp86 <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Place of occurrence ", range="IT10:IT15", col_names=FALSE)))
data2021.loc <- bind_rows(temp1, temp2, temp3, temp4, temp5, temp6, temp7, temp8, temp9, temp10,
temp11, temp12, temp13, temp14, temp15, temp16, temp17, temp18, temp19,
temp20, temp21, temp22, temp23, temp24, temp25, temp26, temp27, temp28,
temp29, temp30, temp31, temp32, temp33, temp34, temp35, temp36, temp37,
temp38, temp39, temp40, temp41, temp42, temp43, temp44, temp45, temp46,
temp47, temp48, temp49, temp50, temp51, temp52, temp53, temp54, temp55,
temp56, temp57, temp58, temp59, temp60, temp60, temp61, temp62, temp63,
temp64, temp65, temp66, temp67, temp68, temp69, temp70, temp71, temp72,
temp73, temp74, temp75, temp76, temp77, temp78, temp79, temp80, temp81,
temp82, temp83, temp84, temp85, temp86) %>%
mutate(week=c(11:(nrow(.)+10)),
year=if_else(week<=53, 2020, 2021),
week=if_else(week>53, week-53, as.double(week)),
"Home/Other"=(V1+V3+V5+V6)) %>%
rename("Care Home"=V4, "Hospital"=V2) %>%
select(-c(V1, V3, V5, V6)) %>%
gather(location, deaths, c(1,2,5))
#Data by location for 2015-19
temp <- tempfile()
source <- "https://www.ons.gov.uk/file?uri=/peoplepopulationandcommunity/birthsdeathsandmarriages/deaths/adhocs/11622fiveyearaverageweeklydeathsbyplaceofdeathenglandandwalesdeathsoccurringbetween2015and2019/fiveyearavgweeklydeaths2015to2019podfinal.xlsx"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
data1519.loc <- read_excel(temp, sheet="Table", range="A4:G56") %>%
mutate(week=as.numeric(substr(...1, 6,7)),
year=1519,
`Home/Other`=Elsewhere+Home+Hospice+`Other communal establishment`) %>%
select(-c(1, 3:5, 7)) %>%
rename(`Care Home`=`Care home`) %>%
gather(location, deaths, c(`Home/Other`, Hospital, `Care Home`))
#Join together
data.loc.EW <- bind_rows(data2021.loc, data1519.loc)
rm(data2021.loc, data1519.loc, temp1, temp2, temp3, temp4, temp5, temp6, temp7,
temp8, temp9, temp10, temp11, temp12, temp13, temp14, temp15, temp16, temp17,
temp18, temp19, temp20, temp21, temp22, temp23, temp24, temp25, temp26, temp27,
temp28, temp29, temp30, temp31, temp32, temp33, temp34, temp35, temp36, temp37,
temp38, temp39, temp40, temp41, temp42, temp43, temp44)
#By cause
#2020
temp <- tempfile()
temp <- curl_download(url=Eng2020, destfile=temp, quiet=FALSE, mode="wb")
data2020.cause.EW <- read_excel(temp, sheet=5, range="C9:BC19",
col_names=FALSE) %>%
slice(c(1,3,11)) %>%
gather(week, deaths) %>%
mutate(cause=rep(c("Total2020", "Mean1519", "COVID2020"), times=(nrow(.)/3)),
week=as.numeric(substr(week, 4, 6))) %>%
spread(cause, deaths) %>%
mutate(other=Total2020-COVID2020, otherexcess=other-Mean1519,
netexcess=Total2020-Mean1519)
#2021 (this data is now very unhelpfully spread over multiple sheets)
temp <- tempfile()
temp <- curl_download(url=Eng2021, destfile=temp, quiet=FALSE, mode="wb")
#Grab total deaths
allcause2021.EW <- as.data.frame(t(read_excel(temp, sheet="Weekly figures 2021",
range=paste0("C9:", EngRange, "9"), col_names=FALSE))) %>%
mutate(week=seq(1:nrow(.))) %>%
rename(Total2021=V1)
#Grab COVID-19 deaths
COVID2021.EW <- as.data.frame(t(read_excel(temp, sheet="Covid-19 - Weekly registrations",
range=paste0("C9:", EngRange, "9"), col_names=FALSE))) %>%
mutate(week=seq(1:nrow(.))) %>%
rename(COVID2021=V1)
data2021.cause.EW <- data2020.cause.EW %>%
merge(allcause2021.EW, all.x=TRUE) %>%
merge(COVID2021.EW, all.x=TRUE) %>%
filter(!is.na(Total2021)) %>%
select(week, Mean1519, COVID2021, Total2021) %>%
mutate(other=Total2021-COVID2021, otherexcess=other-Mean1519,
netexcess=Total2021-Mean1519, year=2021) %>%
select(week, year, COVID2021, otherexcess, netexcess)
data.cause.EW <- data2020.cause.EW %>%
mutate(year=2020) %>%
select(week, year, COVID2020, otherexcess, netexcess) %>%
rename(COVID=COVID2020) %>%
bind_rows(data2021.cause.EW %>% rename(COVID=COVID2021))%>%
gather(cause, deaths, c(3:5))
rm(data2020.cause.EW, data2021.cause.EW, allcause2021.EW, COVID2021.EW)
#######################
#Read in Scottish data#
#######################
temp <- tempfile()
temp <- curl_download(url=Scot2021, destfile=temp, quiet=FALSE, mode="wb")
#Dowload 2020/21 data from the latest spreadsheet
#By age and sex
data20.as.S <- read_excel(temp, sheet="Table 2 (2020)",
range="B24:BC38", col_names=FALSE) %>%
slice(-c(8)) %>%
mutate(sex=rep(c("Female", "Male"), each=7)) %>%
gather(index, deaths, c(2:(ncol(.)-1))) %>%
rename(age=`...1`) %>%
mutate(date=as.Date("2020-01-05")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date-days(4)),
deaths=as.numeric(deaths)) %>%
select(-index)
data21.as.S <- read_excel(temp, sheet="Table 2 (2021)",
range=paste0("B24:", ScotRange, "38"), col_names=FALSE) %>%
slice(-c(8)) %>%
mutate(sex=rep(c("Female", "Male"), each=7)) %>%
gather(index, deaths, c(2:(ncol(.)-1))) %>%
rename(age=`...1`) %>%
mutate(date=as.Date("2021-01-09")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date),
deaths=as.numeric(deaths)) %>%
select(-index)
#By Health Board
data20.HB.S <- read_excel(temp, sheet="Table 2 (2020)",
range="B40:BC53", col_names=FALSE) %>%
gather(index, deaths, c(2:ncol(.))) %>%
rename(HB=`...1`) %>%
mutate(date=as.Date("2020-01-05")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date-days(4)),
deaths=as.numeric(deaths)) %>%
select(-index)
data21.HB.S <- read_excel(temp, sheet="Table 2 (2021)",
range=paste0("B40:", ScotRange, "53"), col_names=FALSE) %>%
gather(index, deaths, c(2:ncol(.))) %>%
rename(HB=`...1`) %>%
mutate(date=as.Date("2021-01-09")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date),
deaths=as.numeric(deaths)) %>%
select(-index)
#By place of death
data20.loc.S <- read_excel(temp, sheet="Table 2 (2020)",
range="B90:BC93", col_names=FALSE) %>%
gather(index, deaths, c(2:ncol(.))) %>%
rename(loc=`...1`) %>%
mutate(date=as.Date("2020-01-05")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date-days(4)),
deaths=as.numeric(deaths)) %>%
select(-index)
data21.loc.S <- read_excel(temp, sheet="Table 2 (2021)",
range=paste0("B90:", ScotRange, "93"), col_names=FALSE) %>%
gather(index, deaths, c(2:ncol(.))) %>%
rename(loc=`...1`) %>%
mutate(date=as.Date("2021-01-09")+weeks(as.numeric(substr(index, 4,6))-2),
week=as.numeric(substr(index, 4,6))-1,
year=year(date),
deaths=as.numeric(deaths)) %>%
select(-index)
#Download historical data
#By sex and age
temp <- tempfile()
source <- "https://www.nrscotland.gov.uk/files//statistics/covid19/weekly-deaths-by-sex-age-2000-2019.xlsx"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
data10.as.S <- read_excel(temp, sheet="2010", range="B5:BC44", col_names=FALSE) %>%
mutate(sex=rep(c("Female", "Male"), each=20), year=2010) %>%
select(-`...2`) %>%
rename(age=`...1`) %>%
gather(week, deaths, c(2:(ncol(.)-2))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-2)
data11.as.S <- read_excel(temp, sheet="2011", range="B5:BC44", col_names=FALSE) %>%
mutate(sex=rep(c("Female", "Male"), each=20), year=2011) %>%
select(-`...2`) %>%
rename(age=`...1`) %>%
gather(week, deaths, c(2:(ncol(.)-2))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-2)
data12.as.S <- read_excel(temp, sheet="2012", range="B5:BC44", col_names=FALSE) %>%
mutate(sex=rep(c("Female", "Male"), each=20), year=2012) %>%
select(-`...2`) %>%
rename(age=`...1`) %>%
gather(week, deaths, c(2:(ncol(.)-2))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-2)
data13.as.S <- read_excel(temp, sheet="2013", range="B5:BC44", col_names=FALSE) %>%
mutate(sex=rep(c("Female", "Male"), each=20), year=2013) %>%
select(-`...2`) %>%
rename(age=`...1`) %>%
gather(week, deaths, c(2:(ncol(.)-2))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-2)
data14.as.S <- read_excel(temp, sheet="2014", range="B5:BC44", col_names=FALSE) %>%
mutate(sex=rep(c("Female", "Male"), each=20), year=2014) %>%
select(-`...2`) %>%
rename(age=`...1`) %>%
gather(week, deaths, c(2:(ncol(.)-2))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-2)
data15.as.S <- read_excel(temp, sheet="2015", range="B5:BD44", col_names=FALSE) %>%
mutate(sex=rep(c("Female", "Male"), each=20), year=2015) %>%
select(-`...2`) %>%
rename(age=`...1`) %>%
gather(week, deaths, c(2:(ncol(.)-2))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-2)
data16.as.S <- read_excel(temp, sheet="2016", range="B5:BC44", col_names=FALSE) %>%
mutate(sex=rep(c("Female", "Male"), each=20), year=2016) %>%
select(-`...2`) %>%
rename(age=`...1`) %>%
gather(week, deaths, c(2:(ncol(.)-2))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-2)
data17.as.S <- read_excel(temp, sheet="2017", range="B5:BC44", col_names=FALSE) %>%
mutate(sex=rep(c("Female", "Male"), each=20), year=2017) %>%
select(-`...2`) %>%
rename(age=`...1`) %>%
gather(week, deaths, c(2:(ncol(.)-2))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-2)
data18.as.S <- read_excel(temp, sheet="2018", range="B5:BC44", col_names=FALSE) %>%
mutate(sex=rep(c("Female", "Male"), each=20), year=2018) %>%
select(-`...2`) %>%
rename(age=`...1`) %>%
gather(week, deaths, c(2:(ncol(.)-2))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-2)
data19.as.S <- read_excel(temp, sheet="2019", range="B5:BC44", col_names=FALSE) %>%
mutate(sex=rep(c("Female", "Male"), each=20), year=2019) %>%
select(-`...2`) %>%
rename(age=`...1`) %>%
gather(week, deaths, c(2:(ncol(.)-2))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-2)
#By health board
#Read in 2015-19 health board data (pre-2015 data seemingly not available)
temp <- tempfile()
source <- "https://www.nrscotland.gov.uk/files//statistics/covid19/weekly-HB-and-CA-2015-2019.xlsx"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
data1519.HB.S <- read_excel(temp, sheet=1, range="A5:BC74", col_names=FALSE) %>%
rename(HB=`...1`, year=`...2`) %>%
fill(HB) %>%
gather(week, deaths, c(3:ncol(.))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-2) %>%
filter(!(week==53 & year!=2015))
#By location
#Read in 2015-19 location data (pre-2015 data seemingly not available)
temp <- tempfile()
source <- "https://www.nrscotland.gov.uk/files//statistics/covid19/weekly-deaths-by-location-2015-2019.xlsx"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
data1519.loc.S <- read_excel(temp, range="A4:BB31", col_names=FALSE) %>%
slice(-c(1,7,8,14,15,21,22,28)) %>%
mutate(loc=rep(c("Care Home", "Home / Non-institution", "Hospital", "Other institution"),
each=5)) %>%
rename(year=`...1`) %>%
gather(week, deaths, c(2:(ncol(.)-1))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-1,
year=as.numeric(year)) %>%
filter(!(week==53 & year!=2015))
#By cause (and location)
temp <- curl_download(url=Scot2021, destfile=temp, quiet=FALSE, mode="wb")
#2015-19 data for all locations
data1519.all.cause.S <- read_excel(temp, sheet="Table 3 (2020)", range="B7:BC12", col_names=FALSE) %>%
rename(cause=`...1`) %>%
gather(week, deaths, c(2:ncol(.))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-1,
year=1519, loc="All")
#2015-19 data for care homes
data1519.ch.cause.S <- read_excel(temp, sheet="Table 3 (2020)", range="B31:BC36", col_names=FALSE) %>%
rename(cause=`...1`) %>%
gather(week, deaths, c(2:ncol(.))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-1,
year=1519, loc="Care Home")
#2015-19 data for home
data1519.home.cause.S <- read_excel(temp, sheet="Table 3 (2020)", range="B55:BC60", col_names=FALSE) %>%
rename(cause=`...1`) %>%
gather(week, deaths, c(2:ncol(.))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-1,
year=1519, loc="Home")
#2015-19 data for hospital
data1519.hosp.cause.S <- read_excel(temp, sheet="Table 3 (2020)", range="B79:BC84", col_names=FALSE) %>%
rename(cause=`...1`) %>%
gather(week, deaths, c(2:ncol(.))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-1,
year=1519, loc="Hospital")
#2015-19 data for other (to be combined with home)
data1519.oth.cause.S <- read_excel(temp, sheet="Table 3 (2020)", range="B103:BC108", col_names=FALSE) %>%
rename(cause=`...1`) %>%
gather(week, deaths, c(2:ncol(.))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-1,
year=1519, loc="Other")
#Stick 15-19 data together
data1519.cause.S <- bind_rows(data1519.ch.cause.S, data1519.home.cause.S, data1519.hosp.cause.S,
data1519.oth.cause.S, data1519.all.cause.S)
#Read in 2020 data
#all locations
data2020.all.cause.S <- read_excel(temp, sheet="Table 3 (2020)", range="B15:BC20", col_names=FALSE) %>%
rename(cause=`...1`) %>%
gather(week, deaths, c(2:ncol(.))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-1,
year=2020, loc="All")
#care homes
data2020.ch.cause.S <- read_excel(temp, sheet="Table 3 (2020)", range="B39:BC44", col_names=FALSE) %>%
rename(cause=`...1`) %>%
gather(week, deaths, c(2:ncol(.))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-1,
year=2020, loc="Care Home")
#home
data2020.home.cause.S <- read_excel(temp, sheet="Table 3 (2020)", range="B63:BC68", col_names=FALSE) %>%
rename(cause=`...1`) %>%
gather(week, deaths, c(2:ncol(.))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-1,
year=2020, loc="Home")
#hospital
data2020.hosp.cause.S <- read_excel(temp, sheet="Table 3 (2020)", range="B87:BC92", col_names=FALSE) %>%
rename(cause=`...1`) %>%
gather(week, deaths, c(2:ncol(.))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-1,
year=2020, loc="Hospital")
#other (to be combined with home)
data2020.oth.cause.S <- read_excel(temp, sheet="Table 3 (2020)", range="B111:BC116", col_names=FALSE) %>%
rename(cause=`...1`) %>%
gather(week, deaths, c(2:ncol(.))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-1,
year=2020, loc="Other")
#Stick 2020 data together
data2020.cause.S <- bind_rows(data2020.ch.cause.S, data2020.home.cause.S, data2020.hosp.cause.S,
data2020.oth.cause.S, data2020.all.cause.S)
#Read in 2021 data
#all locations
data2021.all.cause.S <- read_excel(temp, sheet="Table 3 (2021)",
range=paste0("B15:", ScotRange, "20"), col_names=FALSE) %>%
rename(cause=`...1`) %>%
gather(week, deaths, c(2:ncol(.))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-1,
year=2021, loc="All")
#care homes
data2021.ch.cause.S <- read_excel(temp, sheet="Table 3 (2021)",
range=paste0("B39:", ScotRange, "44"), col_names=FALSE) %>%
rename(cause=`...1`) %>%
gather(week, deaths, c(2:ncol(.))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-1,
year=2021, loc="Care Home")
#home
data2021.home.cause.S <- read_excel(temp, sheet="Table 3 (2021)",
range=paste0("B63:", ScotRange, "68"), col_names=FALSE) %>%
rename(cause=`...1`) %>%
gather(week, deaths, c(2:ncol(.))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-1,
year=2021, loc="Home")
#hospital
data2021.hosp.cause.S <- read_excel(temp, sheet="Table 3 (2021)",
range=paste0("B87:",ScotRange, "92"), col_names=FALSE) %>%
rename(cause=`...1`) %>%
gather(week, deaths, c(2:ncol(.))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-1,
year=2021, loc="Hospital")
#other (to be combined with home)
data2021.oth.cause.S <- read_excel(temp, sheet="Table 3 (2021)",
range=paste0("B111:", ScotRange, "116"), col_names=FALSE) %>%
rename(cause=`...1`) %>%
gather(week, deaths, c(2:ncol(.))) %>%
mutate(week=as.numeric(substr(week, 4, 6))-1,
year=2021, loc="Other")
#Stick 2020 data together
data2021.cause.S <- bind_rows(data2021.ch.cause.S, data2021.home.cause.S, data2021.hosp.cause.S,
data2021.oth.cause.S, data2021.all.cause.S)
#Combine years
data.cause.S <- bind_rows(data1519.cause.S, data2020.cause.S, data2021.cause.S) %>%
mutate(loc=case_when(
loc %in% c("Home", "Other") ~ "Home/Other",
TRUE ~ loc),
cause=if_else(cause=="Circulatory (heart disease and stroke)", "Circulatory", cause)) %>%
group_by(cause, week, year, loc) %>%
summarise(deaths=sum(deaths)) %>%
ungroup() %>%
spread(year, deaths)
data2021.cause.excess.S <- data.cause.S %>%
filter(!is.na(`2021`)) %>%
mutate(excess=`2021`-`1519`, year=2021) %>%
select(cause, loc, week, year, excess)
data.cause.S <- data.cause.S %>%
mutate(excess=`2020`-`1519`, year=2020) %>%
select(cause, loc, week, year, excess) %>%
bind_rows(data2021.cause.excess.S)
#Merge together
data.as.S <- bind_rows(data10.as.S, data11.as.S, data12.as.S, data13.as.S,
data14.as.S, data15.as.S, data16.as.S, data17.as.S,
data18.as.S, data19.as.S) %>%
#Compress age bands to match 2020 data
mutate(age=case_when(
age %in% c("0", "1-4", "5-9", "10-14") ~ "Under 15",
age %in% c("15-19", "20-24", "25-29", "30-34", "35-39", "40-44") ~ "15-44",
age %in% c("45-49", "50-54", "55-59", "60-64") ~ "45-64",
age %in% c("65-69", "70-74") ~ "65-74",
age %in% c("75-79", "80-84") ~ "75-84",
TRUE ~ "85+")) %>%
group_by(age, sex, year, week) %>%
summarise(deaths=sum(deaths)) %>%
ungroup()
data.as.S <- bind_rows(data20.as.S, data21.as.S) %>%
mutate(age=case_when(
age %in% c("Under 1 year", "01-14") ~ "Under 15",
TRUE ~ age)) %>%
group_by(age, sex, year, week, date) %>%
summarise(deaths=sum(deaths)) %>%
ungroup() %>%
bind_rows(data.as.S)
#Add total rows, by age, sex and overall
agetot.S <- data.as.S %>%
group_by(age, date, week, year) %>%
summarise(deaths=sum(deaths)) %>%
mutate(sex="Total") %>%
ungroup()
sextot.S <- data.as.S %>%
group_by(sex, date, week, year) %>%
summarise(deaths=sum(deaths)) %>%
mutate(age="Total") %>%
ungroup()
alltot.S <- data.as.S %>%
group_by(date, week, year) %>%
summarise(deaths=sum(deaths)) %>%
mutate(age="Total", sex="Total") %>%
ungroup()
data.as.S <- bind_rows(data.as.S, agetot.S, sextot.S, alltot.S)
data.HB.S <- bind_rows(data1519.HB.S, data20.HB.S, data21.HB.S)
data.loc.S <- bind_rows(data1519.loc.S, data20.loc.S, data21.loc.S)
rm(data10.as.S, data11.as.S, data12.as.S, data13.as.S, data14.as.S, data15.as.S,
data16.as.S, data17.as.S, data18.as.S, data19.as.S, data20.as.S, data21.as.S,
data1519.HB.S, data20.HB.S, data21.HB.S, data1519.loc.S,
data20.loc.S, data21.loc.S, agetot.S, sextot.S, alltot.S, data1519.all.cause.S,
data1519.cause.S, data1519.ch.cause.S, data1519.home.cause.S, data1519.hosp.cause.S,
data1519.oth.cause.S, data2020.cause.S, data2020.all.cause.S, data2020.ch.cause.S,
data2020.home.cause.S, data2020.hosp.cause.S, data2020.oth.cause.S, data2021.cause.excess.S,
data2021.cause.S, data2021.all.cause.S, data2021.ch.cause.S, data2021.home.cause.S,
data2021.hosp.cause.S, data2021.oth.cause.S)
#############################
#Read in Northern Irish data#
#############################
#No data is (easily) available for Northern Ireland on historic deaths by age or place of death
temp <- tempfile()
temp <- curl_download(url=NI2021, destfile=temp, quiet=FALSE, mode="wb")
#Download 2021 data from the latest spreadsheet
data2021.NI <- read_excel(temp, sheet="Table 1", range=paste0("B5:C", NIRange), col_names=FALSE) %>%
mutate(week=c(54:(nrow(.)+53)), year=2021)
colnames(data2021.NI) <- c("date", "deaths", "week", "year")
data2021.cause.NI <- read_excel(temp, sheet="Table 10", range=paste0("A57:C", as.numeric(NIRange)+52),
col_names=FALSE) %>%
rename(week=`...1`, date=`...2`, COVID=`...3`) %>%
mutate(COVID=as.numeric(gsub("-", "0", COVID)),
week=week+53, year=2021)
#Read in 2020 data
temp <- tempfile()
source <- "https://www.nisra.gov.uk/sites/nisra.gov.uk/files/publications/Weekly_Deaths%20-%20w%20e%201st%20January%202021.XLSX"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
data2020.NI <- read_excel(temp, sheet="Table 1", range="B6:C57", col_names=FALSE) %>%
mutate(week=2:53, year=2020)
colnames(data2020.NI) <- c("date", "deaths", "week", "year")
data2020.cause.NI <- read_excel(temp, sheet="Table 10", range="A5:C56",
col_names=FALSE) %>%
rename(week=`...1`, date=`...2`, COVID=`...3`) %>%
mutate(COVID=as.numeric(gsub("-", "0", COVID)),
year=2020, week=week+1) %>%
bind_rows(data2021.cause.NI) %>%
bind_rows(data.frame(week=1, date=as.Date("2020-01-03"), COVID=0, year=2020))
#Read in historical data
temp <- tempfile()
source <- "https://www.nisra.gov.uk/sites/nisra.gov.uk/files/publications/Weekly%20Deaths%20by%20Age%20and%20Respiratory%20Deaths%2C%202011-2019.xls"
temp <- curl_download(url=source, destfile=temp, quiet=FALSE, mode="wb")
data2019.NI <- read_excel(temp, sheet="Weekly Deaths_2019", range="C5:D56", col_names=FALSE)
data2018.NI <- read_excel(temp, sheet="Weekly Deaths_2018", range="C5:D56", col_names=FALSE)
data2017.NI <- read_excel(temp, sheet="Weekly Deaths_2017", range="C5:D57", col_names=FALSE)
data2016.NI <- read_excel(temp, sheet="Weekly Deaths_2016", range="C5:D56", col_names=FALSE)
data2015.NI <- read_excel(temp, sheet="Weekly Deaths_2015", range="C5:D57", col_names=FALSE)
data2014.NI <- read_excel(temp, sheet="Weekly Deaths_2014", range="C5:D56", col_names=FALSE)
data2013.NI <- read_excel(temp, sheet="Weekly Deaths_2013", range="C5:D56", col_names=FALSE)
data2012.NI <- read_excel(temp, sheet="Weekly Deaths_2012", range="C5:D56", col_names=FALSE)
data2011.NI <- read_excel(temp, sheet="Weekly Deaths_2011", range="C5:D56", col_names=FALSE)
data.NI <- bind_rows(data2011.NI, data2012.NI, data2013.NI, data2014.NI, data2015.NI,
data2016.NI, data2017.NI, data2018.NI, data2019.NI) %>%
rename(date=`...1`, deaths=`...2`) %>%
mutate(week=week(date-days(1)), year=year(date-days(1))) %>%
bind_rows(data2020.NI, data2021.NI) %>%
arrange(date)
#Create cause dataset
data.cause.NI <- data.NI %>%
filter(year<2020) %>%
group_by(week) %>%
summarise(mean1119=mean(deaths))
data.cause.NI <- data.cause.NI %>%
filter(week<=max(data.NI$week)-53) %>%
mutate(week=week+53) %>%
bind_rows(data.cause.NI) %>%
merge(data.NI %>% filter(year>=2020), all.y=TRUE) %>%
merge(data2020.cause.NI, all.x=TRUE) %>%
mutate(other=deaths-COVID, otherexcess=other-mean1119,
netexcess=deaths-mean1119) %>%
select(week, year, COVID, otherexcess, netexcess)
rm(data2011.NI, data2012.NI, data2013.NI, data2014.NI, data2015.NI, data2016.NI,
data2017.NI, data2018.NI, data2019.NI, data2021.NI, data2021.cause.NI)
#Generate overall regional data for UK
data.reg.UK <- data.as.S %>%
filter(age=="Total" & sex=="Total") %>%
select(-c(age, sex)) %>%
mutate(region="Scotland") %>%
bind_rows(data.reg.EW, data.NI %>% mutate(region="Northern Ireland"))
#Save data
#data by age and sex
write.csv(data.as.EW, "Data/deaths_age_sex_EW.csv")
write.csv(data.as.S, "Data/deaths_age_sex_S.csv")
#data by region/Health Board
write.csv(data.reg.UK, "Data/deaths_reg_UK.csv")
write.csv(data.HB.S, "Data/deaths_HB_S.csv")
#data by location
write.csv(data.loc.EW, "Data/deaths_loc_EW.csv")
write.csv(data.loc.S, "Data/deaths_loc_S.csv")
#data by cause
write.csv(data.cause.EW, "Data/deaths_cause_EW.csv")
write.csv(data.cause.S, "Data/deaths_cause_S.csv")
write.csv(data.cause.NI, "Data/deaths_cause_NI.csv")
#Overall NI data
write.csv(data.NI, "Data/deaths_NI.csv")
###############################################################################################
###################
#Plots for England#
###################
#Overall plot
plot1 <- data.as.EW %>%
filter(age=="Total" & sex=="Total") %>%
select(-c(age, sex)) %>%
mutate(week=if_else(year==2021,week+53, week))
plot1.old <- plot1 %>%
filter(year<2020) %>%
group_by(week) %>%
summarise(min=min(deaths), max=max(deaths), mean=mean(deaths)) %>%
ungroup()
Eng2021MaxWeek <- max((plot1 %>% filter(year==2021))$week)
#Add extra weeks to old data
plot1.old <- plot1.old %>%
filter(week<=Eng2021MaxWeek-53) %>%
mutate(week=week+53) %>%
bind_rows(plot1.old)
plot1 <- plot1 %>%
filter(year>=2020) %>%
merge(plot1.old, by="week") %>%
mutate(excess=deaths-mean)
#Calculate excess deaths vs. mean in 2020/21
EW.excess <- plot1 %>%
summarise(excess=sum(excess), total=sum(mean), percexcess=excess/total)
#Extract y=axis placement for excess deaths figure
labpos <- 16000
agg_tiff("Outputs/ONSWeeklyDeaths.tiff", units="in", width=10, height=7, res=500)
ggplot(plot1)+
geom_ribbon(aes(x=date, ymin=min, ymax=max), fill="Skyblue2")+
geom_ribbon(aes(x=date, ymin=mean, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(aes(x=date, y=mean), colour="Grey50", linetype=2)+
geom_line(aes(x=date, y=deaths), colour="Red")+
scale_x_date(name="", breaks=c(as.Date("2020-01-01"), as.Date("2020-04-01"), as.Date("2020-07-01"),
as.Date("2020-10-01"), as.Date("2021-01-01"), as.Date("2021-04-01"),
as.Date("2021-07-01")),
labels=c("Jan 2020", "Apr 2020", "Jul 2020", "Oct 2020", "Jan 2021", "Apr 2021",
"Jul 2021"))+
scale_y_continuous(name="Weekly deaths registered", limits=c(0,NA))+
theme_classic()+
theme(plot.title=element_text(face="bold", size=rel(1.5)), plot.subtitle=element_markdown(),
text=element_text(family="Lato"))+
labs(title="England and Wales has seen excess mortality for the last 17 weeks",
subtitle=paste0("Weekly deaths registered in England & Wales in <span style='color:red;'>2020/21</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>. Data up to ", EWDate, " 2021."),
caption="Data from ONS | Plot by @VictimOfMaths")+
annotate(geom="text", x=as.Date("2020-06-01"), y=labpos,
label=paste0(round(EW.excess$excess, 0)," more deaths in 2020/21\nthan average (+",
round(EW.excess$percexcess*100, 0),"%)"), colour="Red", hjust=0,
family="Lato")+
annotate(geom="text", x=as.Date("2020-02-12"), y=16000, label="Historic maximum",
colour="Skyblue4", family="Lato", size=rel(3))+
annotate(geom="text", x=as.Date("2020-02-10"), y=9100, label="Historic minimum",
colour="Skyblue4", family="Lato", size=rel(3))+
annotate(geom="text", x=as.Date("2020-04-15"), y=7500, label="Historic mean", colour="grey30",
family="Lato", size=rel(3))+
geom_curve(aes(x=as.Date("2020-04-20"), y=7700, xend=as.Date("2020-04-30"), yend=9700),
colour="grey30", curvature=0.15, arrow=arrow(length=unit(0.1, "cm"), type="closed"),
lineend="round")
dev.off()
#Plot by sex
plot2 <- data.as.EW %>%
filter(age=="Total" & sex!="Total") %>%
select(-age) %>%
mutate(week=if_else(year==2021,week+53, week))
plot2.old <- plot2 %>%
filter(year<2020) %>%
group_by(week, sex) %>%
summarise(min=min(deaths), max=max(deaths), mean=mean(deaths)) %>%
ungroup()
#Add extra weeks to old data
plot2.old <- plot2.old %>%
filter(week<=Eng2021MaxWeek-53) %>%
mutate(week=week+53) %>%
bind_rows(plot2.old)
plot2 <- plot2 %>%
filter(year>=2020) %>%
merge(plot2.old, by=c("sex", "week")) %>%
mutate(excess=deaths-mean,
sex=factor(sex, levels=c("Male", "Female")))
#Calculate excess deaths vs. mean in 2020/21
EW.excess.sex <- plot2 %>%
group_by(sex) %>%
summarise(excess=sum(excess), total=sum(mean), percexcess=excess/total) %>%
ungroup()
ann_text2 <- data.frame(date=rep(as.Date("2020-05-20"), times=2), deaths=c(7500,7000),
sex=factor(c("Male", "Female"), levels=c("Male", "Female")))
agg_tiff("Outputs/ONSWeeklyDeathsxSex.tiff", units="in", width=12, height=8, res=500)
ggplot(plot2)+
geom_ribbon(aes(x=date, ymin=min, ymax=max), fill="Skyblue2")+
geom_ribbon(aes(x=date, ymin=mean, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(aes(x=date, y=mean), colour="Grey50", linetype=2)+
geom_line(aes(x=date, y=deaths), colour="Red")+
scale_x_date(name="", breaks=c(as.Date("2020-01-01"), as.Date("2020-04-01"), as.Date("2020-07-01"),
as.Date("2020-10-01"), as.Date("2021-01-01"), as.Date("2021-04-01"),
as.Date("2021-07-01")),
labels=c("Jan 2020", "Apr 2020", "Jul 2020", "Oct 2020", "Jan 2021", "Apr 2021",
"Jul 2021"))+
scale_y_continuous(name="Weekly deaths registered", limits=c(0,NA))+
facet_wrap(~sex)+
theme_classic()+
theme(plot.title=element_text(face="bold", size=rel(1.5)), plot.subtitle=element_markdown(),
strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
text=element_text(family="Lato"))+
labs(title="Both male and female deaths are above average",
subtitle=paste0("Weekly deaths registered in England & Wales in <span style='color:red;'>2020/21</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>. Data up to ", EWDate, " 2021."),
caption="Data from ONS | Plot by @VictimOfMaths")+
geom_text(data=ann_text2, aes(x=date, y=deaths), label=c(paste0("+", round(EW.excess.sex[1,2],0)," excess deaths in 2020/21\nvs. 2010-19 average (+",
round(EW.excess.sex[1,4]*100, 0),"%)"),
paste0("+", round(EW.excess.sex[2,2],0)," deaths (+",
round(EW.excess.sex[2,4]*100, 0),"%)")),
size=rel(3), colour=c("Red", "Red"), hjust=0, family="Lato")
dev.off()
#Plot by age
plot3 <- data.as.EW %>%
filter(age!="Total" & sex=="Total") %>%
select(-sex) %>%
mutate(week=if_else(year==2021,week+53, week))
plot3.old <- plot3 %>%
filter(year<2020) %>%
group_by(week, age) %>%
summarise(min=min(deaths), max=max(deaths), mean=mean(deaths)) %>%
ungroup()
#Add extra weeks to old data
plot3.old <- plot3.old %>%
filter(week<=Eng2021MaxWeek-53) %>%
mutate(week=week+53) %>%
bind_rows(plot3.old)
plot3 <- plot3 %>%
filter(year>=2020) %>%
merge(plot3.old, by=c("age", "week")) %>%
mutate(excess=deaths-mean,
age=factor(age, levels=c("Under 15", "15-44", "45-64", "65-74", "75-84", "85+")))
#Calculate excess deaths vs. mean in 2020/21
EW.excess.age <- plot3 %>%
group_by(age) %>%
summarise(excess=sum(excess), total=sum(mean), percexcess=excess/total) %>%
ungroup()
ann_text3 <- data.frame(date=rep(as.Date("2020-06-01"), times=6),
deaths=c(1300, 1400, 2300, 3500, 5700, 7800),
age=factor(c("Under 15", "15-44", "45-64", "65-74", "75-84", "85+"),
levels=c("Under 15", "15-44", "45-64", "65-74", "75-84", "85+")))
agg_tiff("Outputs/ONSWeeklyDeathsxAge.tiff", units="in", width=12, height=8, res=500)
ggplot(plot3)+
geom_ribbon(aes(x=date, ymin=min, ymax=max), fill="Skyblue2")+
geom_ribbon(aes(x=date, ymin=mean, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(aes(x=date, y=mean), colour="Grey50", linetype=2)+
geom_line(aes(x=date, y=deaths), colour="Red")+
scale_x_date(name="", date_labels="%b-%y")+
scale_y_continuous(name="Weekly deaths registered", limits=c(0,NA))+
facet_wrap(~age)+
theme_classic()+
theme(plot.title=element_text(face="bold", size=rel(1.5)), plot.subtitle=element_markdown(),
strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
text=element_text(family="Lato"))+
labs(title="Age groups over 75 have seen the highest numbers of excess deaths",
subtitle=paste0("Weekly deaths registered in England & Wales in <span style='color:red;'>2020/21</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>. Data up to ", EWDate, " 2021."),
caption="Data from ONS | Plot by @VictimOfMaths")+
geom_text(data=ann_text3, aes(x=date, y=deaths), label=c(paste0(round(EW.excess.age[1,2],0)," excess deaths in 2020/21\nvs. 2010-19 average (",
round(EW.excess.age[1,4]*100, 1),"%)"),
paste0("+", round(EW.excess.age[2,2],0)," deaths (+",
round(EW.excess.age[2,4]*100, 0),"%)"),
paste0("+", round(EW.excess.age[3,2],0)," deaths (+",
round(EW.excess.age[3,4]*100, 0),"%)"),
paste0("+", round(EW.excess.age[4,2],0)," deaths (+",
round(EW.excess.age[4,4]*100, 0),"%)"),
paste0("+", round(EW.excess.age[5,2],0)," deaths (+",
round(EW.excess.age[5,4]*100, 0),"%)"),
paste0("+", round(EW.excess.age[6,2],0)," deaths (+",
round(EW.excess.age[6,4]*100, 0),"%)")),
size=3, colour=rep("red", times=6), hjust=0, family="Lato")
dev.off()
ann_text3 <- data.frame(date=rep(as.Date("2020-06-01"), times=6),
deaths=c(120, 400, 2000, 3000, 5000, 7000),
age=factor(c("Under 15", "15-44", "45-64", "65-74", "75-84", "85+"),
levels=c("Under 15", "15-44", "45-64", "65-74", "75-84", "85+")))
agg_tiff("Outputs/ONSWeeklyDeathsxAgev2.tiff", units="in", width=12, height=8, res=500)
ggplot(plot3)+
geom_ribbon(aes(x=date, ymin=min, ymax=max), fill="Skyblue2")+
geom_ribbon(aes(x=date, ymin=mean, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(aes(x=date, y=mean), colour="Grey50", linetype=2)+
geom_line(aes(x=date, y=deaths), colour="Red")+
scale_x_date(name="", date_labels="%b-%y")+
scale_y_continuous(name="Weekly deaths registered", limits=c(0,NA))+
facet_wrap(~age, scales="free_y")+
theme_classic()+
theme(plot.title=element_text(face="bold", size=rel(1.5)), plot.subtitle=element_markdown(),
strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
text=element_text(family="Lato"))+
labs(title="45-64 year olds have seen the biggest relative increase in mortality",
subtitle=paste0("Weekly deaths registered in England & Wales in <span style='color:red;'>2020/21</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>. Data up to ", EWDate, " 2021."),
caption="Data from ONS | Plot by @VictimOfMaths")+
geom_text(data=ann_text3, aes(x=date, y=deaths), label=c(paste0(round(EW.excess.age[1,2],0)," excess deaths in 2020/21\nvs. 2010-19 average (",
round(EW.excess.age[1,4]*100, 1),"%)"),
paste0("+", round(EW.excess.age[2,2],0)," deaths (+",
round(EW.excess.age[2,4]*100, 0),"%)"),
paste0("+", round(EW.excess.age[3,2],0)," deaths (+",
round(EW.excess.age[3,4]*100, 0),"%)"),
paste0("+", round(EW.excess.age[4,2],0)," deaths (+",
round(EW.excess.age[4,4]*100, 0),"%)"),
paste0("+", round(EW.excess.age[5,2],0)," deaths (+",
round(EW.excess.age[5,4]*100, 0),"%)"),
paste0("+", round(EW.excess.age[6,2],0)," deaths (+",
round(EW.excess.age[6,4]*100, 0),"%)")),
size=3, colour=rep("red", times=6), hjust=0, family="Lato")
dev.off()
#Youngest age band only
agg_tiff("Outputs/ONSWeeklyDeathsxAgeu15.tiff", units="in", width=12, height=8, res=500)
ggplot(plot3 %>% filter(age=="Under 15"))+
geom_ribbon(aes(x=date, ymin=min, ymax=max), fill="Skyblue2")+
geom_ribbon(aes(x=date, ymin=mean, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(aes(x=date, y=mean), colour="Grey50", linetype=2)+
geom_line(aes(x=date, y=deaths), colour="Red")+
scale_x_date(name="", date_labels="%b-%y")+
scale_y_continuous(name="Weekly deaths registered", limits=c(0,NA))+
theme_classic()+
theme(plot.title=element_text(face="bold", size=rel(1.5)), plot.subtitle=element_markdown(),
strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
text=element_text(family="Lato"))+
labs(title="All cause deaths in under 15s have been consistently below average",
subtitle=paste0("Weekly deaths registered in England & Wales in <span style='color:red;'>2020/21</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>. Data up to ", EWDate, " 2021."),
caption="Data from ONS | Plot by @VictimOfMaths")+
annotate(geom="text", x=as.Date("2020-06-01"), y=30,
label=paste0(-1*round(EW.excess.age[1,2],0)," fewer deaths in 2020/21\nvs. 2010-19 average (",
round(EW.excess.age[1,4]*100, 1),"%)"), colour="Red", hjust=0,
family="Lato")+
annotate(geom="text", x=as.Date("2020-02-12"), y=110, label="Historic maximum",
colour="Skyblue4", family="Lato", size=rel(3))+
annotate(geom="text", x=as.Date("2020-02-10"), y=35, label="Historic minimum",
colour="Skyblue4", family="Lato", size=rel(3))+
annotate(geom="text", x=as.Date("2020-04-15"), y=85, label="Historic mean", colour="grey30",
family="Lato", size=rel(3))+
geom_curve(aes(x=as.Date("2020-04-20"), y=83, xend=as.Date("2020-04-30"), yend=75),
colour="grey30", curvature=0.15, arrow=arrow(length=unit(0.1, "cm"), type="closed"),
lineend="round")
dev.off()
#Excess deaths by age stacked
agg_tiff("Outputs/ONSWeeklyDeathsxAgeBars.tiff", units="in", width=9, height=6, res=500)
ggplot(plot3)+
geom_col(aes(x=date, y=excess, fill=age))+
scale_x_date(name="")+
scale_y_continuous(name="Excess deaths vs. 2010-19 average")+
scale_fill_paletteer_d(name="Age", "awtools::a_palette")+
theme_classic()+
theme(plot.title=element_text(face="bold", size=rel(1.5)),
text=element_text(family="Lato"))+
labs(title="Excess mortality in England & Wales by age",
subtitle=paste0("Weekly deaths registered in England & Wales by age compared to the 2010-19 average.\nData up to ", EWDate, " 2021."),
caption="Data from ONS | Plot by @VictimOfMaths")
dev.off()
#Plot by location
plot4 <- data.loc.EW %>%
mutate(week=if_else(year==2021,week+53, week),
location=factor(location, levels=c("Hospital", "Care Home", "Home/Other")))
#Add extra weeks to old data
plot4 <- plot4 %>%
filter(week<=Eng2021MaxWeek-53 & year==1519) %>%
mutate(week=week+53) %>%
bind_rows(plot4) %>%
mutate(date=as.Date("2020-01-03")+weeks(week-1))
#agg_png("Outputs/ConversationPlot3.png", units="in", width=9, height=6, res=800)
#ggplot()+
# geom_line(data=subset(plot4, year==1519 & week<53), aes(x=date, y=deaths), colour="Skyblue2")+
# geom_line(data=subset(plot4, year==1519 & week>53), aes(x=date, y=deaths), colour="Skyblue2")+
# geom_line(data=subset(plot4, year>1519), aes(x=date, y=deaths), colour="Red")+
# scale_x_date(name="", date_labels="%b-%y")+
# scale_y_continuous(name="Weekly deaths registered", limits=c(0,NA))+
# facet_wrap(~location)+
# theme_classic()+
# theme(plot.title=element_text(face="bold", size=rel(1.5)), plot.subtitle=element_markdown(),
# strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
# text=element_text(family="Lato"))+
# labs(title="Deaths have shifted from hospitals to private homes",
# subtitle=paste0("Weekly deaths in England & Wales in <span style='color:red;'>2020/21</span> compared to <span style='color:Skyblue4;'>the range in 2015-19</span>. Data up to ", EWDate, " 2021.<br>Historic data for week 53 is not available"),
# caption="Data from ONS | Plot and analysis by Colin Angus")
#
#dev.off()
agg_tiff("Outputs/ONSWeeklyDeathsxLocation.tiff", units="in", width=9, height=6, res=500)
ggplot()+
geom_line(data=subset(plot4, year==1519 & week<53), aes(x=date, y=deaths), colour="Skyblue2")+
geom_line(data=subset(plot4, year==1519 & week>53), aes(x=date, y=deaths), colour="Skyblue2")+
geom_line(data=subset(plot4, year>1519), aes(x=date, y=deaths), colour="Red")+
scale_x_date(name="", date_labels="%b-%y")+
scale_y_continuous(name="Weekly deaths registered", limits=c(0,NA))+
facet_wrap(~location)+
theme_classic()+
theme(plot.title=element_text(face="bold", size=rel(1.5)), plot.subtitle=element_markdown(),
strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
text=element_text(family="Lato"))+
labs(title="Deaths in all settings are above 'normal' levels",
subtitle=paste0("Weekly deaths in England & Wales in <span style='color:red;'>2020/21</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>. Data up to ", EWDate, " 2021.<br>Historic data for week 53 is not available"),
caption="Data from ONS | Plot by @VictimOfMaths")
dev.off()
#Plot by cause
plot5 <- data.cause.EW %>%
mutate(week=if_else(year==2021,week+53, week),
date=as.Date("2020-01-03")+weeks(week-1))
agg_tiff("Outputs/ONSExcessxCause.tiff", units="in", width=8, height=6, res=500)
ggplot()+
geom_col(data=subset(plot5, cause!="netexcess"), aes(x=date, y=deaths, fill=cause))+
geom_hline(yintercept=0, colour="Grey30")+
geom_line(data=subset(plot5, cause=="netexcess"), aes(x=date, y=deaths, colour=cause))+
scale_x_date(name="", date_labels="%b-%y")+
scale_y_continuous(name="Excess deaths vs. 2015-19 mean")+
scale_fill_paletteer_d("LaCroixColoR::PinaFraise", name="Cause", labels=c("COVID-19", "Other causes"))+
scale_colour_manual(values="NavyBlue", name="", labels="Net excess deaths")+
theme_classic()+
theme(plot.title=element_text(face="bold", size=rel(1.4)),
text=element_text(family="Lato"))+
labs(title="Around half of recent excess deaths involved COVID",
subtitle="Excess deaths vs. 2015-19 average by cause for England & Wales",
caption="Data from ONS | Plot by @VictimOfMaths")
dev.off()
####################
#Plots for Scotland#
####################
#Overall plot
plot6 <- data.as.S %>%
filter(age=="Total" & sex=="Total") %>%
select(-c(age, sex)) %>%
mutate(week=if_else(year==2021,week+53, week))
plot6.old <- plot6 %>%
filter(year<2020) %>%
group_by(week) %>%
summarise(min=min(deaths), max=max(deaths), mean=mean(deaths)) %>%
ungroup()
Scot2021MaxWeek <- max((plot6 %>% filter(year==2021))$week)
#Add extra weeks to old data
plot6.old <- plot6.old %>%
filter(week<=Scot2021MaxWeek-53) %>%
mutate(week=week+53) %>%
bind_rows(plot6.old)
plot6 <- plot6 %>%
filter(year>=2020) %>%
merge(plot6.old, by="week") %>%
mutate(excess=deaths-mean)
#Calculate excess deaths vs. mean in 2020/21
S.excess <- plot6 %>%
summarise(excess=sum(excess), total=sum(mean), percexcess=excess/total)
#Extract y=axis placement for excess deaths figure
labpos <- 1600
agg_tiff("Outputs/NRSWeeklyDeaths.tiff", units="in", width=10, height=8, res=500)
ggplot(plot6)+
geom_ribbon(aes(x=date, ymin=min, ymax=max), fill="Skyblue2")+
geom_ribbon(aes(x=date, ymin=mean, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(aes(x=date, y=mean), colour="Grey50", linetype=2)+
geom_line(aes(x=date, y=deaths), colour="Red")+
scale_x_date(name="", date_labels="%b-%y")+
scale_y_continuous(name="Weekly deaths registered", limits=c(0,NA))+
theme_classic()+
theme(plot.title=element_text(face="bold", size=rel(1.5)), plot.subtitle=element_markdown(),
text=element_text(family="Lato"))+
labs(title="Scotland continues to see excess mortality",
subtitle=paste0("Weekly deaths in Scotland in <span style='color:red;'>2020/21</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>. Data up to ", ScotDate, " 2021."),
caption="Data from NRS | Plot by @VictimOfMaths")+
annotate(geom="text", x=as.Date("2020-06-01"), y=labpos,
label=paste0(round(S.excess$excess, 0)," more deaths in 2020/21\nthan average (+",
round(S.excess$percexcess*100, 0),"%)"), colour="Red", hjust=0,
family="Lato")+
annotate(geom="text", x=as.Date("2020-02-25"), y=1800, label="Historic maximum",
colour="Skyblue4", family="Lato")+
annotate(geom="text", x=as.Date("2020-02-11"), y=980, label="Historic minimum",
colour="Skyblue4", family="Lato")+
annotate(geom="text", x=as.Date("2020-04-15"), y=750, label="Historic mean", colour="grey30",
family="Lato")+
geom_curve(aes(x=as.Date("2020-04-20"), y=770, xend=as.Date("2020-04-30"), yend=1060),
colour="grey30", curvature=0.15, arrow=arrow(length=unit(0.1, "cm"), type="closed"),
lineend="round")
dev.off()
#Plot by sex
plot7 <- data.as.S %>%
filter(age=="Total" & sex!="Total") %>%
select(-age) %>%
mutate(week=if_else(year==2021,week+53, week))
plot7.old <- plot7 %>%
filter(year<2020) %>%
group_by(week, sex) %>%
summarise(min=min(deaths), max=max(deaths), mean=mean(deaths)) %>%
ungroup()
#Add extra weeks to old data
plot7.old <- plot7.old %>%
filter(week<=Scot2021MaxWeek-53) %>%
mutate(week=week+53) %>%
bind_rows(plot7.old)
plot7 <- plot7 %>%
filter(year>=2020) %>%
merge(plot7.old, by=c("sex", "week")) %>%
mutate(excess=deaths-mean,
sex=factor(sex, levels=c("Male", "Female")))
#Calculate excess deaths vs. mean in 2020/21
S.excess.sex <- plot7 %>%
group_by(sex) %>%
summarise(excess=sum(excess), total=sum(mean), percexcess=excess/total) %>%
ungroup()
ann_text7 <- data.frame(date=rep(as.Date("2020-05-20"), times=2), deaths=c(850,700),
sex=factor(c("Male", "Female"), levels=c("Male", "Female")))
agg_tiff("Outputs/NRSWeeklyDeathsxSex.tiff", units="in", width=10, height=7, res=500)
ggplot(plot7)+
geom_ribbon(aes(x=date, ymin=min, ymax=max), fill="Skyblue2")+
geom_ribbon(aes(x=date, ymin=mean, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(aes(x=date, y=mean), colour="Grey50", linetype=2)+
geom_line(aes(x=date, y=deaths), colour="Red")+
scale_x_date(name="", date_labels="%b-%y")+
scale_y_continuous(name="Weekly deaths registered", limits=c(0,NA))+
facet_wrap(~sex)+
theme_classic()+
theme(plot.title=element_markdown(face="bold", size=rel(1.4)), plot.subtitle=element_markdown(),
strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
text=element_text(family="Lato"))+
labs(title="Excess deaths are markedly higher in men",
subtitle=paste0("Weekly deaths in Scotland in <span style='color:red;'>2020/21</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>. Data up to ", ScotDate, " 2021."),
caption="Data from NRS | Plot by @VictimOfMaths")+
geom_text(data=ann_text7, aes(x=date, y=deaths), label=c(paste0("+", round(S.excess.sex[1,2],0)," excess deaths in 2020/21\nvs. 2010-19 average (+",
round(S.excess.sex[1,4]*100, 0),"%)"),
paste0("+", round(S.excess.sex[2,2],0)," deaths (+",
round(S.excess.sex[2,4]*100, 0),"%)")),
size=3, colour=c("Red", "Red"), hjust=0, family="Lato")
dev.off()
#Plot by age
plot8 <- data.as.S %>%
filter(age!="Total" & sex=="Total") %>%
select(-sex) %>%
mutate(week=if_else(year==2021,week+53, week))
plot8.old <- plot8 %>%
filter(year<2020) %>%
group_by(week, age) %>%
summarise(min=min(deaths), max=max(deaths), mean=mean(deaths)) %>%
ungroup()
#Add extra weeks to old data
plot8.old <- plot8.old %>%
filter(week<=Scot2021MaxWeek-53) %>%
mutate(week=week+53) %>%
bind_rows(plot8.old)
plot8 <- plot8 %>%
filter(year>=2020) %>%
merge(plot8.old, by=c("age", "week")) %>%
mutate(excess=deaths-mean,
age=factor(age, levels=c("Under 15", "15-44", "45-64", "65-74", "75-84", "85+")))
#Calculate excess deaths vs. mean in 2020/21
S.excess.age <- plot8 %>%
group_by(age) %>%
summarise(excess=sum(excess), total=sum(mean), percexcess=excess/total) %>%
ungroup()
ann_text8 <- data.frame(date=rep(as.Date("2020-06-01"), times=6),
deaths=c(100, 150, 270, 350, 500, 600),
age=factor(c("Under 15", "15-44", "45-64", "65-74", "75-84", "85+"),
levels=c("Under 15", "15-44", "45-64", "65-74", "75-84", "85+")))
agg_tiff("Outputs/NRSWeeklyDeathsxAge.tiff", units="in", width=12, height=8, res=500)
ggplot(plot8)+
geom_ribbon(aes(x=date, ymin=min, ymax=max), fill="Skyblue2")+
geom_ribbon(aes(x=date, ymin=mean, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(aes(x=date, y=mean), colour="Grey50", linetype=2)+
geom_line(aes(x=date, y=deaths), colour="Red")+
scale_x_date(name="", date_labels="%b-%y")+
scale_y_continuous(name="Weekly deaths registered", limits=c(0,NA))+
facet_wrap(~age)+
theme_classic()+
theme(plot.title=element_text(face="bold", size=rel(1.5)), plot.subtitle=element_markdown(),
strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
text=element_text(family="Lato"))+
labs(title="All age groups over 45 have seen excess mortality in recent weeks",
subtitle=paste0("Weekly deaths in Scotland in <span style='color:red;'>2020/21</span> compared to <span style='color:Skyblue4;'>the range in 2010-19</span>. Data up to ", ScotDate, " 2021."),
caption="Data from NRS | Plot by @VictimOfMaths")+
geom_text(data=ann_text8, aes(x=date, y=deaths), label=c(paste0(round(S.excess.age[1,2],0)," excess deaths in 2020\nvs. 2010-19 average (",
round(S.excess.age[1,4]*100, 1),"%)"),
paste0("+", round(S.excess.age[2,2],0)," deaths (+",
round(S.excess.age[2,4]*100, 0),"%)"),
paste0("+", round(S.excess.age[3,2],0)," deaths (+",
round(S.excess.age[3,4]*100, 0),"%)"),
paste0("+", round(S.excess.age[4,2],0)," deaths (+",
round(S.excess.age[4,4]*100, 0),"%)"),
paste0("+", round(S.excess.age[5,2],0)," deaths (+",
round(S.excess.age[5,4]*100, 0),"%)"),
paste0("+", round(S.excess.age[6,2],0)," deaths (+",
round(S.excess.age[6,4]*100, 0),"%)")),
size=3, colour=rep("red", times=6), hjust=0, family="Lato")
dev.off()
#Plot by location
plot9 <- data.loc.S %>%
mutate(week=if_else(year==2021,week+53, week),
loc=case_when(
loc=="Hospital" ~ "Hospital",
loc=="Care Home" ~ "Care Home",
TRUE ~ "Home/Other"
)) %>%
group_by(year, loc, week, date) %>%
summarise(deaths=sum(deaths)) %>%
ungroup()
plot9.old <- plot9 %>%
filter(year<2020) %>%
group_by(week, loc) %>%
summarise(min=min(deaths), max=max(deaths), mean=mean(deaths)) %>%
ungroup()
#Add extra weeks to old data
plot9.old <- plot9.old %>%
filter(week<=Scot2021MaxWeek-53) %>%
mutate(week=week+53) %>%
bind_rows(plot9.old)
plot9 <- plot9 %>%
filter(year>=2020) %>%
merge(plot9.old, by=c("loc", "week")) %>%
mutate(excess=deaths-mean,
loc=factor(loc, levels=c("Hospital", "Care Home", "Home/Other")))
#Calculate excess deaths vs. mean in 2020/21
S.excess.loc <- plot9 %>%
group_by(loc) %>%
summarise(excess=sum(excess), total=sum(mean), percexcess=excess/total) %>%
ungroup()
ann_text9 <- data.frame(date=rep(as.Date("2020-05-10"), times=3), deaths=c(750,600, 500),
loc=factor(c("Hospital", "Care Home", "Home/Other"),
levels=c("Hospital", "Care Home", "Home/Other")))
agg_tiff("Outputs/NRSWeeklyDeathsxLocation.tiff", units="in", width=14, height=7, res=500)
ggplot(plot9)+
geom_ribbon(aes(x=date, ymin=min, ymax=max), fill="Skyblue2")+
geom_ribbon(aes(x=date, ymin=mean, ymax=deaths), fill="Red", alpha=0.2)+
geom_line(aes(x=date, y=mean), colour="Grey50", linetype=2)+
geom_line(aes(x=date, y=deaths), colour="Red")+
scale_x_date(name="", date_labels="%b-%y")+
scale_y_continuous(name="Weekly deaths registered", limits=c(0,NA))+
facet_wrap(~loc)+
theme_classic()+
theme(plot.title=element_text(face="bold", size=rel(1.5)), plot.subtitle=element_markdown(),
strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
text=element_text(family="Lato"))+
labs(title="All-cause deaths in hospitals and private homes are above 'normal' levels",
subtitle=paste0("Weekly deaths in Scotland in <span style='color:red;'>2020/21</span> compared to <span style='color:Skyblue4;'>the range in 2015-19</span>. Data up to ", ScotDate, " 2021."),
caption="Data from NRS | Plot by @VictimOfMaths")+
geom_text(data=ann_text9, aes(x=date, y=deaths), label=c(paste0(round(S.excess.loc[1,2],0)," excess deaths in 2020/21\nvs. 2010-19 average (",
round(S.excess.loc[1,4]*100, 0),"%)"),
paste0("+", round(S.excess.loc[2,2],0)," deaths (+",
round(S.excess.loc[2,4]*100, 0),"%)"),
paste0("+", round(S.excess.loc[3,2],0)," deaths (+",
round(S.excess.loc[3,4]*100, 0),"%)")),
size=3, colour=rep("Red", 3), hjust=0, family="Lato")
dev.off()
#Plot excess by location
agg_tiff("Outputs/NRSWeeklyDeathsExcessxLocation.tiff", units="in", width=12, height=8, res=500)
ggplot(plot9)+
geom_line(aes(x=date, y=excess, colour=loc))+
geom_hline(yintercept=0, colour="Grey30")+
scale_x_date(name="", date_labels="%b-%y")+
scale_y_continuous(name="Excess deaths compared to 2015-19 average")+
scale_colour_paletteer_d(name="Place of death", "ggsci::planetexpress_futurama")+
theme_classic()+
theme(plot.title=element_text(face="bold", size=rel(1.5)), text=element_text(family="Lato"))+
labs(title="Excess mortality remains highest in Scottish homes",
subtitle="Excess deaths by place of death in Scotland in 2020/21 compared to the 2015-19 average",
caption="Data from NRS | Plot by @VictimOfMaths")
dev.off()
#Plot by cause
plot10 <- data.cause.S %>%
filter(loc=="All") %>%
mutate(week=if_else(year==2021,week+53, week),
date=as.Date("2020-01-05")+weeks(week-1),
cause=factor(cause, levels=c("COVID-19", "Cancer", "Circulatory", "Dementia / Alzheimers",
"Respiratory", "Other")))
agg_tiff("Outputs/NRSExcessxcause.tiff", units="in", width=10, height=7, res=500)
ggplot(plot10)+
geom_col(aes(x=date, y=excess, fill=cause))+
geom_hline(yintercept=0, colour="Grey30")+
scale_x_date(name="", date_labels="%b-%y")+
scale_y_continuous(name="Excess deaths compared to 2015-19 average")+
scale_fill_paletteer_d("LaCroixColoR::paired", name="Cause of death")+
theme_classic()+
theme(plot.title=element_text(face="bold", size=rel(1.5)),
text=element_text(family="Lato"))+
labs(title="The number of COVID deaths in Scotland has been fairly stable in recent weeks",
subtitle="Registered deaths by cause in Scotland in 2020/21 compared to the 2015-19 average",
caption="Data from NRS | Plot by @VictimOfMaths")
dev.off()
#Plot by cause *and* location
plot11 <- data.cause.S %>%
filter(loc!="All") %>%
mutate(week=if_else(year==2021,week+53, week),
date=as.Date("2020-01-05")+weeks(week-1),
cause=factor(cause, levels=c("COVID-19", "Cancer", "Circulatory", "Dementia / Alzheimers",
"Respiratory", "Other")),
loc=factor(loc, levels=c("Hospital", "Care Home", "Home/Other")))
agg_tiff("Outputs/NRSExcessxcausexloc.tiff", units="in", width=12, height=8, res=500)
ggplot(plot11)+
geom_col(aes(x=date, y=excess, fill=cause))+
geom_hline(yintercept=0, colour="Grey30")+
scale_x_date(name="", date_labels="%b-%y")+
scale_y_continuous(name="Excess deaths compared to 2015-19 average")+
scale_fill_paletteer_d("LaCroixColoR::paired", name="Cause of death")+
facet_wrap(~loc)+
theme_classic()+
theme(plot.title=element_text(face="bold", size=rel(1.5)),
strip.background=element_blank(), strip.text=
gitextract_eebvnxd3/ ├── All Cause Mortality/ │ ├── All Cause Deaths France.R │ ├── All Cause Deaths Italy.R │ ├── AllCauseDeaths.R │ ├── AllCauseDeaths2021.R │ ├── AllCauseDeathsxAge.R │ ├── COVIDAgeMortPred.R │ ├── COVIDCareHomeDeaths.R │ ├── COVIDDeathsMSOA.R │ ├── COVIDDeathsxAgeEW.R │ ├── COVIDDeathsxRegion.R │ ├── COVIDExcessxLAxCause.R │ ├── COVIDTotalDeathsPyramid.R │ ├── EWUSACOVIDDeathsxAgeComparison.R │ ├── LA All Cause Deaths.R │ ├── MSOA Deaths.R │ ├── NRS Excess Deaths by Cause.R │ ├── ONSDeathsxVaxStatus.R │ ├── ScottishAllCauseDeathsDetail.R │ └── readme.md ├── Exposure mapping/ │ ├── COVIDExposures.R │ ├── SheffieldCOVIDRiskxLSOA.R │ └── readme.md ├── Heatmaps/ │ ├── COVIDAdmissionsLTLAPhasePlot.R │ ├── COVIDAdmissionsWithFor.R │ ├── COVIDAdmissionsxAge.R │ ├── COVIDAdmissionsxAgeDashboard.R │ ├── COVIDAgeTrends.R │ ├── COVIDBivariateCasesxIMD.R │ ├── COVIDBivariateCasesxVax.R │ ├── COVIDBoosters.R │ ├── COVIDBoosters2.R │ ├── COVIDCFRs.R │ ├── COVIDCanadaHeatmap.R │ ├── COVIDCaseCartograms.R │ ├── COVIDCasesDeathsxIMD.R │ ├── COVIDCasesLTLAPhasePlot.R │ ├── COVIDCasesOctHalfTerm.R │ ├── COVIDCasesPhasePlotHighights.R │ ├── COVIDCasesSGTFNew.R │ ├── COVIDCasesSince100k.R │ ├── COVIDCasesVaxxIMD.R │ ├── COVIDCasesvsCFR.R │ ├── COVIDCasesxAgeContours.R │ ├── COVIDCasesxSex.R │ ├── COVIDCasesxVaxTadpoles.R │ ├── COVIDCasesxVaxxAge.R │ ├── COVIDCycle.R │ ├── COVIDCycle_US.R │ ├── COVIDDeathsWithFrom.R │ ├── COVIDHFRs.R │ ├── COVIDHKVaxxAge.R │ ├── COVIDLACaseData.R │ ├── COVIDLineages.R │ ├── COVIDMSOACaseRatexIMD.R │ ├── COVIDMetricsNormalised.R │ ├── COVIDNHSAbsences.R │ ├── COVIDNHSAdmissions.R │ ├── COVIDNHSBolton.R │ ├── COVIDNHSTrustLakePlots.R │ ├── COVIDONSDeathIneq.R │ ├── COVIDONSInfectionSurvey.R │ ├── COVIDONSInfectionSurveyVariants.R │ ├── COVIDPHECasesxAgev2.R │ ├── COVIDPHEPositivity.R │ ├── COVIDPHESurveillance.R │ ├── COVIDPHESurveillance2.R │ ├── COVIDPHEVaxSurveillance.R │ ├── COVIDPHEVaxxAgexSex.R │ ├── COVIDPillars.R │ ├── COVIDReinfections.R │ ├── COVIDSGTF.R │ ├── COVIDSpiral.R │ ├── COVIDSpiralEurope.R │ ├── COVIDTestingData.R │ ├── COVIDTotalDeathsPyramid.R │ ├── COVIDUKUSADeathsxAge.R │ ├── COVIDUnvaxRisk.R │ ├── COVIDVaccinationAnimations.R │ ├── COVIDVaccinationInequalityGB.R │ ├── COVIDVaccinationMSOACartogram.R │ ├── COVIDVaccinationPopAndIMD.R │ ├── COVIDVaccinationStaffCartogram.R │ ├── COVIDVaccinations.R │ ├── COVIDVaxHeatmap.R │ ├── COVIDVaxPyramidxRegion.R │ ├── COVIDVaxUptakexAge.R │ ├── COVIDVaxUptakexReg.R │ ├── COVIDVaxxAgeUKUSA.R │ ├── COVIDVaxxEthnicityEngScot.R │ ├── COVIDWaveComparisons.R │ ├── English LA Heatmaps.R │ ├── German State Heatmaps.R │ ├── Irish County Heatmaps.R │ ├── Misc Case Analysis.R │ ├── ONSInfectionSurvey.R │ ├── ScotlandCOVIDCasesxAge.R │ ├── ScotlandCOVIDHouseParties.R │ ├── Scottish HB Heatmaps.R │ ├── UK Hex Animations.R │ ├── UKIRELA.geojson │ ├── UKLA.geojson │ ├── Welsh LA Heatmaps.R │ ├── WelshLAHeatmap.R │ ├── YorkshireVaxCartogram.R │ ├── la_trust_lk.csv │ └── readme.md ├── Initial Inequality Estimates/ │ ├── Estimated Cases by IMD.R │ └── readme.md ├── Observed Inequality/ │ ├── COVID-19 vs. Brexit.R │ ├── COVIDIneqDataSetup.R │ ├── COVIDScotlandDeathsIneq.R │ ├── ONS Deaths Ineq 2.R │ ├── ONS Deaths Ineq.R │ └── readme.md └── README.md
Condensed preview — 115 files, each showing path, character count, and a content snippet. Download the .json file or copy for the full structured content (2,971K chars).
[
{
"path": "All Cause Mortality/All Cause Deaths France.R",
"chars": 12808,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(curl)\nlibrary(readxl)\nlibrary(lubridate)\nlibrary(forcats)\nlibrary(ggtext)\nlibr"
},
{
"path": "All Cause Mortality/All Cause Deaths Italy.R",
"chars": 13732,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(curl)\nlibrary(paletteer)\nlibrary(lubridate)\nlibrary(ggtext)\n\n#Download Italian"
},
{
"path": "All Cause Mortality/AllCauseDeaths.R",
"chars": 83368,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(paletteer)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(lubridate)\r\nlibrary(for"
},
{
"path": "All Cause Mortality/AllCauseDeaths2021.R",
"chars": 111393,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(paletteer)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(lubridate)\r\nlibrary(for"
},
{
"path": "All Cause Mortality/AllCauseDeathsxAge.R",
"chars": 33643,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(paletteer)\nlibrary(curl)\nlibrary(readxl)\nlibrary(lubridate)\nlibrary(forcats)\nl"
},
{
"path": "All Cause Mortality/COVIDAgeMortPred.R",
"chars": 18134,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(curl)\nlibrary(arrow)\nlibrary(readxl)\nlibrary(RcppRoll)\nlibrary(paletteer)\nlibr"
},
{
"path": "All Cause Mortality/COVIDCareHomeDeaths.R",
"chars": 9050,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(forcats)\r\nlibrary(paletteer)\r\nlibrary(scale"
},
{
"path": "All Cause Mortality/COVIDDeathsMSOA.R",
"chars": 12039,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(paletteer)\r\nlibrary(scales)\r\nlibrary(gtools)\r\nlibrary(ggtext"
},
{
"path": "All Cause Mortality/COVIDDeathsxAgeEW.R",
"chars": 5106,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(ragg)\r\nlibrary(lubridate)\r\nlibrary(extrafon"
},
{
"path": "All Cause Mortality/COVIDDeathsxRegion.R",
"chars": 6064,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(ukcovid19) #remotes::install_github(\"publichealthengland/coronavirus-dashboard"
},
{
"path": "All Cause Mortality/COVIDExcessxLAxCause.R",
"chars": 19344,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(forcats)\r\nlibrary(paletteer)\r\nlibrary(extrafont)\r\nlibrary(ggtext)\r\n\r\n#Read "
},
{
"path": "All Cause Mortality/COVIDTotalDeathsPyramid.R",
"chars": 11155,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(scales)\r\nlibrary(extrafont)\r\nlibrary(ragg)\r"
},
{
"path": "All Cause Mortality/EWUSACOVIDDeathsxAgeComparison.R",
"chars": 13654,
"preview": "rm(list=ls())\r\n\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(tidyverse)\r\nlibrary(paletteer)\r\nlibrary(ragg)\r\nlibrary(extrafon"
},
{
"path": "All Cause Mortality/LA All Cause Deaths.R",
"chars": 22152,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(curl)\nlibrary(readxl)\nlibrary(ggtext)\nlibrary(paletteer)\nlibrary(lubridate)\nli"
},
{
"path": "All Cause Mortality/MSOA Deaths.R",
"chars": 7496,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(curl)\nlibrary(readxl)\nlibrary(paletteer)\nlibrary(hrbrthemes)\nlibrary(sf)\n\n#Rea"
},
{
"path": "All Cause Mortality/NRS Excess Deaths by Cause.R",
"chars": 6129,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(curl)\nlibrary(readxl)\nlibrary(paletteer)\n\ntemp <- tempfile()\nsource <- \"https:"
},
{
"path": "All Cause Mortality/ONSDeathsxVaxStatus.R",
"chars": 6499,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(lubridate)\r\nlibrary(paletteer)\r\nlibrary(ext"
},
{
"path": "All Cause Mortality/ScottishAllCauseDeathsDetail.R",
"chars": 19657,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(paletteer)\nlibrary(curl)\nlibrary(lubridate)\nlibrary(readxl)\nlibrary(ggtext)\n\n#"
},
{
"path": "All Cause Mortality/readme.md",
"chars": 4921,
"preview": "**Analysis of data on weekly all-cause mortality during the pandemic**<br><br>\n[AllCauseDeaths2021.R](https://github.com"
},
{
"path": "Exposure mapping/COVIDExposures.R",
"chars": 19121,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(paletteer)\nlibrary(curl)\nlibrary(readxl)\nlibrary(sf)\nlibrary(gtools)\nlibrary(c"
},
{
"path": "Exposure mapping/SheffieldCOVIDRiskxLSOA.R",
"chars": 4727,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(sf)\r\nlibrary(paletteer)\r\n\r\n#Download popula"
},
{
"path": "Exposure mapping/readme.md",
"chars": 1041,
"preview": "Mapping potential population exposure to COVID-19.<br><br>\n[COVIDExposures.R](https://github.com/VictimOfMaths/COVID-19/"
},
{
"path": "Heatmaps/COVIDAdmissionsLTLAPhasePlot.R",
"chars": 40666,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(lubridate)\r\nlibrary(extrafont)\r\nlibrary(pal"
},
{
"path": "Heatmaps/COVIDAdmissionsWithFor.R",
"chars": 13177,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(paletteer)\r\nlibrary(extrafont)\r\nlibrary(rag"
},
{
"path": "Heatmaps/COVIDAdmissionsxAge.R",
"chars": 22535,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(lubridate)\r\nlibrary(ggstream)\r\nlibrary(extr"
},
{
"path": "Heatmaps/COVIDAdmissionsxAgeDashboard.R",
"chars": 12878,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(lubridate)\r\nlibrary(ggstream)\r\nlibrary(extr"
},
{
"path": "Heatmaps/COVIDAgeTrends.R",
"chars": 18113,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(broom)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(lubridate)\r\nlibrary(RcppRol"
},
{
"path": "Heatmaps/COVIDBivariateCasesxIMD.R",
"chars": 14489,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(sf)\r\nlibrary(paletteer)\r\nlibrary(ukcovid19)\r\nlibrary(readxl)"
},
{
"path": "Heatmaps/COVIDBivariateCasesxVax.R",
"chars": 20729,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(sf)\r\nlibrary(gtools)\r\nlibrary(extrafont)\r\nlibrary(cowplot)\r\n"
},
{
"path": "Heatmaps/COVIDBoosters.R",
"chars": 21379,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(paletteer)\r\nlibrary(scales)\r\nlibrary(extrafont)\r\nlibrary(rag"
},
{
"path": "Heatmaps/COVIDBoosters2.R",
"chars": 12332,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(paletteer)\r\nlibrary(scales)\r\nlibrary(extrafont)\r\nlibrary(rag"
},
{
"path": "Heatmaps/COVIDCFRs.R",
"chars": 6519,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(lubridate)\r\nlibrary(scales)\r\nlibrary(extrafont)\r\nlibrary(pal"
},
{
"path": "Heatmaps/COVIDCanadaHeatmap.R",
"chars": 10347,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(RcppRoll)\r\nlibrary(padr)\r\nlibrary(lubridate)\r\nlibrary(scales"
},
{
"path": "Heatmaps/COVIDCaseCartograms.R",
"chars": 13981,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(paletteer)\r\nlibrary(sf)\r\nlibrary(ragg)\r\nlibrary(ggtext)\r\nlib"
},
{
"path": "Heatmaps/COVIDCasesDeathsxIMD.R",
"chars": 30432,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(lubridate)\r\nlibrary(RcppRoll)\r\nlibrary(readxl)\r\nlibrary(gtoo"
},
{
"path": "Heatmaps/COVIDCasesLTLAPhasePlot.R",
"chars": 15872,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(paletteer)\r\nlibrary(sf)\r\nlibrary(ragg)\r\nlibrary(ggtext)\r\nlib"
},
{
"path": "Heatmaps/COVIDCasesOctHalfTerm.R",
"chars": 8243,
"preview": "rm(list=ls())\r\n\r\nlibrary(curl)\r\nlibrary(arrow)\r\nlibrary(tidyverse)\r\nlibrary(RcppRoll)\r\nlibrary(ggtext)\r\nlibrary(ragg)\r\n\r"
},
{
"path": "Heatmaps/COVIDCasesPhasePlotHighights.R",
"chars": 6219,
"preview": "#You need to make sure all these packages are installed on your machine\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(ra"
},
{
"path": "Heatmaps/COVIDCasesSGTFNew.R",
"chars": 4720,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(lubridate)\r\nlibrary(RcppRoll)\r\nlibrary(readODS)\r\nlibrary(pal"
},
{
"path": "Heatmaps/COVIDCasesSince100k.R",
"chars": 4513,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(lubridate)\r\nlibrary(paletteer)\r\nlibrary(ggrepel)\r\nlibrary(ex"
},
{
"path": "Heatmaps/COVIDCasesVaxxIMD.R",
"chars": 13459,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(lubridate)\r\nlibrary(RcppRoll)\r\nlibrary(readxl)\r\nlibrary(gtoo"
},
{
"path": "Heatmaps/COVIDCasesvsCFR.R",
"chars": 24526,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(arrow)\r\nlibrary(readxl)\r\nlibrary(RcppRoll)\r\nlibrary(scales)\r"
},
{
"path": "Heatmaps/COVIDCasesxAgeContours.R",
"chars": 7884,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(RcppRoll)\r\nlibrary(lubridate)\r\nlibrary(ggtext)\r\nlibrary(extr"
},
{
"path": "Heatmaps/COVIDCasesxSex.R",
"chars": 41456,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(RcppRoll)\r\nlibrary(lubridate)\r\nlibrary(ggtext)\r\nlibrary(extr"
},
{
"path": "Heatmaps/COVIDCasesxVaxTadpoles.R",
"chars": 7846,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(lubridate)\r\nlibrary(paletteer)\r\nlibrary(sca"
},
{
"path": "Heatmaps/COVIDCasesxVaxxAge.R",
"chars": 25508,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(RcppRoll)\r\nlibrary(readxl)\r\nlibrary(paletteer)\r\nlibrary(extr"
},
{
"path": "Heatmaps/COVIDCycle.R",
"chars": 12687,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(lubridate)\r\nlibrary(ukcovid19) #remotes::install_github(\"pub"
},
{
"path": "Heatmaps/COVIDCycle_US.R",
"chars": 5824,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(curl)\nlibrary(paletteer)\nlibrary(geofacet)\nlibrary(ggtext)\nlibrary(ragg)\n\nopti"
},
{
"path": "Heatmaps/COVIDDeathsWithFrom.R",
"chars": 2306,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(paletteer)\r\nlibrary(extrafont)\r\nlibrary(rag"
},
{
"path": "Heatmaps/COVIDHFRs.R",
"chars": 5135,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(scales)\r\nlibrary(lubridate)\r\nlibrary(RcppRo"
},
{
"path": "Heatmaps/COVIDHKVaxxAge.R",
"chars": 4225,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(RcppRoll)\r\nlibrary(lubridate)\r\nlibrary(ggtext)\r\nlibrary(extr"
},
{
"path": "Heatmaps/COVIDLACaseData.R",
"chars": 59098,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(forcats)\nlibrary(cowplot)\nlibrary(ggridges)\nlibrary(geojsonio)\nlibrary(broom)\n"
},
{
"path": "Heatmaps/COVIDLineages.R",
"chars": 7943,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(paletteer)\r\nlibrary(extrafont)\r\nlibrary(geofacet)\r\nlibrary(s"
},
{
"path": "Heatmaps/COVIDMSOACaseRatexIMD.R",
"chars": 13368,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(lubridate)\r\nlibrary(paletteer)\r\nlibrary(geo"
},
{
"path": "Heatmaps/COVIDMetricsNormalised.R",
"chars": 13410,
"preview": "rm(list=ls())\r\n\r\n#Code to replicate this nice graph from Paul Mainwood\r\n#https://twitter.com/PaulMainwood/status/1449467"
},
{
"path": "Heatmaps/COVIDNHSAbsences.R",
"chars": 15266,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(paletteer)\r\nlibrary(extrafont)\r\nlibrary(rag"
},
{
"path": "Heatmaps/COVIDNHSAdmissions.R",
"chars": 28900,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(lubridate)\r\nlibrary(paletteer)\r\nlibrary(Rcp"
},
{
"path": "Heatmaps/COVIDNHSBolton.R",
"chars": 3196,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(lubridate)\r\nlibrary(paletteer)\r\nlibrary(ggt"
},
{
"path": "Heatmaps/COVIDNHSTrustLakePlots.R",
"chars": 19054,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(ragg)\r\nlibrary(lubridate)\r\nlibrary(extrafon"
},
{
"path": "Heatmaps/COVIDONSDeathIneq.R",
"chars": 16324,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(lubridate)\r\nlibrary(RcppRoll)\r\nlibrary(readxl)\r\nlibrary(pale"
},
{
"path": "Heatmaps/COVIDONSInfectionSurvey.R",
"chars": 34414,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(lubridate)\r\nlibrary(ggtext)\r\nlibrary(extrafont)\r\nlibrary(rag"
},
{
"path": "Heatmaps/COVIDONSInfectionSurveyVariants.R",
"chars": 6422,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(lubridate)\r\nlibrary(ggtext)\r\nlibrary(extrafont)\r\nlibrary(rag"
},
{
"path": "Heatmaps/COVIDPHECasesxAgev2.R",
"chars": 21746,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(arrow)\r\nlibrary(readxl)\r\nlibrary(RcppRoll)\r\nlibrary(palettee"
},
{
"path": "Heatmaps/COVIDPHEPositivity.R",
"chars": 2512,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(RcppRoll)\r\nlibrary(lubridate)\r\nlibrary(ggtext)\r\nlibrary(extr"
},
{
"path": "Heatmaps/COVIDPHESurveillance.R",
"chars": 9737,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(ggtext)\r\nlibrary(ggridges)\r\nlibrary(palette"
},
{
"path": "Heatmaps/COVIDPHESurveillance2.R",
"chars": 6596,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(ggtext)\r\nlibrary(ggridges)\r\nlibrary(ggstrea"
},
{
"path": "Heatmaps/COVIDPHEVaxSurveillance.R",
"chars": 12899,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(readxl)\r\nlibrary(lubridate)\r\nlibrary(extrafont)\r\nlibrary(ragg)\r\n\r\ntheme_cus"
},
{
"path": "Heatmaps/COVIDPHEVaxxAgexSex.R",
"chars": 28439,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(extrafont)\r\nlibrary(ggtext)\r\nlibrary(ragg)\r"
},
{
"path": "Heatmaps/COVIDPillars.R",
"chars": 9453,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(curl)\nlibrary(paletteer)\nlibrary(ggtext)\nlibrary(RcppRoll)\nlibrary(readxl)\nlib"
},
{
"path": "Heatmaps/COVIDReinfections.R",
"chars": 6157,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(lubridate)\r\nlibrary(scales)\r\nlibrary(RcppRoll)\r\nlibrary(curl)\r\nlibrary(pale"
},
{
"path": "Heatmaps/COVIDSGTF.R",
"chars": 5055,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(extrafont)\r\nlibrary(paletteer)\r\nlibrary(ragg)\r\nlibrary(RcppR"
},
{
"path": "Heatmaps/COVIDSpiral.R",
"chars": 13434,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(ggtext)\r\nlibrary(extrafont)\r\nlibrary(RcppRoll)\r\nlibrary(ragg"
},
{
"path": "Heatmaps/COVIDSpiralEurope.R",
"chars": 8496,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(ggtext)\r\nlibrary(extrafont)\r\nlibrary(RcppRoll)\r\nlibrary(ragg"
},
{
"path": "Heatmaps/COVIDTestingData.R",
"chars": 6945,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(paletteer)\r\nlibrary(ukcovid19)\r\nlibrary(RcppRoll)\r\nlibrary(scales)\r\n\r\n#Call"
},
{
"path": "Heatmaps/COVIDTotalDeathsPyramid.R",
"chars": 6472,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(scales)\r\nlibrary(extrafont)\r\nlibrary(ragg)\r"
},
{
"path": "Heatmaps/COVIDUKUSADeathsxAge.R",
"chars": 13118,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(RcppRoll)\r\nlibrary(lubridate)\r\nlibrary(ggtext)\r\nlibrary(extr"
},
{
"path": "Heatmaps/COVIDUnvaxRisk.R",
"chars": 20052,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(sf)\r\nlibrary(arrow)\r\nlibrary(extrafont)\r\nli"
},
{
"path": "Heatmaps/COVIDVaccinationAnimations.R",
"chars": 16526,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(sf)\r\nlibrary(scales)\r\nlibrary(ragg)\r\nlibrar"
},
{
"path": "Heatmaps/COVIDVaccinationInequalityGB.R",
"chars": 18135,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(readxl)\r\nlibrary(curl)\r\nlibrary(scales)\r\nlibrary(extrafont)\r\nlibrary(palett"
},
{
"path": "Heatmaps/COVIDVaccinationMSOACartogram.R",
"chars": 36123,
"preview": "rm(list=ls())\r\n\r\nlibrary(curl)\r\nlibrary(tidyverse)\r\nlibrary(readxl)\r\nlibrary(paletteer)\r\nlibrary(sf)\r\nlibrary(scales)\r\nl"
},
{
"path": "Heatmaps/COVIDVaccinationPopAndIMD.R",
"chars": 11639,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(RcppRoll)\r\nlibrary(readxl)\r\nlibrary(paletteer)\r\nlibrary(extr"
},
{
"path": "Heatmaps/COVIDVaccinationStaffCartogram.R",
"chars": 10605,
"preview": "rm(list=ls())\r\n\r\nlibrary(curl)\r\nlibrary(tidyverse)\r\nlibrary(readxl)\r\nlibrary(paletteer)\r\nlibrary(sf)\r\nlibrary(scales)\r\nl"
},
{
"path": "Heatmaps/COVIDVaccinations.R",
"chars": 7179,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(ukcovid19)\r\nlibrary(paletteer)\r\nlibrary(ggtext)\r\nlibrary(Rcp"
},
{
"path": "Heatmaps/COVIDVaxHeatmap.R",
"chars": 8340,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(RcppRoll)\r\nlibrary(lubridate)\r\nlibrary(sf)\r\nlibrary(extrafon"
},
{
"path": "Heatmaps/COVIDVaxPyramidxRegion.R",
"chars": 5274,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(showtext)\r\n\r\noptions(scipen=9999)\r\n\r\n#Downl"
},
{
"path": "Heatmaps/COVIDVaxUptakexAge.R",
"chars": 13263,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(paletteer)\r\nlibrary(scales)\r\nlibrary(extrafont)\r\nlibrary(rag"
},
{
"path": "Heatmaps/COVIDVaxUptakexReg.R",
"chars": 1631,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(paletteer)\r\nlibrary(extrafont)\r\nlibrary(ragg)\r\n\r\ntheme_custo"
},
{
"path": "Heatmaps/COVIDVaxxAgeUKUSA.R",
"chars": 17330,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(extrafont)\r\nlibrary(ggtext)\r\nlibrary(scales)\r\nlibrary(readxl"
},
{
"path": "Heatmaps/COVIDVaxxEthnicityEngScot.R",
"chars": 4884,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(ggtext)\r\nlibrary(extrafont)\r\nlibrary(ragg)\r"
},
{
"path": "Heatmaps/COVIDWaveComparisons.R",
"chars": 10018,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(lubridate)\r\nlibrary(paletteer)\r\nlibrary(ggrepel)\r\nlibrary(ex"
},
{
"path": "Heatmaps/English LA Heatmaps.R",
"chars": 31366,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(curl)\nlibrary(forcats)\nlibrary(RcppRoll)\nlibrary(data.table)\nlibrary(readxl)\nl"
},
{
"path": "Heatmaps/German State Heatmaps.R",
"chars": 12993,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(curl)\nlibrary(forcats)\nlibrary(readxl)\nlibrary(RcppRoll)\nlibrary(zoo)\nlibrary("
},
{
"path": "Heatmaps/Irish County Heatmaps.R",
"chars": 7065,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(curl)\nlibrary(forcats)\nlibrary(readxl)\nlibrary(RcppRoll)\nlibrary(cowplot)\nlibr"
},
{
"path": "Heatmaps/Misc Case Analysis.R",
"chars": 18105,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(curl)\nlibrary(paletteer)\nlibrary(lubridate)\nlibrary(gt)\nlibrary(sf)\nlibrary(rm"
},
{
"path": "Heatmaps/ONSInfectionSurvey.R",
"chars": 2836,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(paletteer)\r\nlibrary(scales)\r\nlibrary(ragg)\r"
},
{
"path": "Heatmaps/ScotlandCOVIDCasesxAge.R",
"chars": 10220,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(ggtext)\r\nlibrary(ggridges)\r\nlibrary(palette"
},
{
"path": "Heatmaps/ScotlandCOVIDHouseParties.R",
"chars": 7870,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(googlesheets4)\r\nlibrary(lubridate)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary"
},
{
"path": "Heatmaps/Scottish HB Heatmaps.R",
"chars": 15172,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(curl)\nlibrary(forcats)\nlibrary(readxl)\nlibrary(RcppRoll)\nlibrary(cowplot)\nlibr"
},
{
"path": "Heatmaps/UK Hex Animations.R",
"chars": 2379,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(geojsonio)\nlibrary(broom)\nlibrary(zoo)\nlibrary(gganimate)\n\n#Get English UTLA-l"
},
{
"path": "Heatmaps/UKIRELA.geojson",
"chars": 179784,
"preview": "{\"type\":\"FeatureCollection\",\"features\":[{\"type\":\"Feature\",\"properties\":{\"n\":\"Hartlepool\",\"id\":\"E06000001\",\"lon\":-1.27023"
},
{
"path": "Heatmaps/UKLA.geojson",
"chars": 168346,
"preview": "{\"type\":\"FeatureCollection\",\"features\":[{\"type\":\"Feature\",\"properties\":{\"n\":\"Hartlepool\",\"id\":\"E06000001\",\"lon\":-1.27023"
},
{
"path": "Heatmaps/Welsh LA Heatmaps.R",
"chars": 3321,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(curl)\nlibrary(forcats)\nlibrary(readxl)\nlibrary(RcppRoll)\nlibrary(cowplot)\n\n#Re"
},
{
"path": "Heatmaps/WelshLAHeatmap.R",
"chars": 19513,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(forcats)\r\nlibrary(cowplot)\r\nlibrary(ggridges)\r\nlibrary(geojsonio)\r\nlibrary("
},
{
"path": "Heatmaps/YorkshireVaxCartogram.R",
"chars": 19115,
"preview": "rm(list=ls())\r\n\r\nlibrary(curl)\r\nlibrary(tidyverse)\r\nlibrary(readxl)\r\nlibrary(paletteer)\r\nlibrary(sf)\r\nlibrary(scales)\r\nl"
},
{
"path": "Heatmaps/la_trust_lk.csv",
"chars": 642106,
"preview": "\"areacode\",\"areaname\",\"procode3\",\"CountAdm\"\r\n\"E06000001\",\"Hartlepool\",\"RVW\",13157\r\n\"E06000001\",\"Hartlepool\",\"RTR\",1000\r\n"
},
{
"path": "Heatmaps/readme.md",
"chars": 11509,
"preview": "## Visualising the spread of the pandemic<br>\n*Cases*<br>\n[English LA Heatmaps.R](https://github.com/VictimOfMaths/COVID"
},
{
"path": "Initial Inequality Estimates/Estimated Cases by IMD.R",
"chars": 15667,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(curl)\nlibrary(readxl)\nlibrary(paletteer)\nlibrary(sf)\nlibrary(gganimate)\nlibrar"
},
{
"path": "Initial Inequality Estimates/readme.md",
"chars": 844,
"preview": "An initial attempt to understand the potential inequality impacts of the pandemic, before official data became available"
},
{
"path": "Observed Inequality/COVID-19 vs. Brexit.R",
"chars": 2850,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(curl)\nlibrary(sf)\nlibrary(paletteer)\nlibrary(readxl)\n\n#Read in Brexit voting d"
},
{
"path": "Observed Inequality/COVIDIneqDataSetup.R",
"chars": 30667,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(lubridate)\r\nlibrary(paletteer)\r\nlibrary(ggt"
},
{
"path": "Observed Inequality/COVIDScotlandDeathsIneq.R",
"chars": 17439,
"preview": "rm(list=ls())\r\n\r\nlibrary(tidyverse)\r\nlibrary(curl)\r\nlibrary(readxl)\r\nlibrary(ggtext)\r\nlibrary(paletteer)\r\n\r\n############"
},
{
"path": "Observed Inequality/ONS Deaths Ineq 2.R",
"chars": 19695,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(curl)\nlibrary(paletteer)\nlibrary(readxl)\nlibrary(broom)\nlibrary(wesanderson)\nl"
},
{
"path": "Observed Inequality/ONS Deaths Ineq.R",
"chars": 10155,
"preview": "rm(list=ls())\n\nlibrary(tidyverse)\nlibrary(paletteer)\nlibrary(curl)\nlibrary(readxl)\n\ntemp <- tempfile()\nsource <- \"https:"
},
{
"path": "Observed Inequality/readme.md",
"chars": 1038,
"preview": "An analysis of published data on the inequality impacts of the pandemic, and how this compares to historic inequality.<b"
},
{
"path": "README.md",
"chars": 17895,
"preview": "# COVID-19\nPlots and analysis relating to the pandemic\n\n1) *Cases*<br>\n[English LA Heatmaps.R](https://github.com/Victim"
}
]
About this extraction
This page contains the full source code of the VictimOfMaths/COVID-19 GitHub repository, extracted and formatted as plain text for AI agents and large language models (LLMs). The extraction includes 115 files (2.6 MB), approximately 677.1k tokens. Use this with OpenClaw, Claude, ChatGPT, Cursor, Windsurf, or any other AI tool that accepts text input. You can copy the full output to your clipboard or download it as a .txt file.
Extracted by GitExtract — free GitHub repo to text converter for AI. Built by Nikandr Surkov.