-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathwinterpressures.Rmd
211 lines (171 loc) · 8.99 KB
/
winterpressures.Rmd
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
---
title: "NHS England winter pressures and BRC volunteers"
output:
html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r load_data, message=FALSE, warning=FALSE, include=FALSE}
library(tidyverse)
library(tidyr)
library(leaflet)
library(mapview)
library(leaflet.extras)
library(readxl)
library(stringr)
library(lubridate)
source("init.r")
##
## Volunteers
##
vol_radius = 40000 # 40km
# volunteer data from Fiona Agnew's report
# subset emergency response and IL volunteers
vols = read_csv(file.path(vols.dir, "volunteers - 18-12-17.csv")) %>%
rename(Position = `Role Name`, `Position location` = Location, Basis = `Volunteer Basis`,
Type = `Volunteer Type`) %>%
filter(Basis == "Regular" & Type == "Active") %>% # only show regular, active volunteers
filter(`Role Family` %in% c("Emergency Response", "Independent Living")) %>%
filter(substr(Country, 1, 1) == "E") %>% # volunteers in England only
filter(!is.na(Latitude) & !is.na(Longitude)) # drop people we can't map
##
## load latest version of the winter situation report
## (generated by `process sitrep.r`)
##
# pick the most recent file in the sitrep folder
# source: https://stackoverflow.com/questions/13762224/how-to-sort-files-list-by-date/13762544
sitrep_details = file.info(list.files(path=sitrep.dir, pattern="*.csv", full.names=T))
sitrep_filename = sitrep_details %>%
rownames_to_column() %>%
mutate(mtime = as.POSIXct(mtime)) %>%
arrange(desc(mtime)) %>%
top_n(1, mtime) %>%
select(rowname) %>%
as.character()
sitrep = read_csv(sitrep_filename)
# extract date of this sitrep from the filename
sitrep_date = ymd(str_extract(sitrep_filename, "\\d{4}-\\d{2}-\\d{2}"))
sitrep_date_str = format(sitrep_date, format="%A %d %B %Y") # convert to friendly string (e.g. "Sunday 07 January 2018")
n.bins = max(sitrep$StressRank) # did we rank Trusts into quartiles, quintiles etc.?
rank_cols = c("#31a354", "#fed976", "#fd8d3c", "#de2d26") # green, yellow, orange, red
```
```{r popup_graph, message=FALSE, warning=FALSE, include=FALSE}
# create a list of figures - one for each data point (NHS Trust) - to appear in each popup
pops = lapply(1:nrow(sitrep), function(i) {
sitrep_bar = sitrep[i,] %>%
select(Name, Delay_stress:Diverts_stress) %>%
gather(Indicator, Rating, Delay_stress:Diverts_stress) %>%
mutate(Rating = factor(Rating, levels=1:n.bins))
sitrep_bar = sitrep_bar %>%
mutate(x_text = case_when(
Indicator == "Delay_stress" ~ "Ambulance\ndelays",
Indicator == "Beds_stress" ~ "Bed\noccupancy",
Indicator == "Closures_stress" ~ "Closures",
Indicator == "Diverts_stress" ~ "Diverts"
))
# levels(sitrep_bar$Rating) = 1:4 # manually set levels so colours appear correctly
# trust_name = sitrep_bar$Name[1]
# radial plot
# note: y is converted to char then int because we want to convert the factor name (rank) to int
ggplot(sitrep_bar, aes(x=Indicator, y=as.integer(as.character(Rating)), fill=Rating)) +
coord_polar() +
geom_col() +
geom_text(aes(y=3.8, label=x_text), size=3) +
ylim(NA, n.bins) +
# get the relevant colours to display (in case this Trust doesn't contain all ranks from 1-4)
#scale_fill_manual(values=rank_cols[as.integer(levels(sitrep_bar$Rating))], name="Stress") +
scale_fill_manual(values=rank_cols, name="Stress", drop=F) +
scale_x_discrete(labels=c("Diverts_stress" = "Diverts", "Delay_stress" = "Ambulance\ndelays",
"Closures_stress" = "Closures", "Beds_stress" = "Bed\noccupancy")) +
theme_light() +
theme(panel.border = element_blank()
,axis.ticks = element_blank()
,axis.title = element_blank()
,axis.text.y = element_blank()
,axis.text.x = element_blank() # element_text(margin = margin(l=1, b = 1))
,legend.text = element_text(size = 8)
,legend.title = element_text(size = 8)
#,legend.position = "bottom"
,legend.direction = "horizontal"
,legend.position = c(0.5, -0.05)
,legend.box.spacing = unit(0, "cm")
,legend.box.margin = margin(0, 0, 0, 0, "cm")
,legend.margin = margin(0, 0, 0, 0, "cm")
,plot.margin = margin(0, 0, 0.55, 0, "cm")
#,plot.background = element_rect(fill="darkseagreen")
)
})
```
```{r labels, message=FALSE, warning=FALSE, include=FALSE}
median_delay30 = median(sitrep$`Delay 30-60 mins`)
median_delay60 = median(sitrep$`Delay >60 mins`)
sitrep$warn_missing = ifelse(sitrep$MissingDataYN,
"<span style='font-weight:bold;color:red'>SOME DATA IS MISSING FOR THIS TRUST</span><br/>", "")
sitrep$hovertext = mapply(
function(Name, warn_missing, StressRank, Beds, Delays30, Delays60, Closures, Diverts) {
htmltools::HTML(sprintf(
"<div style='font-size:12px;width:250px;float:right'>
<span style='font-weight:bold'>%s</span><br/><br/>
%s
<span>BRC stress rating: <span style='font-weight:bold;color:%s'>%s</span></span><br/><br/>
<span>Bed occupancy rate: %s%%</span><br/>
<span>Ambulance delays (30-60 mins): %s (National median: %s)</span><br/>
<span>Ambulance delays (> 60 mins): %s (National median: %s)</span><br/>
<span>A&E closures: %s</span><br/>
<span>A&E diverts: %s</span>
</div>",
Name, warn_missing, rank_cols[StressRank], StressRank, round(Beds * 100, 1),
Delays30, median_delay30, Delays60, median_delay60,
Closures, Diverts
))
},
sitrep$Name, sitrep$warn_missing, sitrep$StressRank, sitrep$`Occupancy rate`,
sitrep$`Delay 30-60 mins`, sitrep$`Delay >60 mins`, sitrep$Closures, sitrep$Diverts
)
```
Showing the NHS situation as of <span style="font-weight:bold">`r sitrep_date_str`</span>.
BRC volunteers are represented by the blue heatmap, with a `r vol_radius / 1000`km radius drawn around each volunteer. The heatmap only shows regular, active Emergency Response and Independent Living volunteers.
The coloured circles outlined in black are NHS England Trusts. The colour of the hospital icons represents [winter pressures facing NHS Trusts](https://www.england.nhs.uk/statistics/statistical-work-areas/winter-daily-sitreps/winter-daily-sitrep-2017-18-data/); these have been summarised on a scale of one to four, where <span style="color:#31a354">one means low/no pressure</span>, <span style="color:#fed976">two means below-average pressure</span>, <span style="color:#fd8d3c">three means moderate pressure</span> and <span style="color:#de2d26">four means high pressure</span>.
This winter pressures scale was derived from four indicators:
- percentage of general and acute beds occupied
- ambulance handover delays (30-60 minutes as well as over one hour) [^1]
- number of A&E unit diverts
- whether or not any A&E units have been closed [^2]
Trusts were ranked into [quartiles](https://en.wikipedia.org/wiki/Quartile) for each of these indicators. If a Trust closed any A&E units or had any ambulance delays of over one hour, they are put into the highest 'stress' category (4) for those indicators.
Click on any NHS Trust to see a breakdown of its winter pressures in terms of bed occupancy, ambulance delays, A&E unit diverts and A&E unit closures.
```{r map, echo=FALSE, message=FALSE, warning=FALSE}
# Create a continuous palette function for hospital marker colours
hospital_pal = colorFactor(
palette = rank_cols,
domain = levels(sitrep$StressRank)
)
leaflet(sitrep, width="100%",
options = leafletOptions(minZoom = 5, maxZoom = 12, attributionControl = T)) %>%
# centre map on Whitendale Hanging Stones, the centre of GB: https://en.wikipedia.org/wiki/Centre_points_of_the_United_Kingdom
setView(lat=54.00366, lng=-2.547855, zoom=6) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
# volunteers heatmap
addWebGLHeatmap(data=vols,
lng=~Longitude, lat=~Latitude, size=as.character(vol_radius), units="m",
opacity=0.6, intensity=0.1, gradientTexture="deep-sea") %>%
# hospitals
addCircleMarkers(data=sitrep,
lng=~Longitude, lat=~Latitude,
# icon=hospital_icon,
fillColor = ~hospital_pal(StressRank), radius=6, fillOpacity=1,
stroke=T, weight=2, color="black",
label = ~Name,
popup = ~paste(
# holder for the two floating divs so they appear side by side nicely
"<div style='height:225px'>",
"<div style='float:left'>",
popupGraph(pops, type = "svg", width = 175, height = 175),
"</div>",
hovertext,
"</div>"
),
popupOptions = popupOptions(maxWidth=600, minWidth = 500))
```
[^1]: Any Trusts with ambulances delayed by more than 60 minutes were given the top stress rating (4).
[^2]: Any A&E unit closures automatically give the top stress rating (4).