Neil Pettinger / John MacKintosh
2018-05-09
Microsoft version available from
library(tidyverse) # a suite of packages with common conventions
library(lubridate) # better handling of dates
library(scales) # easier plot scales
library(readxl) # easy import from Excel
library(hrbrthemes) # custom plot theme
library(extrafont) # loads fonts required for hrbrthemes on Windows
data <- read_xlsx("RedGreenGreyDots.xlsx", sheet = 1)
glimpse(data)
Observations: 684
Variables: 7
$ MovementDateTime <dttm> 2014-09-03 00:01:00, 2014-09-03 00:03:00, 20...
$ FirstName <chr> "MOIRA", "DORIS", "DORIS", "MARGARET", "GEORG...
$ LastName <chr> "MACLEOD", "WALLHEAD", "WALLHEAD", "MILNE", "...
$ Ward_Dept <chr> "A&E", "A&E", "Ward 02 (AMU)", "A&E", "A&E", ...
$ Staging_Post <chr> "A&E", "A&E", "Assessment", "A&E", "A&E", "A&...
$ Movement_Type <chr> "Departure", "Transfer Out", "Transfer In", "...
$ IN_OUT <chr> "OUT", "OUT", "IN", "OUT", "OUT", "OUT", "OUT...
#could also have used str(data)
knitr::kable(head(data))
MovementDateTime | FirstName | LastName | Ward_Dept | Staging_Post | Movement_Type | IN_OUT |
---|---|---|---|---|---|---|
2014-09-03 00:01:00 | MOIRA | MACLEOD | A&E | A&E | Departure | OUT |
2014-09-03 00:03:00 | DORIS | WALLHEAD | A&E | A&E | Transfer Out | OUT |
2014-09-03 00:03:00 | DORIS | WALLHEAD | Ward 02 (AMU) | Assessment | Transfer In | IN |
2014-09-03 00:04:00 | MARGARET | MILNE | A&E | A&E | Departure | OUT |
2014-09-03 00:05:00 | GEORGE | EVANS | A&E | A&E | Departure | OUT |
2014-09-03 00:05:00 | MARJORIE | ROSS | A&E | A&E | Departure | OUT |
plot_data <- data %>%
mutate(Movement15 = lubridate::floor_date(MovementDateTime,"15 minutes")) %>%
group_by(IN_OUT, Movement_Type,Staging_Post,Movement15) %>%
mutate(counter = case_when(
IN_OUT == 'IN' ~ 1,
IN_OUT == 'OUT' ~ -1)) %>%
mutate(Movement_15_SEQNO = cumsum(counter)) %>%
ungroup()
knitr::kable(plot_data[1:6,5:10])
Staging_Post | Movement_Type | IN_OUT | Movement15 | counter | Movement_15_SEQNO |
---|---|---|---|---|---|
A&E | Departure | OUT | 2014-09-03 | -1 | -1 |
A&E | Transfer Out | OUT | 2014-09-03 | -1 | -1 |
Assessment | Transfer In | IN | 2014-09-03 | 1 | 1 |
A&E | Departure | OUT | 2014-09-03 | -1 | -2 |
A&E | Departure | OUT | 2014-09-03 | -1 | -3 |
A&E | Departure | OUT | 2014-09-03 | -1 | -4 |
plot_data$Movement_Type <- gsub("Transfer.*","Transfer",x = plot_data$Movement_Type)
knitr::kable(plot_data[1:6,5:10])
Staging_Post | Movement_Type | IN_OUT | Movement15 | counter | Movement_15_SEQNO |
---|---|---|---|---|---|
A&E | Departure | OUT | 2014-09-03 | -1 | -1 |
A&E | Transfer | OUT | 2014-09-03 | -1 | -1 |
Assessment | Transfer | IN | 2014-09-03 | 1 | 1 |
A&E | Departure | OUT | 2014-09-03 | -1 | -2 |
A&E | Departure | OUT | 2014-09-03 | -1 | -3 |
A&E | Departure | OUT | 2014-09-03 | -1 | -4 |
lims <- as.POSIXct(strptime(
c("2014-09-03 00:00","2014-09-04 01:00"), format = "%Y-%m-%d %H:%M")
)
preparation step - setting axis limits in the correct time date format
ggplot(plot_data,aes(Movement15,Movement_15_SEQNO, colour = Movement_Type)) +
geom_point()
# ggplot is a plotting command
# aes(x,y)
# ggplot guide at:
https://www.johnmackintosh.com/2016-05-26-ggplot-demo/
ggplot(plot_data,aes(Movement15,Movement_15_SEQNO, colour = Movement_Type)) +
geom_jitter(width = 0.10) +
scale_colour_manual(values = c("#D7100D","#40B578","grey60"))
p <- ggplot(plot_data,aes(Movement15,Movement_15_SEQNO, colour = Movement_Type)) +
geom_jitter(width = 0.10) +
scale_colour_manual(values = c("#D7100D","#40B578","grey60")) +
facet_grid(Staging_Post~., switch = "y") +
scale_x_datetime(date_labels = "%H:%M",date_breaks = "3 hours",
limits = lims,
timezone = "UTC",
expand = c(0,0))
p
p <- p + theme_ipsum(base_family = "Arial Narrow") +
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank()) +
theme(axis.text.x = element_text(size = 7)) +
theme(axis.ticks.x = element_blank()) +
theme(legend.position = "bottom") +
theme(panel.grid.minor = element_blank(),
panel.grid.major = element_blank()) +
theme(strip.text.y = element_text(angle = 180)) +
guides(color = guide_legend("Movement Type")) +
ggtitle(label = "Anytown General Hospital | Wednesday 3rd September 2014 00:00 to 23:59\n",
subtitle = "A&E AND INPATIENT ARRIVALS, DEPARTURES AND TRANSFERS") +
labs(x = NULL, y = NULL)
p
library(gganimate)
ggplot(plot_data,aes(Movement15,Movement_15_SEQNO, colour=Movement_Type,
frame = Movement15,cumulative = TRUE))+
geom_jitter(width=0.10) +
#### additional code as before
Similar code but using gganimate package and providing “frame” and “cumulative” arguments
ggplot(plot_data,aes(Movement15,Movement_15_SEQNO, colour=Movement_Type))+
geom_jitter(width=0.05)+
scale_colour_manual(values=c("red","green","grey60"))+
facet_wrap(~Ward_Dept, ncol = 3)+
scale_x_datetime(date_labels="%H:%M",date_breaks = "3 hours",
limits = lims,
timezone = Sys.timezone(),
expand = c(0,0)) +
### additional formatting code