Merge pull request #270 from mrc-ide/feat/time_boosters

Implement time varying coverage for PEV boosters:

R/correlation.R

@@ -139,7 +139,7 @@ CorrelationParameters <- R6::R6Class(
 #'   min_wait = 0,
 #'   min_ages = 100,
 #'   max_ages = 1000,
-#'   booster_timestep = numeric(0),
+#'   booster_spacing = numeric(0),
 #'   booster_coverage = numeric(0),
 #'   booster_profile = NULL
 #' )

R/events.R

@@ -18,7 +18,7 @@ create_events <- function(parameters) {
       function(.) individual::TargetedEvent$new(parameters$human_population)
     )
     mass_pev_boosters <- lapply(
-      seq_along(parameters$mass_pev_booster_timestep),
+      seq_along(parameters$mass_pev_booster_spacing),
       function(.) individual::TargetedEvent$new(parameters$human_population)
     )
     events$mass_pev <- individual::Event$new()
@@ -33,7 +33,7 @@ create_events <- function(parameters) {
       function(.) individual::TargetedEvent$new(parameters$human_population)
     )
     pev_epi_boosters <- lapply(
-      seq_along(parameters$pev_epi_booster_timestep),
+      seq_along(parameters$pev_epi_booster_spacing),
       function(.) individual::TargetedEvent$new(parameters$human_population)
     )
     events$pev_epi_doses <- pev_epi_doses
@@ -129,9 +129,10 @@ attach_event_listeners <- function(
     attach_pev_dose_listeners(
       variables,
       parameters,
+      parameters$mass_pev_timesteps,
       events$mass_pev_doses,
       events$mass_pev_boosters,
-      parameters$mass_pev_booster_timestep,
+      parameters$mass_pev_booster_spacing,
       parameters$mass_pev_booster_coverage,
       parameters$mass_pev_profile_indices,
       'mass',
@@ -143,9 +144,10 @@ attach_event_listeners <- function(
     attach_pev_dose_listeners(
       variables,
       parameters,
+      parameters$pev_epi_timesteps,
       events$pev_epi_doses,
       events$pev_epi_boosters,
-      parameters$pev_epi_booster_timestep,
+      parameters$pev_epi_booster_spacing,
       parameters$pev_epi_booster_coverage,
       parameters$pev_epi_profile_indices,
       'epi',

R/pev.R

@@ -179,6 +179,7 @@ create_pev_efficacy_listener <- function(variables, pev_profile_index) {
 create_pev_booster_listener <- function(
   variables,
   coverage,
+  pev_distribution_timesteps,
   booster_number,
   pev_profile_index,
   next_booster_event,
@@ -192,7 +193,11 @@ create_pev_booster_listener <- function(
   force(next_booster_delay)
   force(coverage)
   function(timestep, target) {
-    target <- sample_bitset(target, coverage)
+    cov_t <- coverage[
+      match_timestep(pev_distribution_timesteps, timestep),
+      booster_number
+    ]
+    target <- sample_bitset(target, cov_t)
     variables$last_pev_timestep$queue_update(timestep, target)
     variables$last_eff_pev_timestep$queue_update(timestep, target)
     variables$pev_profile$queue_update(pev_profile_index, target)
@@ -236,6 +241,7 @@ create_dosage_renderer <- function(renderer, strategy, dose) {
 attach_pev_dose_listeners <- function(
   variables,
   parameters,
+  pev_distribution_timesteps,
   dose_events,
   booster_events,
   booster_delays,
@@ -302,7 +308,8 @@ attach_pev_dose_listeners <- function(
     booster_events[[b]]$add_listener(
       create_pev_booster_listener(
         variables = variables,
-        coverage = booster_coverages[[b]],
+        coverage = booster_coverages,
+        pev_distribution_timesteps = pev_distribution_timesteps,
         booster_number = b,
         pev_profile_index = pev_profile_indices[[b + 1]],
         next_booster_event = next_booster_event,

R/pev_parameters.R

@@ -62,7 +62,7 @@ rtss_booster_profile <- create_pev_profile(
 #' age. Efficacy will take effect after the last dose
 #'
 #' @param parameters a list of parameters to modify
-#' @param profile primary vaccine profile of type PEVProfile
+#' @param profile a list of details for the vaccine profile, create with `create_pev_profile`
 #' @param coverages a vector of coverages for the primary doses
 #' @param timesteps a vector of timesteps associated with coverages
 #' @param age the age when an individual will receive the first dose of the
@@ -72,12 +72,11 @@ rtss_booster_profile <- create_pev_profile(
 #' between an individual receiving the final dose and the first booster. When using
 #' both set_mass_pev and set_pev_epi, this represents the minimum time between
 #' an individual being vaccinated under one scheme and vaccinated under another.
-#' @param booster_timestep the timesteps (following the final dose) at which booster vaccinations are administered
-#' @param booster_coverage the proportion of the vaccinated population relative to the last vaccination (whether a previous booster or the primary series)
-#' @param booster_profile list of booster vaccine profiles, of type
-#' PEVProfile, for each timestep in booster_timeteps
+#' @param booster_spacing the timesteps (following the final primary dose) at which booster vaccinations are administered
+#' @param booster_coverage a matrix of coverages (timesteps x boosters) specifying the proportion the previously vaccinated population to continue receiving booster doses. The rows of the matrix must be the same size as `timesteps`. The columns of the matrix must be the same size as `booster_spacing`.
+#' @param booster_profile list of lists representing each booster profile, the outer list must be the same length as `booster_spacing`. Create vaccine profiles with `create_pev_profile`
 #' @param seasonal_boosters logical, if TRUE the first booster timestep is
-#' relative to the start of the year, otherwise they are relative to the last dose
+#' relative to the start of the year, otherwise they are relative to the last primary dose
 #' @export
 set_pev_epi <- function(
   parameters,
@@ -86,33 +85,47 @@ set_pev_epi <- function(
   timesteps,
   age,
   min_wait,
-  booster_timestep,
+  booster_spacing,
   booster_coverage,
   booster_profile,
   seasonal_boosters = FALSE
   ) {
   stopifnot(all(coverages >= 0) && all(coverages <= 1))
+  stopifnot(is.matrix(booster_coverage))
 
   # Check that the primary timing parameters make sense
   if(length(coverages) != length(timesteps)){
     stop("coverages and timesteps must align")
   }
 
+  # Check that booster_spacing are monotonically increasing
+  if (length(booster_spacing) > 1) {
+    if (!all(diff(booster_spacing) > 0)) {
+      stop('booster_spacing must be monotonically increasing')
+    }
+  }
+
   # Check that seasonal booster parameters make sense
   stopifnot(min_wait >= 0)
   stopifnot(age >= 0)
   stopifnot(is.logical(seasonal_boosters))
   if (seasonal_boosters) {
-    if(booster_timestep[[1]] < 0) {
-      booster_timestep <- booster_timestep + 365
+    if(booster_spacing[[1]] < 0) {
+      booster_spacing <- booster_spacing + 365
     }
   }
 
   # Check that the booster timing parameters make sense
-  stopifnot((length(booster_timestep) == 0) || all(booster_timestep > 0))
+  stopifnot((length(booster_spacing) == 0) || all(booster_spacing > 0))
   stopifnot((length(booster_coverage)) == 0 || all(booster_coverage >= 0 & booster_coverage <= 1))
-  if (!all(c(length(booster_coverage), length(booster_timestep), length(booster_profile)) == length(booster_timestep))) {
-    stop('booster_timestep and booster_coverage and booster_profile does not align')
+  if (!all(c(ncol(booster_coverage), length(booster_profile)) == length(booster_spacing))) {
+    stop('booster_spacing, booster_coverage and booster_profile do not align')
+  }
+  # Check that booster_coverage and timesteps align
+  if (length(booster_coverage) > 0) {
+    if (nrow(booster_coverage) != length(timesteps)) {
+      stop('booster_coverage and timesteps do not align')
+    }
   }
 
   # Index the new vaccine profiles
@@ -125,7 +138,7 @@ set_pev_epi <- function(
   parameters$pev_epi_coverages <- coverages
   parameters$pev_epi_timesteps <- timesteps
   parameters$pev_epi_age <- age
-  parameters$pev_epi_booster_timestep <- booster_timestep
+  parameters$pev_epi_booster_spacing <- booster_spacing
   parameters$pev_epi_min_wait <- min_wait
   parameters$pev_epi_booster_coverage <- booster_coverage
   parameters$pev_epi_profile_indices <- profile_indices
@@ -139,18 +152,17 @@ set_pev_epi <- function(
 #' Efficacy will take effect after the last dose
 #'
 #' @param parameters a list of parameters to modify
-#' @param profile primary vaccine profile of type PEVProfile
+#' @param profile a list of details for the vaccine profile, create with `create_pev_profile`
 #' @param timesteps a vector of timesteps for each round of vaccinations
 #' @param coverages the coverage for each round of vaccinations
 #' @param min_wait the minimum acceptable time since the last vaccination (in timesteps);
 #' When using both set_mass_pev and set_pev_epi, this represents the minimum
 #' time between an individual being vaccinated under one scheme and vaccinated under another.
 #' @param min_ages for the target population, inclusive (in timesteps)
 #' @param max_ages for the target population, inclusive (in timesteps)
-#' @param booster_timestep the timesteps (following the initial vaccination) at which booster vaccinations are administered
-#' @param booster_coverage the proportion of the vaccinated population relative to the last vaccination (whether a previous booster or the primary series)
-#' @param booster_profile list of booster vaccine profiles, of type
-#' PEVProfile, for each timestep in booster_timeteps
+#' @param booster_spacing the timesteps (following the final primary dose) at which booster vaccinations are administered
+#' @param booster_coverage a matrix of coverages (timesteps x boosters) specifying the proportion the previously vaccinated population to continue receiving booster doses. The rows of the matrix must be the same size as `timesteps`. The columns of the matrix must be the same size as `booster_spacing`.
+#' @param booster_profile list of lists representing each booster profile, the outer list must be the same length as `booster_spacing`. Create vaccine profiles with `create_pev_profile`
 #' @export
 set_mass_pev <- function(
   parameters,
@@ -160,21 +172,36 @@ set_mass_pev <- function(
   min_ages,
   max_ages,
   min_wait,
-  booster_timestep,
+  booster_spacing,
   booster_coverage,
   booster_profile
   ) {
   stopifnot(all(timesteps >= 1))
   stopifnot(min_wait >= 0)
   stopifnot(all(coverages >= 0) && all(coverages <= 1))
   stopifnot(all(min_ages >= 0 & max_ages >= 0))
-  stopifnot(all(booster_timestep > 0))
+  stopifnot(all(booster_spacing > 0))
   stopifnot(all(booster_coverage >= 0 & booster_coverage <= 1))
   if (length(min_ages) != length(max_ages)) {
     stop('min and max ages do not align')
   }
-  if (!all(c(length(booster_coverage), length(booster_timestep), length(booster_profile)) == length(booster_timestep))) {
-    stop('booster_timestep, booster_coverage and booster_profile does not align')
+
+  # Check that booster_spacing are monotonically increasing
+  if (length(booster_spacing) > 1) {
+    if (!all(diff(booster_spacing) > 0)) {
+      stop('booster_spacing must be monotonically increasing')
+    }
+  }
+
+  stopifnot((length(booster_coverage)) == 0 || all(booster_coverage >= 0 & booster_coverage <= 1))
+  if (!all(c(ncol(booster_coverage), length(booster_profile)) == length(booster_spacing))) {
+    stop('booster_spacing, booster_coverage and booster_profile do not align')
+  }
+  # Check that booster_coverage and timesteps align
+  if (length(booster_coverage) > 0) {
+    if (nrow(booster_coverage) != length(timesteps)) {
+      stop('booster_coverage and timesteps do not align')
+    }
   }
 
   # Index the new vaccine profiles
@@ -189,7 +216,7 @@ set_mass_pev <- function(
   parameters$mass_pev_min_ages <- min_ages
   parameters$mass_pev_max_ages <- max_ages
   parameters$mass_pev_min_wait <- min_wait
-  parameters$mass_pev_booster_timestep <- booster_timestep
+  parameters$mass_pev_booster_spacing <- booster_spacing
   parameters$mass_pev_booster_coverage <- booster_coverage
   parameters$mass_pev_profile_indices <- profile_indices
   parameters