-
Notifications
You must be signed in to change notification settings - Fork 0
/
winterpressures-services.Rmd
261 lines (212 loc) · 11.4 KB
/
winterpressures-services.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
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
---
title: "NHS Winter Pressures - with BRC's Independent Living volunteers and services"
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)
library(rgdal)
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 load_services, message=FALSE, warning=FALSE, include=FALSE}
services = read_csv(file.path(data.dir, services.dir, "IL services England.csv")) %>%
replace_na(list(Hospitals = ""))
# make a nice icon for showing services on the map
service_icon = awesomeIcons(
icon = 'fa-plus',
iconColor = 'red',
library = 'fa',
markerColor = "white",
squareMarker = T
)
```
```{r load_boundaries, message=FALSE, warning=FALSE, include=FALSE}
# load community connector boundaries - run `process community connectors.r` first if needed
pc_districts = readRDS(file.path(data.dir, services.dir, "CC boundaries.rds"))
```
```{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.
Independent Living services are shown by the red crosses. Click on a service for more information. Note that we don't have location information for `r sum(is.na(services$Postcode))` of the `r nrow(services)` and so they cannot be shown on the map. Purple patches show the locations of our Community Connector services. (Northern Ireland and Isle of Man areas extend into the sea because of different ways the boundaries were defined.)
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. Tick the "IL Services" box in the top-right corner of the map to see our Independent Living services. Click  to view the map fullscreen.
```{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%", height="800",
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) %>%
addFullscreenControl() %>%
# volunteers heatmap
# this needs to be the first thing drawn, otherwise users can't click on the hospital markers
addWebGLHeatmap(data=vols,
lng=~Longitude, lat=~Latitude, size=as.character(vol_radius), units="m",
opacity=0.6, intensity=0.1, gradientTexture="deep-sea",
group="Volunteers") %>%
# community connector areas
addPolygons(data=pc_districts,
stroke = FALSE, smoothFactor = 0.3, fillOpacity = 0.3,
fillColor = "blue",
group = "Community Connector Services",
highlightOptions = highlightOptions(bringToFront=F, sendToBack=T)) %>%
# IL services
addAwesomeMarkers(data=services,
lng=~Longitude, lat=~Latitude, icon=service_icon,
popup = ~paste0("Service: ", Name, "<br/>",
"Type: ", Type, "<br/>",
"Category: ", Category, "<br/>",
"Hospitals working in: ", Hospitals),
group="IL Services") %>%
# 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),
group = "NHS Trusts") %>%
addLayersControl(
overlayGroups = c("IL Services", "Community Connector Services"),
options = layersControlOptions(collapsed = FALSE, autoZIndex = TRUE)
) %>%
hideGroup("IL Services")
```
[^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).