## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", message = FALSE, warning = FALSE, out.width = "100%", fig.height = 7, dpi = 300 ) ## ----setup-------------------------------------------------------------------- library(outbreaker2) library(o2ools) ## ----inputs------------------------------------------------------------------- # The input data head(linelist) # outbreaker2 result out ## ----------------------------------------------------------------------------- out_id <- identify(out, ids = linelist$name) head(out_id) ## ----------------------------------------------------------------------------- trees <- get_trees(out_id, kappa = TRUE, t_inf = TRUE, group = linelist$group) #100th sample head(trees[[100]]) ## ----------------------------------------------------------------------------- true_tree <- data.frame( from = as.character(outbreaker2::fake_outbreak$ances), to = linelist$id, stringsAsFactors = FALSE ) accuracy <- get_accuracy(out, true_tree) hist(accuracy) ## ----------------------------------------------------------------------------- entropy <- get_entropy(out_id) barplot( entropy, horiz = TRUE, las = 1 ) ## ----------------------------------------------------------------------------- # augment linelist with summaries of t_inf and kappa o2linelist <- augment_linelist( out, linelist, params = c("t_inf","kappa"), summary_fns = list( mean = function(x) mean(x, na.rm = TRUE), q25 = function(x) quantile(x, .25, na.rm = TRUE), q75 = function(x) quantile(x, .75, na.rm = TRUE) ) ) head(o2linelist) ## ----------------------------------------------------------------------------- consensus_tree <- get_consensus(out) head(consensus_tree) ## ----------------------------------------------------------------------------- library(epicontacts) epi <- make_epicontacts( linelist = o2linelist, contacts = subset(consensus_tree, !is.na(from)), #remove NA edges (i.e. imports) directed = TRUE ) # plot(epi) basic plot # colour setting epi$linelist$group <- factor(epi$linelist$group, levels = c("hcw", "patient")) my_pal <- function(n) { c("orange", "purple")[1:n] } vis_epicontacts( epi, thin = FALSE, #show imports label = "name", node_shape = "group", shapes = c("hcw" = "user-md", "patient" = "bed"), # https://fontawesome.com/v4/icons/ node_color = "group", edge_arrow = "to", col_pal = my_pal, edge_col_pal = my_pal, ) ## ----------------------------------------------------------------------------- library(igraph) library(tidygraph) library(ggraph) g <- epicontacts:::as.igraph.epicontacts(epi) |> as_tbl_graph() layout_data <- create_layout(g, layout = 'kk') layout_data$x <- layout_data$onset p <- ggraph(layout_data)+ geom_edge_link( aes( edge_width = frequency, color = .N()$group[from] # .N() to accesses node data ), arrow = arrow(length = unit(2.5, 'mm')), end_cap = circle(3, 'mm') ) + geom_node_point( aes(fill = group), shape = 21, colour = "black", size = 5 ) + geom_node_text( aes(label = epicontacts_name), repel = TRUE, size = 3, nudge_y = 0.1, bg.color = "white", bg.r = 0.1 ) + scale_edge_width("Posterior support", range = c(0.1, 1), breaks = c(0.8, 0.9, 1)) + scale_fill_manual( "", values = c("hcw" = "orange", "patient" = "purple"), breaks = c("hcw", "patient") ) + scale_edge_colour_manual( "", values = c("hcw" = "orange", "patient" = "purple"), breaks = c("hcw", "patient") )+ theme_bw() + labs(x = "Onset date", y = "")+ theme( axis.line.y = element_blank(), axis.text.y = element_blank(), axis.ticks.y = element_blank(), panel.grid.major.y = element_blank(), panel.grid.minor.y = element_blank(), legend.position = "bottom" ) print(p) ## ----------------------------------------------------------------------------- max_post <- trees[[which.max(out$post)]] #Same as before, create and plot an epicontacts object epi <- make_epicontacts( linelist = o2linelist, contacts = subset(max_post, !is.na(from)), #remove NA edges (i.e. imports) directed = TRUE ) ## ----------------------------------------------------------------------------- out_direct <- filter_chain(out, param = "kappa", thresh = 1, comparator = "==", target = "alpha")