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 packages
library(outbreaks)
library(incidence2)
library(i2extras)
library(epiparameter)
library(distcrete)
library(epitrix)
library(projections)
library(tidyverse)

# Load the simulated Ebola outbreak data
data(ebola_sim_clean)

# Extract the first element of the list
linelist <- ebola_sim_clean$linelist

# Convert the data to an incidence2 object
incidence2_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 object
incidence1_filter <- 
  incidence2_filter %>% 
  tidyr::uncount(count) %>% 
  dplyr::pull(date_index) %>% 
  incidence::incidence()

# Model the incidence
incidence2_fit <- 
  i2extras::fit_curve(
    x = incidence2_filter,
    model = "poisson",
    alpha = 0.05
  )

# Extract parameter by disease, distribution, author
epidist_ebola_si <- 
  epiparameter::epiparameter_db(
    disease = "Ebola",
    epi_name = "serial_interval",
    single_epiparameter = TRUE
    )

# Read epidist class object
# Read distribution: gamma
epidist_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 distribution
discrete_ebola_si <- epiparameter::discretise(epidist_ebola_si)

# Now read distribution: discrete gamma
discrete_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 object
distcrete_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 object
distcrete_ebola_si
#> A discrete distribution
#>   name: gamma
#>   parameters:
#>     shape: 2.18793402777778
#>     scale: 6.49014084507042

# Transform growth rate into reproductive number
reproductive_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 number
sample_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 number
reproductive_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 number
incidence1_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 projection
incidence1_filter %>% 
  plot() %>% 
  add_projections(
    x = incidence1_projection,
    quantiles = c(0.025, 0.5, 0.975)
  )

Steps in detail

  • (pending)