From a7c7dd1f29d143b2f19404ae613e484d40e25788 Mon Sep 17 00:00:00 2001 From: Giovanni Charles Date: Mon, 18 Sep 2023 14:43:44 +0100 Subject: [PATCH] Fix competing hazards for mass and EPI pev: * Add tests for the EPI and mass vaccination processes/listeners * Add checks in the listeners to remove scheduled vaccinations * Update the news for the bug fix * RcppExports updated automatically --- NEWS.md | 5 +++ R/pev.R | 21 ++++++++++- src/RcppExports.cpp | 2 +- tests/testthat/test-pev-epi.R | 70 +++++++++++++++++++++++++++++++++++ tests/testthat/test-pev.R | 68 ++++++++++++++++++++++++++++++++++ 5 files changed, 163 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 826bf0d0..538311c6 100644 --- a/NEWS.md +++ b/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 diff --git a/R/pev.R b/R/pev.R index 4c735552..28eb2819 100644 --- a/R/pev.R +++ b/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) diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index affb233d..f5c226fd 100644 --- a/src/RcppExports.cpp +++ b/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}, diff --git a/tests/testthat/test-pev-epi.R b/tests/testthat/test-pev-epi.R index 4eea8445..3dac524d 100644 --- a/tests/testthat/test-pev-epi.R +++ b/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)) diff --git a/tests/testthat/test-pev.R b/tests/testthat/test-pev.R index 5cb09c5d..c80dc457 100644 --- a/tests/testthat/test-pev.R +++ b/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(