-
Notifications
You must be signed in to change notification settings - Fork 54
/
COVIDCycle.R
232 lines (205 loc) · 12.4 KB
/
COVIDCycle.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
rm(list=ls())
library(tidyverse)
library(curl)
library(lubridate)
library(ukcovid19) #remotes::install_github("publichealthengland/coronavirus-dashboard-api-R-sdk")
library(paletteer)
library(ggtext)
library(extrafont)
options(scipen=9999)
admissions <- get_data(filters="areaType=nation", structure=list(date="date",
name="areaName",
admissions="newAdmissions"))
admissions <- admissions %>%
mutate(date=as.Date(date)) %>%
filter(date>as.Date("2020-03-19"))
deaths <- get_data(filters="areaType=nation", structure=list(date="date",
name="areaName",
deaths="newDeaths28DaysByDeathDate"))
deaths <- deaths %>%
mutate(date=as.Date(date)) %>%
filter(date>as.Date("2020-03-19"))
data <- merge(admissions, deaths) %>%
mutate(days=yday(date), weekno=if_else(year(date)==2020, week(date), week(date)+52), pop=case_when(
name=="England" ~ 56286961,
name=="Northern Ireland" ~ 1893667,
name=="Scotland" ~ 5463300,
name=="Wales" ~ 3152879),
admrate=admissions*100000/pop, mortrate=deaths*100000/pop) %>%
arrange(date)
weekdata <- data %>%
group_by(weekno, name) %>%
summarise(admissions=mean(admissions), deaths=mean(deaths),
admrate=mean(admrate), mortrate=mean(mortrate)) %>%
mutate(label=as.Date("2020-01-01")+days(weekno)*7-1, label=format(label, "%d %b %y")) %>%
ungroup() %>%
#Pull out every 4th week for labelling, making sure the most recent week is always labelled
#I bet there is a more elegant solution than this, but I just learned that %% does, so I am unrepentant
group_by(name) %>%
arrange(-weekno) %>%
mutate(flag=(max(weekno)-weekno) %% 4) %>%
ungroup() %>%
arrange(weekno)
#Faceted plot for UK nations
tiff("Outputs/COVIDCycleUK.tiff", units="in", width=12, height=8, res=500)
ggplot()+
geom_path(data=data, aes(x=admrate, y=mortrate), alpha=0.1,
arrow = arrow(type = "closed", angle = 30, length = unit(0.05, "inches")))+
geom_path(data=weekdata, aes(x=admrate, y=mortrate), colour="tomato",
arrow = arrow(type = "closed", angle = 30, length = unit(0.05, "inches")))+
geom_text(data=weekdata %>% filter(flag==0),
aes(x=admrate, y=mortrate, label=label), size=rel(2), colour="Grey40",
vjust=-0.4)+
scale_x_continuous(trans="log10", name="Daily COVID-19 admissions per 100,000 (log scale)")+
scale_y_continuous(trans="log10", name="Daily COVID-19 deaths per 100,000 (log scale)")+
facet_wrap(~name)+
theme_classic()+
theme(plot.subtitle=element_markdown(), plot.title=element_text(face="bold", size=rel(1.6)),
strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
text=element_text(family="Lato"))+
labs(title="Going round in circles",
subtitle="New hospital admissions with positive COVID-19 test and deaths within 28 days of a positive test across the UK <span style='color:Grey60;'>by day</span> and <span style='color:tomato;'>the weekly average",
caption="Inspired by @maartenzam | Data from coronavirus.data.gov.uk | Plot by @VictimOfMaths")
dev.off()
#Plot for England only
EngCycle <- ggplot()+
geom_path(data=subset(data, name=="England"), aes(x=admissions, y=deaths), alpha=0.1,
arrow = arrow(type = "closed", angle = 30, length = unit(0.05, "inches")))+
geom_path(data=subset(weekdata, name=="England"), aes(x=admissions, y=deaths), colour="tomato",
arrow = arrow(type = "closed", angle = 30, length = unit(0.05, "inches")))+
geom_text(data=weekdata %>% filter(name=="England" & flag==0),
aes(x=admissions, y=deaths, label=label), size=rel(2), colour="Grey40",
vjust=-0.4)+
scale_x_continuous(trans="log10", name="Daily COVID-19 admissions (log scale)")+
scale_y_continuous(trans="log10", name="Daily COVID-19 deaths (log scale)")+
theme_classic()+
theme(plot.subtitle=element_markdown(), plot.title=element_text(face="bold", size=rel(2)),
text=element_text(family="Lato"))+
labs(title="Going round in circles",
subtitle="New hospital admissions with positive COVID-19 test and deaths within 28 days of a positive test<br>in England <span style='color:Grey60;'>by day</span> and <span style='color:tomato;'>the weekly average",
caption="Inspired by @maartenzam | Data from coronavirus.data.gov.uk | Plot by @VictimOfMaths")
tiff("Outputs/COVIDCycleEng.tiff", units="in", width=8, height=6, res=500)
EngCycle
dev.off()
png("Outputs/COVIDCycleEng.png", units="in", width=8, height=6, res=500)
EngCycle
dev.off()
#Plot for Wales only
tiff("Outputs/COVIDCycleWal.tiff", units="in", width=8, height=6, res=500)
ggplot()+
geom_path(data=subset(data, name=="Wales"), aes(x=admissions, y=deaths), alpha=0.1,
arrow = arrow(type = "closed", angle = 30, length = unit(0.05, "inches")))+
geom_path(data=subset(weekdata, name=="Wales"), aes(x=admissions, y=deaths), colour="tomato",
arrow = arrow(type = "closed", angle = 30, length = unit(0.05, "inches")))+
geom_text(data=weekdata %>% filter(name=="Wales" & flag==0),
aes(x=admissions, y=deaths, label=label), size=rel(2), colour="Grey40",
vjust=-0.4)+
scale_x_continuous(trans="log10", name="Daily COVID-19 admissions (log scale)")+
scale_y_continuous(trans="log10", name="Daily COVID-19 deaths (log scale)")+
theme_classic()+
theme(plot.subtitle=element_markdown(), plot.title=element_text(face="bold", size=rel(2)),
text=element_text(family="Lato"))+
labs(title="Going round in circles",
subtitle="New hospital admissions with positive COVID-19 test and deaths within 28 days of a positive test<br>in Wales <span style='color:Grey60;'>by day</span> and <span style='color:tomato;'>the weekly average",
caption="Inspired by @maartenzam | Data from coronavirus.data.gov.uk | Plot by @VictimOfMaths")
dev.off()
#Plot for Scotland only
tiff("Outputs/COVIDCycleSco.tiff", units="in", width=8, height=6, res=500)
ggplot()+
geom_path(data=subset(data, name=="Scotland"), aes(x=admissions, y=deaths), alpha=0.1,
arrow = arrow(type = "closed", angle = 30, length = unit(0.05, "inches")))+
geom_path(data=subset(weekdata, name=="Scotland"), aes(x=admissions, y=deaths), colour="tomato",
arrow = arrow(type = "closed", angle = 30, length = unit(0.05, "inches")))+
geom_text(data=weekdata %>% filter(name=="Scotland" & flag==0),
aes(x=admissions, y=deaths, label=label), size=rel(2), colour="Grey40",
vjust=-0.4)+
scale_x_continuous(trans="log10", name="Daily COVID-19 admissions (log scale)")+
scale_y_continuous(trans="log10", name="Daily COVID-19 deaths (log scale)")+
theme_classic()+
theme(plot.subtitle=element_markdown(), plot.title=element_text(face="bold", size=rel(2)),
text=element_text(family="Lato"))+
labs(title="Going round in circles",
subtitle="New hospital admissions with positive COVID-19 test and deaths within 28 days of a positive test<br>in Scotland <span style='color:Grey60;'>by day</span> and <span style='color:tomato;'>the weekly average",
caption="Inspired by @maartenzam | Data from coronavirus.data.gov.uk | Plot by @VictimOfMaths")
dev.off()
#Plot for NI only
tiff("Outputs/COVIDCycleNI.tiff", units="in", width=8, height=6, res=500)
ggplot()+
geom_path(data=subset(data, name=="Northern Ireland"), aes(x=admissions, y=deaths), alpha=0.1,
arrow = arrow(type = "closed", angle = 30, length = unit(0.05, "inches")))+
geom_path(data=subset(weekdata, name=="Northern Ireland"), aes(x=admissions, y=deaths), colour="tomato",
arrow = arrow(type = "closed", angle = 30, length = unit(0.05, "inches")))+
geom_text(data=weekdata %>% filter(name=="Northern Ireland" & flag==0),
aes(x=admissions, y=deaths, label=label), size=rel(2), colour="Grey40",
vjust=-0.4)+
scale_x_continuous(trans="log10", name="Daily COVID-19 admissions (log scale)")+
scale_y_continuous(trans="log10", name="Daily COVID-19 deaths (log scale)")+
theme_classic()+
theme(plot.subtitle=element_markdown(), plot.title=element_text(face="bold", size=rel(2)),
text=element_text(family="Lato"))+
labs(title="Going round in circles",
subtitle="New hospital admissions with positive COVID-19 test and deaths within 28 days of a positive test<br>in Northern Ireland <span style='color:Grey60;'>by day</span> and <span style='color:tomato;'>the weekly average",
caption="Inspired by @maartenzam | Data from coronavirus.data.gov.uk | Plot by @VictimOfMaths")
dev.off()
#Repeat at regional level
admissions.reg <- get_data(filters="areaType=nhsregion", structure=list(date="date",
name="areaName",
admissions="newAdmissions"))
admissions.reg <- admissions.reg %>%
mutate(date=as.Date(date)) %>%
filter(date>as.Date("2020-03-19"))
deaths.reg <- get_data(filters="areaType=region", structure=list(date="date",
name="areaName",
deaths="newDeaths28DaysByDeathDate"))
#Compress regions to align (more or less) with NHS regions
deaths.reg <- deaths.reg %>%
mutate(date=as.Date(date)) %>%
filter(date>as.Date("2020-03-19")) %>%
mutate(name=case_when(name %in% c("East Midlands", "West Midlands") ~ "Midlands",
name %in% c("North East", "Yorkshire and The Humber") ~ "North East and Yorkshire",
TRUE ~ name)) %>%
group_by(date, name) %>%
summarise(deaths=sum(deaths)) %>%
ungroup()
data.reg <- merge(admissions.reg, deaths.reg) %>%
mutate(days=yday(date), weekno=if_else(year(date)==2020, week(date), week(date)+52), pop=case_when(
name=="East of England" ~ 6236072,
name=="London" ~ 8961989,
name=="Midlands" ~ 4835928+5934037,
name=="North East and Yorkshire" ~ 2669941+5502967,
name=="North West" ~ 7341196,
name=="South East" ~ 9180135,
name=="South West" ~ 5624696),
admrate=admissions*100000/pop, mortrate=deaths*100000/pop) %>%
arrange(date)
weekdata.reg <- data.reg %>%
group_by(weekno, name) %>%
summarise(admissions=mean(admissions), deaths=mean(deaths),
admrate=mean(admrate), mortrate=mean(mortrate)) %>%
mutate(label=as.Date("2020-01-01")+days(weekno)*7-1, label=format(label, "%d %b")) %>%
ungroup() %>%
group_by(name) %>%
arrange(-weekno) %>%
mutate(flag=(max(weekno)-weekno) %% 4) %>%
ungroup() %>%
arrange(weekno)
#Faceted plot for English regions
tiff("Outputs/COVIDCycleReg.tiff", units="in", width=14, height=8, res=500)
ggplot()+
geom_path(data=data.reg, aes(x=admrate, y=mortrate), alpha=0.1,
arrow = arrow(type = "closed", angle = 30, length = unit(0.05, "inches")))+
geom_path(data=weekdata.reg, aes(x=admrate, y=mortrate), colour="tomato",
arrow = arrow(type = "closed", angle = 30, length = unit(0.05, "inches")))+
#geom_text(data=weekdata.reg, aes(x=admrate, y=mortrate, label=label), size=rel(2), colour="Grey40",
# vjust=-0.4)+
scale_x_continuous(trans="log10", name="Daily COVID-19 admissions per 100,000 (log scale)")+
scale_y_continuous(trans="log10", name="Daily COVID-19 deaths per 100,000 (log scale)")+
facet_wrap(~name)+
theme_classic()+
theme(plot.subtitle=element_markdown(), plot.title=element_text(face="bold", size=rel(2)),
strip.background=element_blank(), strip.text=element_text(face="bold", size=rel(1)),
text=element_text(family="Lato"))+
labs(title="Going round in circles",
subtitle="New hospital admissions with a positive COVID-19 test and deaths within 28 days of a positive test in England England <span style='color:Grey60;'>by day</span> and <span style='color:tomato;'>the weekly average</span>.<br>Admissions data is published for NHS regions while deaths data is at government region level. These geographies are similar but may not overlap perfectly.",
caption="Inspired by @maartenzam | Data from coronavirus.data.gov.uk | Plot by @VictimOfMaths")
dev.off()