Implement time varying coverage for PEV boosters:

 * Update documentation
 * Update parameterisation and tests
 * Update booster listener to incorporate timed coverage
 * Update attach_events to pass timed coverage parameters
 * Test timed coverage sampling
 * Bonus: fix a biology test

R/events.R

@@ -133,6 +133,8 @@ attach_event_listeners <- function(
       events$mass_pev_boosters,
       parameters$mass_pev_booster_timestep,
       parameters$mass_pev_booster_coverage,
+      parameters$mass_pev_timed_booster_coverage,
+      parameters$mass_pev_timed_booster_coverage_timestep,
       parameters$mass_pev_profile_indices,
       'mass',
       renderer
@@ -147,6 +149,8 @@ attach_event_listeners <- function(
       events$pev_epi_boosters,
       parameters$pev_epi_booster_timestep,
       parameters$pev_epi_booster_coverage,
+      parameters$pev_epi_timed_booster_coverage,
+      parameters$pev_epi_timed_booster_coverage_timestep,
       parameters$pev_epi_profile_indices,
       'epi',
       renderer

R/pev.R

@@ -179,6 +179,8 @@ create_pev_efficacy_listener <- function(variables, pev_profile_index) {
 create_pev_booster_listener <- function(
   variables,
   coverage,
+  timed_coverage = NULL,
+  timed_coverage_timestep = NULL,
   booster_number,
   pev_profile_index,
   next_booster_event,
@@ -192,7 +194,17 @@ create_pev_booster_listener <- function(
   force(next_booster_delay)
   force(coverage)
   function(timestep, target) {
-    target <- sample_bitset(target, coverage)
+    if (is.null(timed_coverage)) {
+      t_coverage <- 1
+    } else {
+      t_coverage <- timed_coverage[
+        match_timestep(timed_coverage_timestep, timestep)
+      ]
+    }
+    target <- sample_bitset(
+      target,
+      coverage * t_coverage
+    )
     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)
@@ -240,6 +252,8 @@ attach_pev_dose_listeners <- function(
   booster_events,
   booster_delays,
   booster_coverages,
+  booster_timed_coverage,
+  booster_timed_coverage_timestep,
   pev_profile_indices,
   strategy,
   renderer
@@ -303,6 +317,8 @@ attach_pev_dose_listeners <- function(
       create_pev_booster_listener(
         variables = variables,
         coverage = booster_coverages[[b]],
+        timed_coverage = booster_timed_coverage,
+        timed_coverage_timestep = booster_timed_coverage_timestep,
         booster_number = b,
         pev_profile_index = pev_profile_indices[[b + 1]],
         next_booster_event = next_booster_event,

R/pev_parameters.R

@@ -74,6 +74,8 @@ rtss_booster_profile <- create_pev_profile(
 #' 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_timed_coverage a time varying proportion of the vaccinated population relative to the last vaccination (whether a previous booster or the primary series), set in time with `booster_coverage_timestep`
+#' @param booster_timed_coverage_timestep a vector of timesteps to change the time varying coverage specified in `booster_timed_coverage`
 #' @param booster_profile list of booster vaccine profiles, of type
 #' PEVProfile, for each timestep in booster_timeteps
 #' @param seasonal_boosters logical, if TRUE the first booster timestep is
@@ -88,6 +90,8 @@ set_pev_epi <- function(
   min_wait,
   booster_timestep,
   booster_coverage,
+  booster_timed_coverage = NULL,
+  booster_timed_coverage_timestep = NULL,
   booster_profile,
   seasonal_boosters = FALSE
   ) {
@@ -114,6 +118,9 @@ set_pev_epi <- function(
   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 (length(booster_timed_coverage) != length(booster_timed_coverage_timestep)) {
+    stop("booster_coverage_timestep must be the same length as booster_coverage")
+  }
 
   # Index the new vaccine profiles
   profile_list <- c(list(profile), booster_profile)
@@ -128,6 +135,9 @@ set_pev_epi <- function(
   parameters$pev_epi_booster_timestep <- booster_timestep
   parameters$pev_epi_min_wait <- min_wait
   parameters$pev_epi_booster_coverage <- booster_coverage
+  parameters$pev_epi_booster_timed_coverage <- booster_timed_coverage
+  parameters$pev_epi_booster_timed_coverage_timestep <- booster_timed_coverage_timestep
+  parameters$pev_epi_booster_coverage <- booster_coverage
   parameters$pev_epi_profile_indices <- profile_indices
   parameters$pev_epi_seasonal_boosters <- seasonal_boosters
   parameters
@@ -149,6 +159,8 @@ set_pev_epi <- function(
 #' @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_timed_coverage a time varying proportion of the vaccinated population relative to the last vaccination (whether a previous booster or the primary series), set in time with `booster_coverage_timestep`
+#' @param booster_timed_coverage_timestep a vector of timesteps to change the time varying coverage specified in `booster_timed_coverage`
 #' @param booster_profile list of booster vaccine profiles, of type
 #' PEVProfile, for each timestep in booster_timeteps
 #' @export
@@ -162,6 +174,8 @@ set_mass_pev <- function(
   min_wait,
   booster_timestep,
   booster_coverage,
+  booster_timed_coverage = NULL,
+  booster_timed_coverage_timestep = NULL,
   booster_profile
   ) {
   stopifnot(all(timesteps >= 1))
@@ -176,6 +190,9 @@ set_mass_pev <- function(
   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')
   }
+  if (length(booster_timed_coverage) != length(booster_timed_coverage_timestep)) {
+    stop("booster_coverage_timestep must be the same length as booster_coverage")
+  }
 
   # Index the new vaccine profiles
   profile_list <- c(list(profile), booster_profile)
@@ -191,6 +208,8 @@ set_mass_pev <- function(
   parameters$mass_pev_min_wait <- min_wait
   parameters$mass_pev_booster_timestep <- booster_timestep
   parameters$mass_pev_booster_coverage <- booster_coverage
+  parameters$mass_pev_booster_timed_coverage <- booster_timed_coverage
+  parameters$mass_pev_booster_timed_coverage_timestep <- booster_timed_coverage_timestep
   parameters$mass_pev_profile_indices <- profile_indices
   parameters
 }

tests/testthat/test-biology.R

@@ -92,13 +92,13 @@ test_that('FOIM is consistent with equilibrium', {
       psi <- unique_biting_rate(age, parameters)
       zeta <- variables$zeta$get_values()
       .pi <- human_pi(psi, zeta)
-      calculate_foim(a, sum(.pi * variables$infectivity$get_values()))
+      calculate_foim(a, sum(.pi * variables$infectivity$get_values()), 1.)
     }
   )
   expect_equal(
     expected_foim,
     actual_foim,
-    tolerance = 1e-4
+    tolerance = 1e-3
   )
 })
 

tests/testthat/test-pev-epi.R

@@ -51,6 +51,47 @@ test_that('pev epi strategy parameterisation works', {
   )
 })
 
+test_that('I can add time varying booster coverage to the pev epi strategy', {
+  parameters <- get_parameters()
+  parameters <- set_pev_epi(
+    parameters,
+    profile = rtss_profile,
+    coverages = c(0.1, 0.8),
+    timesteps = c(10, 100),
+    min_wait = 0,
+    age = 5 * 30,
+    booster_timestep = c(18, 36) * 30,
+    booster_coverage = c(.9, .8),
+    booster_timed_coverage = c(.5, .7),
+    booster_timed_coverage_timestep = c(365, 2*365),
+    booster_profile = list(rtss_booster_profile, rtss_booster_profile)
+  )
+  expect_equal(parameters$pev_epi_booster_timestep, c(18, 36) * 30)
+  expect_equal(parameters$pev_epi_booster_coverage, c(.9, .8))
+  expect_equal(parameters$pev_epi_booster_timed_coverage, c(.5, .7))
+  expect_equal(parameters$pev_epi_booster_timed_coverage_timestep, c(365, 2*365))
+  expect_equal(parameters$pev_profiles, list(rtss_profile, rtss_booster_profile, rtss_booster_profile))
+
+  expect_error(
+    parameters <- set_pev_epi(
+      parameters,
+      profile = rtss_profile,
+      coverages = c(0.1, 0.8),
+      timesteps = c(10, 100),
+      min_wait = 0,
+      age = 5 * 30,
+      booster_timestep = c(18, 36) * 30,
+      booster_coverage = c(.9, .8),
+      booster_timed_coverage = c(.5, .7),
+      booster_timed_coverage_timestep = 365,
+      booster_profile = list(rtss_booster_profile, rtss_booster_profile)
+    ),
+    "booster_coverage_timestep must be the same length as booster_coverage",
+    fixed = TRUE
+  )
+})
+
+
 test_that('pev epi fails pre-emptively with unaligned booster parameters', {
   parameters <- get_parameters()
   expect_error(