library(knitr) opts_chunk$set(cache.path='~/.vignette_cache/', echo = FALSE, message=FALSE, warning = FALSE, autodep=TRUE, cache = TRUE) library(knitcitations) cite_options(citation_format = 'pandoc') P <- rprojroot::find_rstudio_root_file source(P("R/summarizing_functions.R"))
Model after r citep('10.1371/journal.pone.0080091')
.
library(metaflu) library(ggplot2) library(dplyr) library(doMC) library(tidyr)
get_outputs <- function(funcname, matrow){ print(paste("Starting",matrow[1],"by",matrow[2],"simulation.")) results <- do.call(funcname, list(matrow[1], matrow[2])) duration <- get_duration(results) lower_d <- quantile(unlist(duration$days_greater), probs = c(0.025)) upper_d <- quantile(unlist(duration$days_greater), probs = c(0.975)) median_d <- quantile(unlist(duration$days_greater), probs = c(0.5)) failure <- proportion_failed(get_failure(results)) abundance <- get_tot_infections(results) lower_a <- quantile(unlist(abundance$total_i), probs = c(0.025)) upper_a <- quantile(unlist(abundance$total_i), probs = c(0.975)) median_a <- quantile(unlist(abundance$total_i), probs = c(0.5)) df <- data.frame(failure, lower_d, median_d, upper_d, lower_a, median_a, upper_a) df }
set.seed(17) fig2 <- function(farm_size, farm_number){ initial_cond <- matrix(c(farm_size, 0, 0, 0), nrow=farm_number, ncol=4, byrow=TRUE) infected_patches <- sample(seq_len(nrow(initial_cond)), 2) initial_cond[infected_patches, 2] <- 1 initial_cond[infected_patches, 1] <- initial_cond[infected_patches, 1] - 1 fig2parms = list( beta = 0.004, #contact rate for direct transmission gamma = 0.167, #recovery rate mu = 0, #base mortality rate alpha = 0.1111, #disease mortality rate phi = 0, #infectiousness of environmental virions eta = 0, #degradation rate of environmental virions nu = 0.00, #uptake rate of environmental virion sigma = 0, #virion shedding rate omega = 0.03, #movement rate rho = 0, #contact nonlinearity 0=dens-dependent, 1=freq-dependent lambda = 0, #force of infection from external sources tau_crit = 0, #critical suveillance time I_crit = 0, #threshold for reporting pi_report = .0, #reporting probability pi_detect = .0, #detection probability chi = make_net(network_type = "smallworld", network_parms = list(dim = 1, size = farm_number, nei = 2.33, p = 0.0596, multiple = FALSE, loops = FALSE)), stochastic_network = TRUE ) x <- mf_sim(init = initial_cond, parameters = fig2parms, times=0:1000, n_sims = 100) x } registerDoMC(cores=34) recreate_data <- function(funcname){ a <- c(40,50,64,80,100,125,160,200,256,320,400,500,640,800) parMat <- cbind(a, rev(a)) results <- apply(parMat, 1, function(x) get_outputs(funcname,x)) results } fig2results <- bind_rows(recreate_data("fig2")) saveRDS(fig2results, "fig2results.rds") #full_recreate_data <- function(funcname){ # a <- c(5,8,10,16,20,25,32,40,50,64,80,100,125,160,200,256,320,400,500,640,800,1000,1280,1600,2000,3200,4000,6400) # parMat <- cbind(a, rev(a)) # results <- apply(parMat, 1, function(x) get_outputs(funcname, x)) # results #} #fullfig2results <- bind_rows(full_recreate_data("fig2"))
ggplot(data = fig2results) + geom_line(aes(x = seq_along(failure), y = failure)) + scale_x_continuous(breaks = seq_along(fig2results$failure), name = "Chickens:Farm", labels = c("40:800", "50:640", "64:500", "80:400","100:320", "125:256", "160:200","200:160","256:125","320:100","400:80", "500:64", "640:50", "800:40")) + scale_y_continuous(name = "Proportion of Epidemic Failures") + theme_bw() + theme(axis.text.x = element_text(angle = 90, hjust = 1))
The above figure is a recreation of the top graph of Figure 2, showing the 'probability' that an epidemic will fail using their model; in this context "epidemic failure" is a run where the epidemic does not propagate an originally seeded patch to any other patch. Our model shows roughly the same behavior as the published paper, with epidemic failure becoming less likely as we increase the size of farms.
ggplot(data = fig2results) + geom_line(aes(x = seq_along(median_d), y = median_d)) + geom_line(aes(x = seq_along(lower_d), y = lower_d), linetype = "dashed") + geom_line(aes(x = seq_along(upper_d), y = upper_d), linetype = "dashed") + scale_x_continuous(breaks = seq_along(fig2results$failure), name = "Chickens:Farm", labels = c("40:800", "50:640", "64:500", "80:400","100:320", "125:256", "160:200","200:160","256:125","320:100","400:80", "500:64", "640:50", "800:40")) + scale_y_continuous(name = "Median Duration (days)") + theme_bw() + theme(axis.text.x = element_text(angle = 90, hjust = 1))
This graph is a recreation of the middle graph in Figure 2, and shows the median length of the epidemic in days, along with the 95% bootstrapped interval in dashed lines. This graph is considerably different from the published results, with epidemics that last far shorter and simulations with a much lower 97.5% quantile. Although Figure 2 includes environmental transmission, Figure S8 does not, and still reports a median duration in the 300/500 range for these Chickens:Farm combinations. '
ggplot(data = fig2results) + geom_line(aes(x = seq_along(median_a), y = median_a)) + geom_line(aes(x = seq_along(lower_a), y = lower_a), linetype = "dashed") + geom_line(aes(x = seq_along(upper_a), y = upper_a), linetype = "dashed") + scale_x_continuous(breaks = seq_along(fig2results$failure), name = "Chickens:Farm", labels = c("40:800", "50:640", "64:500", "80:400","100:320", "125:256", "160:200","200:160","256:125","320:100","400:80", "500:64", "640:50", "800:40")) + scale_y_continuous(name = "Number of Infections") + theme_bw() + theme(axis.text.x = element_text(angle = 90, hjust = 1))
The above graph shows the median total number of infections as we alter the number of chickens and number of farms. The fact that it looks a bit like the graph of a binary variable reflects the fact that the results of each run at each combination of chickens/farms either propagate to nearly the entire population (~32000) or barely propagate at all (~5-15 infections).
write.bibtex(file="references.bib")
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.