How to project the future trajectory of the outbreak?
Published
November 1, 2024
Ingredients
Project the future daily incidence based of past incidence, a selection of plausible basic reproduction numbers, and the distribution of the serial interval, using the {projections} package.
Get the basic reproductive number from the growth rate, given a generation time distribution, using the {epitrix} package.
Use the serial interval time as proxy of the generation time.
Use the serial interval distribution parameters of Ebola Virus Disease estimated from the WHO Ebola Response Team in 2015.
Use the linelist from the Simulated Ebola outbreak ebola_sim_clean object from the {outbreaks} R package.
Keep the first 48 weeks as period of analysis.
Use the date of onset column to calculate the daily growth rate.
Steps in code
# Project the future trajectory of the outbreak# Load required packageslibrary(outbreaks)library(incidence2)library(i2extras)library(epiparameter)library(distcrete)library(epitrix)library(projections)library(tidyverse)# Load the simulated Ebola outbreak datadata(ebola_sim_clean)# Extract the first element of the listlinelist <- ebola_sim_clean$linelist# Convert the data to an incidence2 objectincidence2_data <- incidence2::incidence(x = linelist, date_index ="date_of_onset",interval ="day" )# Filter the incidence2 object to keep the first 48 weeks. incidence2_filter <- incidence2_data[1:48,]# Convert the filtered incidence2 object to an incidence objectincidence1_filter <- incidence2_filter %>% tidyr::uncount(count) %>% dplyr::pull(date_index) %>% incidence::incidence()# Model the incidenceincidence2_fit <- i2extras::fit_curve(x = incidence2_filter,model ="poisson",alpha =0.05 )# Extract parameter by disease, distribution, authorepidist_ebola_si <- epiparameter::epiparameter_db(disease ="Ebola",epi_name ="serial_interval",single_epiparameter =TRUE )# Read epidist class object# Read distribution: gammaepidist_ebola_si#> Disease: Ebola Virus Disease#> Pathogen: Ebola Virus#> Epi Parameter: serial interval#> Study: WHO Ebola Response Team, Agua-Agum J, Ariyarajah A, Aylward B, Blake I,#> Brennan R, Cori A, Donnelly C, Dorigatti I, Dye C, Eckmanns T, Ferguson#> N, Formenty P, Fraser C, Garcia E, Garske T, Hinsley W, Holmes D,#> Hugonnet S, Iyengar S, Jombart T, Krishnan R, Meijers S, Mills H,#> Mohamed Y, Nedjati-Gilani G, Newton E, Nouvellet P, Pelletier L,#> Perkins D, Riley S, Sagrado M, Schnitzler J, Schumacher D, Shah A, Van#> Kerkhove M, Varsaneux O, Kannangarage N (2015). "West African Ebola#> Epidemic after One Year — Slowing but Not Yet under Control." _The New#> England Journal of Medicine_. doi:10.1056/NEJMc1414992#> <https://doi.org/10.1056/NEJMc1414992>.#> Distribution: gamma#> Parameters:#> shape: 2.188#> scale: 6.490# Discretise the distributiondiscrete_ebola_si <- epiparameter::discretise(epidist_ebola_si)# Now read distribution: discrete gammadiscrete_ebola_si#> Disease: Ebola Virus Disease#> Pathogen: Ebola Virus#> Epi Parameter: serial interval#> Study: WHO Ebola Response Team, Agua-Agum J, Ariyarajah A, Aylward B, Blake I,#> Brennan R, Cori A, Donnelly C, Dorigatti I, Dye C, Eckmanns T, Ferguson#> N, Formenty P, Fraser C, Garcia E, Garske T, Hinsley W, Holmes D,#> Hugonnet S, Iyengar S, Jombart T, Krishnan R, Meijers S, Mills H,#> Mohamed Y, Nedjati-Gilani G, Newton E, Nouvellet P, Pelletier L,#> Perkins D, Riley S, Sagrado M, Schnitzler J, Schumacher D, Shah A, Van#> Kerkhove M, Varsaneux O, Kannangarage N (2015). "West African Ebola#> Epidemic after One Year — Slowing but Not Yet under Control." _The New#> England Journal of Medicine_. doi:10.1056/NEJMc1414992#> <https://doi.org/10.1056/NEJMc1414992>.#> Distribution: discrete gamma#> Parameters:#> shape: 2.188#> scale: 6.490# Transform from 'epidist' class to 'distcrete' class objectdistcrete_ebola_si <- distcrete::distcrete(name ="gamma",shape = discrete_ebola_si$prob_dist$parameters$shape,scale = discrete_ebola_si$prob_dist$parameters$scale,interval = discrete_ebola_si$prob_dist$interval,w = discrete_ebola_si$prob_dist$w )# Read distcrete class objectdistcrete_ebola_si#> A discrete distribution#> name: gamma#> parameters:#> shape: 2.18793402777778#> scale: 6.49014084507042# Transform growth rate into reproductive numberreproductive_basic <- epitrix::lm2R0_sample(x = incidence2_fit %>%pull(model) %>%pluck(1),w = discrete_ebola_si$prob_dist,n =500 )# Write function to sample replicates of reproductive numbersample_function <-function(x = reproductive_basic, n_sim =1000){ mu <-mean(x) sigma <-sd(x) shape_scale <- epitrix::gamma_mucv2shapescale(mu = mu, cv = sigma / mu ) sample_result <-rgamma(n = n_sim, shape = shape_scale$shape, scale = shape_scale$scale )return(sample_result) }# Run function to sample replicates of reproductive numberreproductive_basic_sample <-sample_function(x = reproductive_basic,n_sim =1000 )# Plot the sample distribution# hist(reproductive_basic_sample)# Project the future incidence # from incidence object and sample of basic reproductive numberincidence1_projection <- projections::project(x = incidence1_filter, R = reproductive_basic_sample,si = distcrete_ebola_si, n_sim =1000, n_days =14, R_fix_within =TRUE )# Plot the incidence object with the projectionincidence1_filter %>%plot() %>%add_projections(x = incidence1_projection,quantiles =c(0.025, 0.5, 0.975) )