Merge pull request #179 from mrc-ide/feat/rtss_epi_variable_cov

Time varying rtss epi coverage

R/compatibility.R

@@ -184,7 +184,7 @@ remove_unused_equilibrium <- function(params) {
 #' equilibrium parameters and set up the initial human and mosquito population
 #' to acheive init_EIR
 #' @param parameters model parameters to update
-#' @param init_EIR the desired initial EIR (infectious bites per day over the entire human
+#' @param init_EIR the desired initial EIR (infectious bites per person per day over the entire human
 #' population)
 #' @param eq_params parameters from the malariaEquilibrium package, if null.
 #' The default malariaEquilibrium parameters will be used

R/events.R

@@ -27,7 +27,7 @@ create_events <- function(parameters) {
   }
 
   # EPI vaccination events
-  if (!is.null(parameters$rtss_epi_start)) {
+  if (!is.null(parameters$rtss_epi_coverage)) {
     rtss_epi_doses <- lapply(
       seq_along(parameters$rtss_doses),
       function(.) individual::TargetedEvent$new(parameters$human_population)

R/processes.R

@@ -124,14 +124,16 @@ create_processes <- function(
   # =========
   # RTS,S EPI
   # =========
-  if (!is.null(parameters$rtss_epi_start)) {
+  if (!is.null(parameters$rtss_epi_coverages)) {
     processes <- c(
       processes,
       create_rtss_epi_process(
         variables,
         events,
         parameters,
-        correlations
+        correlations,
+        parameters$rtss_epi_coverages,
+        parameters$rtss_epi_timesteps
       )
     )
   }

R/rtss.R

@@ -12,16 +12,23 @@ create_rtss_epi_process <- function(
   variables,
   events,
   parameters,
-  correlations
+  correlations,
+  coverages,
+  timesteps
   ) {
   function(timestep) {
-    if (!between(timestep, parameters$rtss_epi_start, parameters$rtss_epi_end)) {
+    timestep_index <- match_timestep(ts = timesteps, t = timestep)
+    if(timestep_index == 0){
+      return()
+    }
+    coverage <- coverages[timestep_index]
+    if(coverage == 0){
       return()
     }
+
     to_vaccinate <- variables$birth$get_index_of(
       set = timestep - parameters$rtss_epi_age
     )
-
     if (parameters$rtss_epi_min_wait == 0) {
       target <- to_vaccinate$to_vector()
     } else {
@@ -36,10 +43,11 @@ create_rtss_epi_process <- function(
       sample_intervention(
         target,
        'rtss',
-        parameters$rtss_epi_coverage,
+        coverage,
         correlations
       )
     ]
+
     schedule_vaccination(
       target,
       events,

R/utils.R

@@ -64,4 +64,3 @@ rtexp <- function(n, m, t) { itexp(runif(n), m, t) }
 match_timestep <- function(ts, t) {
   min(sum(ts <= t), length(ts))
 }
-

R/vaccine_parameters.R

@@ -4,9 +4,8 @@
 #' age. Efficacy will take effect after the last dose
 #'
 #' @param parameters a list of parameters to modify
-#' @param start timestep to turn on epi vaccination
-#' @param end timestep to turn off epi vaccination
-#' @param coverage the coverage for the starter doses
+#' @param coverages a vector of coverages for the starter doses
+#' @param timesteps a vector of timesteps associated with coverages
 #' @param age for the target population, (in timesteps)
 #' @param min_wait the minimum acceptable time since the last vaccination (in
 #' timesteps); When seasonal_boosters = TRUE, this represents the minimum time
@@ -21,19 +20,18 @@
 #' @export
 set_rtss_epi <- function(
   parameters,
-  start,
-  end,
-  coverage,
+  coverages,
+  timesteps,
   age,
   min_wait,
   boosters,
   booster_coverage,
   seasonal_boosters = FALSE
   ) {
-  stopifnot(length(start) == 1 && start > 1)
-  stopifnot(length(end) == 1 && end > start)
+  if(length(coverages) != length(timesteps)){
+    stop("coverages and timesteps must align")
+  }
   stopifnot(min_wait >= 0)
-  stopifnot(coverage >= 0 & coverage <= 1)
   stopifnot(age >= 0)
   stopifnot(is.logical(seasonal_boosters))
   if (seasonal_boosters) {
@@ -47,9 +45,8 @@ set_rtss_epi <- function(
     stop('booster and booster_coverage does not align')
   }
   parameters$rtss <- TRUE
-  parameters$rtss_epi_start <- start
-  parameters$rtss_epi_end <- end
-  parameters$rtss_epi_coverage <- coverage
+  parameters$rtss_epi_coverages <- coverages
+  parameters$rtss_epi_timesteps <- timesteps
   parameters$rtss_epi_age <- age
   parameters$rtss_epi_boosters <- boosters
   parameters$rtss_epi_min_wait <- min_wait

tests/testthat/test-rtss-epi.R

@@ -2,18 +2,16 @@ test_that('RTS,S epi strategy parameterisation works', {
   parameters <- get_parameters()
   parameters <- set_rtss_epi(
     parameters,
-    start = 10,
-    end = 100,
-    coverage = 0.8,
+    coverages = c(0.1, 0.8),
+    timesteps = c(10, 100),
     min_wait = 0,
     age = 5 * 30,
     boosters = c(18, 36) * 30,
     booster_coverage = c(.9, .8)
   )
   expect_equal(parameters$rtss, TRUE)
-  expect_equal(parameters$rtss_epi_start, 10)
-  expect_equal(parameters$rtss_epi_end, 100)
-  expect_equal(parameters$rtss_epi_coverage, .8)
+  expect_equal(parameters$rtss_epi_coverages, c(0.1, 0.8))
+  expect_equal(parameters$rtss_epi_timesteps, c(10, 100))
   expect_equal(parameters$rtss_epi_age, 5 * 30)
   expect_equal(parameters$rtss_epi_min_wait, 0)
   expect_equal(parameters$rtss_epi_boosters, c(18, 36) * 30)
@@ -24,9 +22,8 @@ test_that('RTS,S epi fails pre-emptively', {
   expect_error(
     set_rtss_epi(
       parameters,
-      start = 10,
-      end = 100,
-      coverages = 0.8,
+      coverages = c(0.1, 0.8),
+      timesteps = c(10, 100),
       min_wait = 0,
       min_ages = 5 * 30,
       max_ages = 17 * 30,
@@ -42,9 +39,8 @@ test_that('RTS,S epi targets correct age and respects min_wait', {
   parameters <- get_parameters(list(human_population = 5))
   parameters <- set_rtss_epi(
     parameters,
-    start = 10,
-    end = timestep,
-    coverage = 0.8,
+    timesteps = 10,
+    coverages = 0.8,
     min_wait = 2*365,
     age = 18 * 365,
     boosters = c(18, 36) * 30,
@@ -65,7 +61,9 @@ test_that('RTS,S epi targets correct age and respects min_wait', {
     variables,
     events,
     parameters,
-    get_correlation_parameters(parameters)
+    get_correlation_parameters(parameters),
+    parameters$rtss_epi_coverages,
+    parameters$rtss_epi_timesteps
   )
 
   mockery::stub(
@@ -103,9 +101,8 @@ test_that('RTS,S EPI respects min_wait when scheduling seasonal boosters', {
   parameters <- get_parameters(list(human_population = 5))
   parameters <- set_rtss_epi(
     parameters,
-    start = 10,
-    end = timestep,
-    coverage = 0.8,
+    timesteps = 10,
+    coverages = 0.8,
     min_wait = 6 * 30,
     age = 18 * 365,
     boosters = c(3, 12) * 30,
@@ -138,9 +135,8 @@ test_that('RTS,S EPI schedules for the following year with seasonal boosters', {
   parameters <- get_parameters(list(human_population = 5))
   parameters <- set_rtss_epi(
     parameters,
-    start = 10,
-    end = timestep,
-    coverage = 0.8,
+    timesteps = 10,
+    coverages = 0.8,
     min_wait = 6 * 30,
     age = 18 * 365,
     boosters = c(3, 12) * 30,