How to project the future trajectory of the outbreak?
Published
March 26, 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::epiparam() %>%filter(str_detect(disease,"Ebola")) %>%filter(epi_distribution =="serial_interval") %>%filter(region =="West Africa") %>%filter(author =="WHO_Ebola_Response_Team") %>%filter(year ==2015) %>% epiparameter::as_epidist()# Read epidist class object# Read distribution: gammaepidist_ebola_si
Disease: Ebola Virus Disease
Pathogen: Ebola Virus
Epi Distribution: serial interval
Study: WHO, Ebola, Response, Team (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 Distribution: serial interval
Study: WHO, Ebola, Response, Team (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 distributionhist(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) )