Data Transitions: visualising and animating patient flow

Neil Pettinger / John MacKintosh
2018-05-09

What is R?

plot of chunk unnamed-chunk-1

How does it compare to Excel?

plot of chunk unnamed-chunk-2plot of chunk unnamed-chunk-2

  • open source - free to use
  • 1000 functions in base installation
  • several updates to base installation per year
  • 12000 + user contributed packages
  • machine learning, mapping, medical imaging

2014 - Rows of Dots

plot of chunk unnamed-chunk-3

But can you tell me about what that original plot sought to demonstrate? Response 1 I can’t remember exactly where rows of dots came from but when I first experimented with them I just had two horizontal rows on a 24-hour timeline. Red arrivals were the top line. Blue departures were the line below.

2017 Red, Green and Grey Dots

plot of chunk unnamed-chunk-4

The original plot then became more sophisticated Can you talk through the evolution of this plot and the underlying theories and perspectives that drove this?

Excel Method : 1

plot of chunk unnamed-chunk-5

Excel Method : 2

plot of chunk unnamed-chunk-6

Excel Output

plot of chunk unnamed-chunk-7

How can we do this in R?

plot of chunk unnamed-chunk-8

4 stage process

  • load the packages we need
  • import the data from Excel
  • transform the data
  • create the plot

Load the required packages

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

Import the data

data <- read_xlsx("RedGreenGreyDots.xlsx", sheet = 1)

Check the data was imported correctly

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)

View the 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

Transform the data using dplyr package

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

Simplify the Movement Type field

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

Step 4 - Create the plot

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

Initial basic plot using ggplot2 package

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/

output 1

plot of chunk unnamed-chunk-18

Manually specify colours

ggplot(plot_data,aes(Movement15,Movement_15_SEQNO, colour = Movement_Type)) +
  geom_jitter(width = 0.10) +
  scale_colour_manual(values = c("#D7100D","#40B578","grey60"))

output 2

plot of chunk unnamed-chunk-20

Create small multiple

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

output 3

plot of chunk unnamed-chunk-22

themes, formatting and labels

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

final plot

plot of chunk unnamed-chunk-24

Animated version

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

Animated plot

Faceted by Ward

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

Animated facet by ward

Animated LOS