outbreak_animation.R

# script to demonstrate outbreak animation with a subset of mers_korea_2015 data

# must install github release of threejs package

# devtools::install_github("bwlewis/rthreejs")
library(threejs)
library(outbreaks)
library(dplyr)

# use dplyr to subset results to only include hospital visit exposure

# prep edge attributes
hospvisit <- 
  mers_korea_2015$contacts %>%
  filter(exposure == "Visit hospital") %>%
  select(from,to)

# prep node attributes
hospvisitll <-
  mers_korea_2015$linelist %>%
  filter(id %in% hospvisit$from | id %in% hospvisit$to) %>%
  select(id)

# create graph object from data frame
g <- graph_from_data_frame(hospvisit, vertices = hospvisitll)

# remove edges from graph
gnoe <- g - edges(1:ecount(g))

# make list of graphs
graph_list <- list(gnoe,
                   gnoe + edge(ends(g, es = E(g), names = FALSE)[1,]), 
                   gnoe + edge(ends(g, es = E(g), names = FALSE)[1,]) + edge(ends(g, es = E(g), names = FALSE)[2,]),
                   gnoe + edge(ends(g, es = E(g), names = FALSE)[1,]) + edge(ends(g, es = E(g), names = FALSE)[2,]) +  edge(ends(g, es = E(g), names = FALSE)[3,]),
                   gnoe + edge(ends(g, es = E(g), names = FALSE)[1,]) + edge(ends(g, es = E(g), names = FALSE)[2,]) +  edge(ends(g, es = E(g), names = FALSE)[3,]) + edge(ends(g, es = E(g), names = FALSE)[4,]),
                   gnoe + edge(ends(g, es = E(g), names = FALSE)[1,]) + edge(ends(g, es = E(g), names = FALSE)[2,]) +  edge(ends(g, es = E(g), names = FALSE)[3,]) + edge(ends(g, es = E(g), names = FALSE)[4,]) + edge(ends(g, es = E(g), names = FALSE)[5,]),
                   gnoe + edge(ends(g, es = E(g), names = FALSE)[1,]) + edge(ends(g, es = E(g), names = FALSE)[2,]) +  edge(ends(g, es = E(g), names = FALSE)[3,]) + edge(ends(g, es = E(g), names = FALSE)[4,]) + edge(ends(g, es = E(g), names = FALSE)[5,]) + edge(ends(g, es = E(g), names = FALSE)[6,]),
                   gnoe + edge(ends(g, es = E(g), names = FALSE)[1,]) + edge(ends(g, es = E(g), names = FALSE)[2,]) +  edge(ends(g, es = E(g), names = FALSE)[3,]) + edge(ends(g, es = E(g), names = FALSE)[4,]) + edge(ends(g, es = E(g), names = FALSE)[5,]) + edge(ends(g, es = E(g), names = FALSE)[6,]) + edge(ends(g, es = E(g), names = FALSE)[7,]),
                   gnoe + edge(ends(g, es = E(g), names = FALSE)[1,]) + edge(ends(g, es = E(g), names = FALSE)[2,]) +  edge(ends(g, es = E(g), names = FALSE)[3,]) + edge(ends(g, es = E(g), names = FALSE)[4,]) + edge(ends(g, es = E(g), names = FALSE)[5,]) + edge(ends(g, es = E(g), names = FALSE)[6,]) + edge(ends(g, es = E(g), names = FALSE)[7,]) + edge(ends(g, es = E(g), names = FALSE)[8,]),
                   gnoe + edge(ends(g, es = E(g), names = FALSE)[1,]) + edge(ends(g, es = E(g), names = FALSE)[2,]) +  edge(ends(g, es = E(g), names = FALSE)[3,]) + edge(ends(g, es = E(g), names = FALSE)[4,]) + edge(ends(g, es = E(g), names = FALSE)[5,]) + edge(ends(g, es = E(g), names = FALSE)[6,]) + edge(ends(g, es = E(g), names = FALSE)[7,]) + edge(ends(g, es = E(g), names = FALSE)[8,]) + edge(ends(g, es = E(g), names = FALSE)[9,]), 
                   gnoe + edge(ends(g, es = E(g), names = FALSE)[1,]) + edge(ends(g, es = E(g), names = FALSE)[2,]) +  edge(ends(g, es = E(g), names = FALSE)[3,]) + edge(ends(g, es = E(g), names = FALSE)[4,]) + edge(ends(g, es = E(g), names = FALSE)[5,]) + edge(ends(g, es = E(g), names = FALSE)[6,]) + edge(ends(g, es = E(g), names = FALSE)[7,]) + edge(ends(g, es = E(g), names = FALSE)[8,]) + edge(ends(g, es = E(g), names = FALSE)[9,]) + edge(ends(g, es = E(g), names = FALSE)[10,]),
                   gnoe + edge(ends(g, es = E(g), names = FALSE)[1,]) + edge(ends(g, es = E(g), names = FALSE)[2,]) +  edge(ends(g, es = E(g), names = FALSE)[3,]) + edge(ends(g, es = E(g), names = FALSE)[4,]) + edge(ends(g, es = E(g), names = FALSE)[5,]) + edge(ends(g, es = E(g), names = FALSE)[6,]) + edge(ends(g, es = E(g), names = FALSE)[7,]) + edge(ends(g, es = E(g), names = FALSE)[8,]) + edge(ends(g, es = E(g), names = FALSE)[9,]) + edge(ends(g, es = E(g), names = FALSE)[10,]) + edge(ends(g, es = E(g), names = FALSE)[11,]),
                   gnoe + edge(ends(g, es = E(g), names = FALSE)[1,]) + edge(ends(g, es = E(g), names = FALSE)[2,]) +  edge(ends(g, es = E(g), names = FALSE)[3,]) + edge(ends(g, es = E(g), names = FALSE)[4,]) + edge(ends(g, es = E(g), names = FALSE)[5,]) + edge(ends(g, es = E(g), names = FALSE)[6,]) + edge(ends(g, es = E(g), names = FALSE)[7,]) + edge(ends(g, es = E(g), names = FALSE)[8,]) + edge(ends(g, es = E(g), names = FALSE)[9,]) + edge(ends(g, es = E(g), names = FALSE)[10,]) + edge(ends(g, es = E(g), names = FALSE)[11,]) + edge(ends(g, es = E(g), names = FALSE)[12,])
)

# plot graphs                   
graphjs(graph_list,
        vertex.shape="sphere", 
        vertex.label = names(V(gnoe)),
        edge.width=3)