Merge pull request #265 from mrc-ide/bug/competing_vaccination

Fix competing hazards for mass and EPI pev:

NEWS.md

@@ -1,3 +1,8 @@
+# malariasimulation 1.6.1 (wip)
+
+ * Fix bug in competing hazards between mass and EPI vaccines. Where individuals
+   can be enrolled onto both strategies if applied on the same timestep.
+
 # malariasimulation 1.6.0
 
   * Fix MDA bug where undetectable asymptomatics are treated

R/pev.R

@@ -29,6 +29,14 @@ create_epi_pev_process <- function(
     to_vaccinate <- variables$birth$get_index_of(
       set = timestep - parameters$pev_epi_age
     )
+
+    #ignore those who are scheduled for mass vaccination
+    if (!is.null(events$mass_pev_doses)) {
+      to_vaccinate <- to_vaccinate$and(
+        events$mass_pev_doses[[1]]$get_scheduled()$not()
+      )
+    }
+
     if (parameters$pev_epi_min_wait == 0) {
       target <- to_vaccinate$to_vector()
     } else {
@@ -81,13 +89,22 @@ create_mass_pev_listener <- function(
       in_age_group$or(variables$birth$get_index_of(a = min_birth, b = max_birth))
     }
     if (parameters$mass_pev_min_wait == 0) {
-      target <- in_age_group$to_vector()
+      target <- in_age_group
     } else {
       not_recently_vaccinated <- variables$pev_timestep$get_index_of(
         a = max(timestep - parameters$mass_pev_min_wait, 0),
         b = timestep
       )$not(TRUE)
-      target <- in_age_group$and(not_recently_vaccinated)$to_vector()
+      target <- in_age_group$and(not_recently_vaccinated)
+    }
+
+    #ignore those who are scheduled for EPI vaccination
+    if (!is.null(events$pev_epi_doses)) {
+      target <- target$and(
+        events$pev_epi_doses[[1]]$get_scheduled()$not()
+      )$to_vector()
+    } else {
+      target <- target$to_vector()
     }
 
     time_index = which(parameters$mass_pev_timesteps == timestep)

src/RcppExports.cpp

@@ -260,7 +260,7 @@ BEGIN_RCPP
 END_RCPP
 }
 
-RcppExport SEXP run_testthat_tests(void);
+RcppExport SEXP run_testthat_tests();
 
 static const R_CallMethodDef CallEntries[] = {
     {"_malariasimulation_create_adult_mosquito_model", (DL_FUNC) &_malariasimulation_create_adult_mosquito_model, 5},

tests/testthat/test-pev-epi.R

@@ -131,6 +131,76 @@ test_that('pev epi targets correct age and respects min_wait', {
   )
 })
 
+test_that('EPI ignores individuals scheduled for mass vaccination', {
+  timestep <- 100
+  parameters <- get_parameters(list(human_population = 5))
+  parameters <- set_mass_pev(
+    parameters,
+    profile = rtss_profile,
+    timesteps = c(50, 100),
+    coverages = rep(0.8, 2),
+    min_wait = 0,
+    min_ages = c(1, 2, 3, 18) * 365,
+    max_ages = (c(1, 2, 3, 18) + 1) * 365 - 1,
+    booster_timestep = c(18, 36) * 30,
+    booster_coverage = c(.9, .8),
+    booster_profile = list(rtss_booster_profile, rtss_booster_profile)
+  )
+  parameters <- set_pev_epi(
+    parameters,
+    profile = rtss_profile,
+    timesteps = 10,
+    coverages = 0.8,
+    min_wait = 0,
+    age = 18 * 365,
+    booster_timestep = c(18, 36) * 30,
+    booster_coverage = c(.9, .8),
+    booster_profile = list(rtss_booster_profile, rtss_booster_profile)
+  )
+  events <- create_events(parameters)
+  variables <- create_variables(parameters)
+  variables$birth <- individual::IntegerVariable$new(
+    -c(18, 8, 2.9, 3.2, 18) * 365 + 100
+  )
+  variables$pev_timestep <- mock_integer(
+    c(-1, -1, -1, 50, 50)
+  )
+
+  correlations <- get_correlation_parameters(parameters)
+
+  process <- create_epi_pev_process(
+    variables,
+    events,
+    parameters,
+    correlations,
+    parameters$pev_epi_coverages,
+    parameters$pev_epi_timesteps
+  )
+
+  sample_mock <- mockery::mock(c(TRUE))
+
+  mockery::stub(
+    process,
+    'sample_intervention',
+    sample_mock
+  )
+
+  # schedule id #1 for epi vaccination
+  events$mass_pev_doses[[1]]$schedule(1, 0)
+
+  process(timestep)
+
+  mockery::expect_args(
+    sample_mock,
+    1,
+    5,
+    'pev',
+    .8,
+    correlations
+  )
+})
+
+
 test_that('pev EPI respects min_wait when scheduling seasonal boosters', {
   timestep <- 5 * 365 
   parameters <- get_parameters(list(human_population = 5))

tests/testthat/test-pev.R

@@ -209,6 +209,74 @@ test_that('Mass vaccinations update vaccination time', {
   )
 })
 
+test_that('Mass vaccinations ignore EPI individuals', {
+  timestep <- 100
+  parameters <- get_parameters(list(human_population = 5))
+  parameters <- set_mass_pev(
+    parameters,
+    profile = rtss_profile,
+    timesteps = c(50, 100),
+    coverages = rep(0.8, 2),
+    min_wait = 0,
+    min_ages = c(1, 2, 3, 18) * 365,
+    max_ages = (c(1, 2, 3, 18) + 1) * 365 - 1,
+    booster_timestep = c(18, 36) * 30,
+    booster_coverage = c(.9, .8),
+    booster_profile = list(rtss_booster_profile, rtss_booster_profile)
+  )
+  parameters <- set_pev_epi(
+    parameters,
+    profile = rtss_profile,
+    timesteps = 10,
+    coverages = 0.8,
+    min_wait = 2*365,
+    age = 18 * 365,
+    booster_timestep = c(18, 36) * 30,
+    booster_coverage = c(.9, .8),
+    booster_profile = list(rtss_booster_profile, rtss_booster_profile)
+  )
+  events <- create_events(parameters)
+  variables <- create_variables(parameters)
+  variables$birth <- individual::IntegerVariable$new(
+    -c(18.3, 8, 2.9, 3.2, 18.4) * 365 + 100
+  )
+  variables$pev_timestep <- mock_integer(
+    c(-1, -1, -1, 50, 50)
+  )
+
+  correlations <- get_correlation_parameters(parameters)
+
+  listener <- create_mass_pev_listener(
+    variables,
+    events,
+    parameters,
+    correlations
+  )
+
+  sample_mock <- mockery::mock(c(TRUE, TRUE, FALSE, FALSE))
+
+  mockery::stub(
+    listener,
+    'sample_intervention',
+    sample_mock
+  )
+
+  # schedule id #1 for epi vaccination
+  events$pev_epi_doses[[1]]$schedule(1, 0)
+
+  listener(timestep)
+
+  mockery::expect_args(
+    sample_mock,
+    1,
+    c(3, 4, 5),
+    'pev',
+    .8,
+    correlations
+  )
+})
+
+
 test_that('Mass boosters update profile params and reschedule correctly', {
   parameters <- get_parameters()
   parameters <- set_mass_pev(