From 73cbfb412ec5ccb32e3354c4c4e8084d2bb8a6b9 Mon Sep 17 00:00:00 2001 From: Giovanni Charles Date: Thu, 16 Nov 2023 16:50:30 +0000 Subject: [PATCH 1/4] 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 | 4 + R/pev.R | 18 ++++- R/pev_parameters.R | 19 +++++ man/CorrelationParameters.Rd | 36 ++++----- man/set_mass_pev.Rd | 6 ++ man/set_pev_epi.Rd | 6 ++ tests/testthat/test-biology.R | 4 +- tests/testthat/test-pev-epi.R | 41 ++++++++++ tests/testthat/test-pev.R | 148 ++++++++++++++++++++++++++++++++++ 9 files changed, 261 insertions(+), 21 deletions(-) diff --git a/R/events.R b/R/events.R index 879d72bd..21207e5d 100644 --- a/R/events.R +++ b/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 diff --git a/R/pev.R b/R/pev.R index 039b6044..d37ff6d3 100644 --- a/R/pev.R +++ b/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, diff --git a/R/pev_parameters.R b/R/pev_parameters.R index aeb6bd5b..c74f3a94 100644 --- a/R/pev_parameters.R +++ b/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 } diff --git a/man/CorrelationParameters.Rd b/man/CorrelationParameters.Rd index c2e6ada7..b1d22578 100644 --- a/man/CorrelationParameters.Rd +++ b/man/CorrelationParameters.Rd @@ -14,17 +14,17 @@ Describes an event in the simulation \section{Methods}{ \subsection{Public methods}{ \itemize{ -\item \href{#method-CorrelationParameters-new}{\code{CorrelationParameters$new()}} -\item \href{#method-CorrelationParameters-inter_round_rho}{\code{CorrelationParameters$inter_round_rho()}} -\item \href{#method-CorrelationParameters-inter_intervention_rho}{\code{CorrelationParameters$inter_intervention_rho()}} -\item \href{#method-CorrelationParameters-sigma}{\code{CorrelationParameters$sigma()}} -\item \href{#method-CorrelationParameters-mvnorm}{\code{CorrelationParameters$mvnorm()}} -\item \href{#method-CorrelationParameters-clone}{\code{CorrelationParameters$clone()}} +\item \href{#method-new}{\code{CorrelationParameters$new()}} +\item \href{#method-inter_round_rho}{\code{CorrelationParameters$inter_round_rho()}} +\item \href{#method-inter_intervention_rho}{\code{CorrelationParameters$inter_intervention_rho()}} +\item \href{#method-sigma}{\code{CorrelationParameters$sigma()}} +\item \href{#method-mvnorm}{\code{CorrelationParameters$mvnorm()}} +\item \href{#method-clone}{\code{CorrelationParameters$clone()}} } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CorrelationParameters-new}{}}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-new}{}}} \subsection{Method \code{new()}}{ initialise correlation parameters \subsection{Usage}{ @@ -40,8 +40,8 @@ initialise correlation parameters } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CorrelationParameters-inter_round_rho}{}}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-inter_round_rho}{}}} \subsection{Method \code{inter_round_rho()}}{ Add rho between rounds \subsection{Usage}{ @@ -60,8 +60,8 @@ the intervention} } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CorrelationParameters-inter_intervention_rho}{}}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-inter_intervention_rho}{}}} \subsection{Method \code{inter_intervention_rho()}}{ Add rho between interventions \subsection{Usage}{ @@ -83,8 +83,8 @@ the intervention} } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CorrelationParameters-sigma}{}}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-sigma}{}}} \subsection{Method \code{sigma()}}{ Standard deviation of each intervention between rounds \subsection{Usage}{ @@ -93,8 +93,8 @@ Standard deviation of each intervention between rounds } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CorrelationParameters-mvnorm}{}}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-mvnorm}{}}} \subsection{Method \code{mvnorm()}}{ multivariate norm draws for these parameters \subsection{Usage}{ @@ -103,8 +103,8 @@ multivariate norm draws for these parameters } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CorrelationParameters-clone}{}}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ diff --git a/man/set_mass_pev.Rd b/man/set_mass_pev.Rd index 7c28547f..e088e0bb 100644 --- a/man/set_mass_pev.Rd +++ b/man/set_mass_pev.Rd @@ -14,6 +14,8 @@ set_mass_pev( min_wait, booster_timestep, booster_coverage, + booster_timed_coverage = NULL, + booster_timed_coverage_timestep = NULL, booster_profile ) } @@ -38,6 +40,10 @@ time between an individual being vaccinated under one scheme and vaccinated unde \item{booster_coverage}{the proportion of the vaccinated population relative to the last vaccination (whether a previous booster or the primary series)} +\item{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 \code{booster_coverage_timestep}} + +\item{booster_timed_coverage_timestep}{a vector of timesteps to change the time varying coverage specified in \code{booster_timed_coverage}} + \item{booster_profile}{list of booster vaccine profiles, of type PEVProfile, for each timestep in booster_timeteps} } diff --git a/man/set_pev_epi.Rd b/man/set_pev_epi.Rd index 4dea14ed..2f7e7ced 100644 --- a/man/set_pev_epi.Rd +++ b/man/set_pev_epi.Rd @@ -13,6 +13,8 @@ set_pev_epi( min_wait, booster_timestep, booster_coverage, + booster_timed_coverage = NULL, + booster_timed_coverage_timestep = NULL, booster_profile, seasonal_boosters = FALSE ) @@ -39,6 +41,10 @@ an individual being vaccinated under one scheme and vaccinated under another.} \item{booster_coverage}{the proportion of the vaccinated population relative to the last vaccination (whether a previous booster or the primary series)} +\item{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 \code{booster_coverage_timestep}} + +\item{booster_timed_coverage_timestep}{a vector of timesteps to change the time varying coverage specified in \code{booster_timed_coverage}} + \item{booster_profile}{list of booster vaccine profiles, of type PEVProfile, for each timestep in booster_timeteps} diff --git a/tests/testthat/test-biology.R b/tests/testthat/test-biology.R index 5895d45b..c739f7e7 100644 --- a/tests/testthat/test-biology.R +++ b/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 ) }) diff --git a/tests/testthat/test-pev-epi.R b/tests/testthat/test-pev-epi.R index ef9148a3..26541b9c 100644 --- a/tests/testthat/test-pev-epi.R +++ b/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( diff --git a/tests/testthat/test-pev.R b/tests/testthat/test-pev.R index 30007cd3..16f65849 100644 --- a/tests/testthat/test-pev.R +++ b/tests/testthat/test-pev.R @@ -54,6 +54,49 @@ test_that('Mass vaccination strategy parameterisation works', { ) }) +test_that('I can add time varying booster coverage to the mass pev strategy', { + parameters <- get_parameters() + parameters <- set_mass_pev( + parameters, + profile = rtss_profile, + timesteps = 10, + coverages = 0.8, + min_wait = 0, + min_ages = 5 * 30, + max_ages = 17 * 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$mass_pev_booster_timestep, c(18, 36) * 30) + expect_equal(parameters$mass_pev_booster_timed_coverage, c(.5, .7)) + expect_equal(parameters$mass_pev_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_mass_pev( + parameters, + profile = rtss_profile, + timesteps = 10, + coverages = 0.8, + min_wait = 0, + min_ages = 5 * 30, + max_ages = 17 * 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('Mass vaccination fails pre-emptively for unaligned booster parameters', { parameters <- get_parameters() expect_error( @@ -557,6 +600,8 @@ test_that('Mass dose events are not ruined by lazy evaluation', { booster_events = events$mass_pev_boosters, booster_delays = parameters$mass_pev_booster_timestep, booster_coverages = parameters$mass_pev_booster_coverage, + booster_timed_coverage = NULL, + booster_timed_coverage_timestep = NULL, pev_profile_indices = parameters$mass_pev_profile_indices, strategy = 'mass', renderer = mock_render(1) @@ -612,4 +657,107 @@ test_that('Efficacies are calculated correctly', { ) }) +test_that('pev timed booster coverage works with NULL', { + timestep <- 5 * 365 + parameters <- get_parameters(list(human_population = 5)) + parameters <- set_pev_epi( + parameters, + profile = rtss_profile, + timesteps = 10, + coverages = 0.8, + min_wait = 6 * 30, + age = 18 * 365, + booster_timestep = c(3, 12) * 30, + booster_coverage = c(.9, .8), + booster_timed_coverage = c(.5, .7), + booster_timed_coverage_timestep = c(timestep, timestep + 365), + booster_profile = list(rtss_booster_profile, rtss_booster_profile), + ) + events <- create_events(parameters) + + booster_event <- mock_event(events$pev_epi_boosters[[1]]) + + listener <- create_pev_booster_listener( + variables = create_variables(parameters), + coverage = .9, + timed_coverage = NULL, + timed_coverage_timestep = NULL, + booster_number = 1, + pev_profile_index = 2, + next_booster_event = booster_event, + next_booster_delay = 9 * 30, + renderer = mock_render(timestep), + strategy = 'epi' + ) + + target <- individual::Bitset$new(5)$insert(seq(5)) + + mock_sample_bitset = mockery::mock(individual::Bitset$new(5)$insert(c(1, 2))) + mockery::stub( + listener, + 'sample_bitset', + mock_sample_bitset + ) + + listener(timestep, target) + + mockery::expect_args( + mock_sample_bitset, + 1, + target, + .9 + ) +}) + + +test_that('pev boosters take into account the timed coverage', { + timestep <- 5 * 365 + parameters <- get_parameters(list(human_population = 5)) + parameters <- set_pev_epi( + parameters, + profile = rtss_profile, + timesteps = 10, + coverages = 0.8, + min_wait = 6 * 30, + age = 18 * 365, + booster_timestep = c(3, 12) * 30, + booster_coverage = c(.9, .8), + booster_timed_coverage = c(.5, .7), + booster_timed_coverage_timestep = c(timestep, timestep + 365), + booster_profile = list(rtss_booster_profile, rtss_booster_profile), + ) + events <- create_events(parameters) + + booster_event <- mock_event(events$pev_epi_boosters[[1]]) + + listener <- create_pev_booster_listener( + variables = create_variables(parameters), + coverage = .9, + timed_coverage = c(.5, .7), + timed_coverage_timestep = c(timestep, timestep + 365), + booster_number = 1, + pev_profile_index = 2, + next_booster_event = booster_event, + next_booster_delay = 9 * 30, + renderer = mock_render(timestep), + strategy = 'epi' + ) + + target <- individual::Bitset$new(5)$insert(seq(5)) + + mock_sample_bitset = mockery::mock(individual::Bitset$new(5)$insert(c(1, 2))) + mockery::stub( + listener, + 'sample_bitset', + mock_sample_bitset + ) + + listener(timestep, target) + mockery::expect_args( + mock_sample_bitset, + 1, + target, + .45 + ) +}) From d49c8dd75c09bffad38382eefeaf63cf0375f977 Mon Sep 17 00:00:00 2001 From: Giovanni Charles Date: Wed, 6 Dec 2023 16:36:55 +0000 Subject: [PATCH 2/4] Fix PEV EPI parameterisation bug --- R/pev_parameters.R | 4 ++-- tests/testthat/test-pev-epi.R | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/pev_parameters.R b/R/pev_parameters.R index c74f3a94..6648dd29 100644 --- a/R/pev_parameters.R +++ b/R/pev_parameters.R @@ -135,8 +135,8 @@ 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_timed_booster_coverage <- booster_timed_coverage + parameters$pev_epi_timed_booster_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 diff --git a/tests/testthat/test-pev-epi.R b/tests/testthat/test-pev-epi.R index 26541b9c..a1c718cb 100644 --- a/tests/testthat/test-pev-epi.R +++ b/tests/testthat/test-pev-epi.R @@ -68,8 +68,8 @@ test_that('I can add time varying booster coverage to the pev epi strategy', { ) 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_epi_timed_booster_coverage, c(.5, .7)) + expect_equal(parameters$pev_epi_timed_booster_coverage_timestep, c(365, 2*365)) expect_equal(parameters$pev_profiles, list(rtss_profile, rtss_booster_profile, rtss_booster_profile)) expect_error( From 91247b4eee779c8b426bb7aa50b28cb4244b363b Mon Sep 17 00:00:00 2001 From: Giovanni Charles Date: Thu, 4 Jan 2024 15:44:27 +0000 Subject: [PATCH 3/4] Implement simplified pev booster interface: * rename booster_timesteps -> booster_spacing * make booster_coverage a matrix (timestep x booster doses) * update validation * update implementation of attach_booster_listener * fix regression tests * update documentation * update vignettes * fix correlation examples --- R/correlation.R | 2 +- R/events.R | 14 +- R/pev.R | 27 ++-- R/pev_parameters.R | 73 +++++----- man/get_correlation_parameters.Rd | 2 +- man/set_mass_pev.Rd | 17 +-- man/set_pev_epi.Rd | 19 +-- tests/testthat/test-infection-integration.R | 4 +- tests/testthat/test-pev-epi.R | 80 +++-------- tests/testthat/test-pev.R | 140 ++++++++------------ vignettes/Vaccines.Rmd | 20 +-- 11 files changed, 150 insertions(+), 248 deletions(-) diff --git a/R/correlation.R b/R/correlation.R index 41ea6a82..68119369 100644 --- a/R/correlation.R +++ b/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 #' ) diff --git a/R/events.R b/R/events.R index 21207e5d..d7ad3416 100644 --- a/R/events.R +++ b/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,12 +129,11 @@ 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_timed_booster_coverage, - parameters$mass_pev_timed_booster_coverage_timestep, parameters$mass_pev_profile_indices, 'mass', renderer @@ -145,12 +144,11 @@ 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_timed_booster_coverage, - parameters$pev_epi_timed_booster_coverage_timestep, parameters$pev_epi_profile_indices, 'epi', renderer diff --git a/R/pev.R b/R/pev.R index d37ff6d3..bc27fc9f 100644 --- a/R/pev.R +++ b/R/pev.R @@ -179,8 +179,7 @@ create_pev_efficacy_listener <- function(variables, pev_profile_index) { create_pev_booster_listener <- function( variables, coverage, - timed_coverage = NULL, - timed_coverage_timestep = NULL, + pev_distribution_timesteps, booster_number, pev_profile_index, next_booster_event, @@ -194,17 +193,11 @@ create_pev_booster_listener <- function( force(next_booster_delay) force(coverage) function(timestep, target) { - 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 - ) + 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) @@ -248,12 +241,11 @@ create_dosage_renderer <- function(renderer, strategy, dose) { attach_pev_dose_listeners <- function( variables, parameters, + pev_distribution_timesteps, dose_events, booster_events, booster_delays, booster_coverages, - booster_timed_coverage, - booster_timed_coverage_timestep, pev_profile_indices, strategy, renderer @@ -316,9 +308,8 @@ attach_pev_dose_listeners <- function( booster_events[[b]]$add_listener( create_pev_booster_listener( variables = variables, - coverage = booster_coverages[[b]], - timed_coverage = booster_timed_coverage, - timed_coverage_timestep = booster_timed_coverage_timestep, + 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, diff --git a/R/pev_parameters.R b/R/pev_parameters.R index 6648dd29..73947b29 100644 --- a/R/pev_parameters.R +++ b/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,14 +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_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 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, @@ -88,14 +85,13 @@ set_pev_epi <- function( timesteps, age, min_wait, - booster_timestep, + booster_spacing, booster_coverage, - booster_timed_coverage = NULL, - booster_timed_coverage_timestep = NULL, 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)){ @@ -107,19 +103,22 @@ set_pev_epi <- function( 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') } - if (length(booster_timed_coverage) != length(booster_timed_coverage_timestep)) { - stop("booster_coverage_timestep must be the same length as booster_coverage") + # 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 @@ -132,12 +131,9 @@ 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_timed_booster_coverage <- booster_timed_coverage - parameters$pev_epi_timed_booster_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,7 +145,7 @@ 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); @@ -157,12 +153,9 @@ set_pev_epi <- function( #' 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_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 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, @@ -172,26 +165,28 @@ set_mass_pev <- function( min_ages, max_ages, min_wait, - booster_timestep, + booster_spacing, booster_coverage, - booster_timed_coverage = NULL, - booster_timed_coverage_timestep = NULL, 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') + 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') } - if (length(booster_timed_coverage) != length(booster_timed_coverage_timestep)) { - stop("booster_coverage_timestep must be the same length as booster_coverage") + # 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 @@ -206,10 +201,8 @@ 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_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 } diff --git a/man/get_correlation_parameters.Rd b/man/get_correlation_parameters.Rd index 21995b91..068aed64 100644 --- a/man/get_correlation_parameters.Rd +++ b/man/get_correlation_parameters.Rd @@ -27,7 +27,7 @@ parameters <- set_mass_pev( min_wait = 0, min_ages = 100, max_ages = 1000, - booster_timestep = numeric(0), + booster_spacing = numeric(0), booster_coverage = numeric(0), booster_profile = NULL ) diff --git a/man/set_mass_pev.Rd b/man/set_mass_pev.Rd index e088e0bb..ef3263e5 100644 --- a/man/set_mass_pev.Rd +++ b/man/set_mass_pev.Rd @@ -12,17 +12,15 @@ set_mass_pev( min_ages, max_ages, min_wait, - booster_timestep, + booster_spacing, booster_coverage, - booster_timed_coverage = NULL, - booster_timed_coverage_timestep = NULL, booster_profile ) } \arguments{ \item{parameters}{a list of parameters to modify} -\item{profile}{primary vaccine profile of type PEVProfile} +\item{profile}{a list of details for the vaccine profile, create with \code{create_pev_profile}} \item{timesteps}{a vector of timesteps for each round of vaccinations} @@ -36,16 +34,11 @@ set_mass_pev( 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.} -\item{booster_timestep}{the timesteps (following the initial vaccination) at which booster vaccinations are administered} +\item{booster_spacing}{the timesteps (following the final primary dose) at which booster vaccinations are administered} -\item{booster_coverage}{the proportion of the vaccinated population relative to the last vaccination (whether a previous booster or the primary series)} +\item{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 \code{timesteps}. The columns of the matrix must be the same size as \code{booster_spacing}.} -\item{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 \code{booster_coverage_timestep}} - -\item{booster_timed_coverage_timestep}{a vector of timesteps to change the time varying coverage specified in \code{booster_timed_coverage}} - -\item{booster_profile}{list of booster vaccine profiles, of type -PEVProfile, for each timestep in booster_timeteps} +\item{booster_profile}{list of lists representing each booster profile, the outer list must be the same length as \code{booster_spacing}. Create vaccine profiles with \code{create_pev_profile}} } \description{ distribute pre-erythrocytic vaccine to a population in an age range. diff --git a/man/set_pev_epi.Rd b/man/set_pev_epi.Rd index 2f7e7ced..a3a4d195 100644 --- a/man/set_pev_epi.Rd +++ b/man/set_pev_epi.Rd @@ -11,10 +11,8 @@ set_pev_epi( timesteps, age, min_wait, - booster_timestep, + booster_spacing, booster_coverage, - booster_timed_coverage = NULL, - booster_timed_coverage_timestep = NULL, booster_profile, seasonal_boosters = FALSE ) @@ -22,7 +20,7 @@ set_pev_epi( \arguments{ \item{parameters}{a list of parameters to modify} -\item{profile}{primary vaccine profile of type PEVProfile} +\item{profile}{a list of details for the vaccine profile, create with \code{create_pev_profile}} \item{coverages}{a vector of coverages for the primary doses} @@ -37,19 +35,14 @@ 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.} -\item{booster_timestep}{the timesteps (following the final dose) at which booster vaccinations are administered} +\item{booster_spacing}{the timesteps (following the final primary dose) at which booster vaccinations are administered} -\item{booster_coverage}{the proportion of the vaccinated population relative to the last vaccination (whether a previous booster or the primary series)} +\item{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 \code{timesteps}. The columns of the matrix must be the same size as \code{booster_spacing}.} -\item{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 \code{booster_coverage_timestep}} - -\item{booster_timed_coverage_timestep}{a vector of timesteps to change the time varying coverage specified in \code{booster_timed_coverage}} - -\item{booster_profile}{list of booster vaccine profiles, of type -PEVProfile, for each timestep in booster_timeteps} +\item{booster_profile}{list of lists representing each booster profile, the outer list must be the same length as \code{booster_spacing}. Create vaccine profiles with \code{create_pev_profile}} \item{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} } \description{ distribute vaccine when an individual becomes a certain diff --git a/tests/testthat/test-infection-integration.R b/tests/testthat/test-infection-integration.R index 238a2ae6..0400a361 100644 --- a/tests/testthat/test-infection-integration.R +++ b/tests/testthat/test-infection-integration.R @@ -121,8 +121,8 @@ test_that('calculate_infections works various combinations of drug and vaccinati min_ages = 0, max_ages = 100 * 365, min_wait = 0, - booster_timestep = 365, - booster_coverage = 1, + booster_spacing = 365, + booster_coverage = matrix(1), booster_profile = list(rtss_booster_profile) ) diff --git a/tests/testthat/test-pev-epi.R b/tests/testthat/test-pev-epi.R index a1c718cb..56db32e7 100644 --- a/tests/testthat/test-pev-epi.R +++ b/tests/testthat/test-pev-epi.R @@ -7,8 +7,8 @@ test_that('pev epi strategy parameterisation works', { timesteps = c(10, 100), min_wait = 0, age = 5 * 30, - booster_timestep = c(18, 36) * 30, - booster_coverage = c(.9, .8), + booster_spacing = c(18, 36) * 30, + booster_coverage = matrix(c(.9, .8, .9, .8), nrow=2, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ) expect_equal(parameters$pev, TRUE) @@ -16,7 +16,7 @@ test_that('pev epi strategy parameterisation works', { expect_equal(parameters$pev_epi_timesteps, c(10, 100)) expect_equal(parameters$pev_epi_age, 5 * 30) expect_equal(parameters$pev_epi_min_wait, 0) - expect_equal(parameters$pev_epi_booster_timestep, c(18, 36) * 30) + expect_equal(parameters$pev_epi_booster_spacing, c(18, 36) * 30) expect_equal(parameters$pev_profiles, list(rtss_profile, rtss_booster_profile, rtss_booster_profile)) expect_equal(parameters$pev_epi_profile_indices, seq(3)) @@ -28,8 +28,8 @@ test_that('pev epi strategy parameterisation works', { timesteps = 10, min_wait = 0, age = 5 * 30, - booster_timestep = c(18, 36) * 30, - booster_coverage = c(.9, .8), + booster_spacing = c(18, 36) * 30, + booster_coverage = matrix(c(.9, .8, .9, .8), nrow=2, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ), "all(coverages >= 0) && all(coverages <= 1) is not TRUE", fixed = TRUE @@ -43,35 +43,16 @@ test_that('pev epi strategy parameterisation works', { timesteps = 10, min_wait = 0, age = 5 * 30, - booster_timestep = c(18, 36) * 30, - booster_coverage = c(.9, .8), + booster_spacing = c(18, 36) * 30, + booster_coverage = matrix(c(.9, .8, .9, .8), nrow=2, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ), "all(coverages >= 0) && all(coverages <= 1) is not TRUE", fixed = TRUE ) }) -test_that('I can add time varying booster coverage to the pev epi strategy', { +test_that('set_pev_epi checks booster coverage matrix shape', { 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_timed_booster_coverage, c(.5, .7)) - expect_equal(parameters$pev_epi_timed_booster_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, @@ -80,34 +61,15 @@ test_that('I can add time varying booster coverage to the pev epi strategy', { 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_spacing = c(18, 36) * 30, + booster_coverage = matrix(c(.9, .8), nrow=2, ncol=1), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ), - "booster_coverage_timestep must be the same length as booster_coverage", + 'booster_spacing, booster_coverage and booster_profile do not align', fixed = TRUE ) }) - -test_that('pev epi fails pre-emptively with unaligned booster parameters', { - parameters <- get_parameters() - expect_error( - set_pev_epi( - 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 = .9, - booster_profile = list(rtss_booster_profile, rtss_booster_profile) - ) - ) -}) - test_that('pev epi targets correct age and respects min_wait', { timestep <- 5*365 parameters <- get_parameters(list(human_population = 5)) @@ -118,8 +80,8 @@ test_that('pev epi targets correct age and respects min_wait', { coverages = 0.8, min_wait = 2*365, age = 18 * 365, - booster_timestep = c(18, 36) * 30, - booster_coverage = c(.9, .8), + booster_spacing = c(18, 36) * 30, + booster_coverage = matrix(c(.9, .8), nrow=1, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ) events <- create_events(parameters) @@ -182,8 +144,8 @@ test_that('EPI ignores individuals scheduled for mass vaccination', { 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_spacing = c(18, 36) * 30, + booster_coverage = matrix(c(.9, .8, .9, .8), nrow=2, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ) parameters <- set_pev_epi( @@ -193,8 +155,8 @@ test_that('EPI ignores individuals scheduled for mass vaccination', { coverages = 0.8, min_wait = 0, age = 18 * 365, - booster_timestep = c(18, 36) * 30, - booster_coverage = c(.9, .8), + booster_spacing = c(18, 36) * 30, + booster_coverage = matrix(c(.9, .8), nrow=1, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ) events <- create_events(parameters) @@ -251,8 +213,8 @@ test_that('pev EPI respects min_wait when scheduling seasonal boosters', { coverages = 0.8, min_wait = 6 * 30, age = 18 * 365, - booster_timestep = c(3, 12) * 30, - booster_coverage = c(.9, .8), + booster_spacing = c(3, 12) * 30, + booster_coverage = matrix(c(.9, .8), nrow=1, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile), seasonal_boosters = TRUE ) @@ -287,8 +249,8 @@ test_that('pev EPI schedules for the following year with seasonal boosters', { coverages = 0.8, min_wait = 6 * 30, age = 18 * 365, - booster_timestep = c(3, 12) * 30, - booster_coverage = c(.9, .8), + booster_spacing = c(3, 12) * 30, + booster_coverage = matrix(c(.9, .8), nrow=1, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile), seasonal_boosters = TRUE ) diff --git a/tests/testthat/test-pev.R b/tests/testthat/test-pev.R index 16f65849..11a9030b 100644 --- a/tests/testthat/test-pev.R +++ b/tests/testthat/test-pev.R @@ -8,8 +8,8 @@ test_that('Mass vaccination strategy parameterisation works', { min_wait = 0, min_ages = 5 * 30, max_ages = 17 * 30, - booster_timestep = c(18, 36) * 30, - booster_coverage = c(.9, .8), + booster_spacing = c(18, 36) * 30, + booster_coverage = matrix(c(.9, .8), nrow=1, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ) expect_equal(parameters$pev, TRUE) @@ -17,7 +17,7 @@ test_that('Mass vaccination strategy parameterisation works', { expect_equal(parameters$mass_pev_coverages, .8) expect_equal(parameters$mass_pev_min_ages, 5 * 30) expect_equal(parameters$mass_pev_max_ages, 17 * 30) - expect_equal(parameters$mass_pev_booster_timestep, c(18, 36) * 30) + expect_equal(parameters$mass_pev_booster_spacing, c(18, 36) * 30) expect_equal(parameters$pev_profiles, list(rtss_profile, rtss_booster_profile, rtss_booster_profile)) expect_equal(parameters$mass_pev_profile_indices, seq(3)) @@ -30,8 +30,8 @@ test_that('Mass vaccination strategy parameterisation works', { min_wait = 0, min_ages = 5 * 30, max_ages = 17 * 30, - booster_timestep = c(18, 36) * 30, - booster_coverage = c(.9, .8), + booster_spacing = c(18, 36) * 30, + booster_coverage = matrix(c(.9, .8), nrow=1, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ), "all(coverages >= 0) && all(coverages <= 1) is not TRUE", fixed = TRUE @@ -46,57 +46,34 @@ test_that('Mass vaccination strategy parameterisation works', { min_wait = 0, min_ages = 5 * 30, max_ages = 17 * 30, - booster_timestep = c(18, 36) * 30, - booster_coverage = c(.9, .8), + booster_spacing = c(18, 36) * 30, + booster_coverage = matrix(c(.9, .8), nrow=1, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ), "all(coverages >= 0) && all(coverages <= 1) is not TRUE", fixed = TRUE ) }) -test_that('I can add time varying booster coverage to the mass pev strategy', { +test_that('set_mass_pev checks booster coverage matrix shape', { parameters <- get_parameters() - parameters <- set_mass_pev( - parameters, - profile = rtss_profile, - timesteps = 10, - coverages = 0.8, - min_wait = 0, - min_ages = 5 * 30, - max_ages = 17 * 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$mass_pev_booster_timestep, c(18, 36) * 30) - expect_equal(parameters$mass_pev_booster_timed_coverage, c(.5, .7)) - expect_equal(parameters$mass_pev_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_mass_pev( parameters, profile = rtss_profile, - timesteps = 10, - coverages = 0.8, + coverages = c(0.1), + timesteps = c(10), min_wait = 0, min_ages = 5 * 30, max_ages = 17 * 30, - booster_timestep = c(18, 36) * 30, - booster_coverage = c(.9, .8), - booster_timed_coverage = c(.5, .7), - booster_timed_coverage_timestep = 365, + booster_spacing = c(18, 36) * 30, + booster_coverage = matrix(c(.9, .8), nrow=2, ncol=1), booster_profile = list(rtss_booster_profile, rtss_booster_profile) - ), - "booster_coverage_timestep must be the same length as booster_coverage", - fixed = TRUE - ) + ), + 'booster_spacing, booster_coverage and booster_profile do not align', + fixed = TRUE + ) }) - test_that('Mass vaccination fails pre-emptively for unaligned booster parameters', { parameters <- get_parameters() expect_error( @@ -108,8 +85,8 @@ test_that('Mass vaccination fails pre-emptively for unaligned booster parameters min_wait = 0, min_ages = 5 * 30, max_ages = 17 * 30, - booster_timestep = c(18, 36) * 30, - booster_coverage = c(.9), + booster_spacing = c(18, 36) * 30, + booster_coverage = matrix(.9, nrow=1, ncol=1), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ) ) @@ -126,8 +103,8 @@ test_that('Infection considers pev efficacy', { min_wait = 0, min_ages = 5 * 30, max_ages = 17 * 30, - booster_timestep = c(18, 36) * 30, - booster_coverage = c(.9, .8), + booster_spacing = c(18, 36) * 30, + booster_coverage = matrix(c(.9, .8), nrow=1, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ) events <- create_events(parameters) @@ -193,8 +170,8 @@ test_that('Mass vaccinations update vaccination time', { 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_spacing = c(18, 36) * 30, + booster_coverage = matrix(c(.9, .8, .9, .8), nrow=2, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ) events <- create_events(parameters) @@ -263,8 +240,8 @@ test_that('Mass vaccinations ignore EPI individuals', { 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_spacing = c(18, 36) * 30, + booster_coverage = matrix(c(.9, .8, .9, .8), nrow=2, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ) parameters <- set_pev_epi( @@ -274,8 +251,8 @@ test_that('Mass vaccinations ignore EPI individuals', { coverages = 0.8, min_wait = 2*365, age = 18 * 365, - booster_timestep = c(18, 36) * 30, - booster_coverage = c(.9, .8), + booster_spacing = c(18, 36) * 30, + booster_coverage = matrix(c(.9, .8), nrow=1, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ) events <- create_events(parameters) @@ -330,8 +307,8 @@ test_that('Mass boosters update profile params and reschedule correctly', { min_wait = 0, min_ages = c(1, 2, 3, 18) * 365, max_ages = (c(1, 2, 3, 18) + 1) * 365 - 1, - booster_timestep = c(1, 6) * 30, - booster_coverage = c(1, 1), + booster_spacing = c(1, 6) * 30, + booster_coverage = matrix(1, nrow=2, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ) events <- create_events(parameters) @@ -355,7 +332,8 @@ test_that('Mass boosters update profile params and reschedule correctly', { listener <- create_pev_booster_listener( variables = variables, - coverage = 1, + coverage = parameters$mass_pev_booster_coverage, + parameters$mass_pev_timesteps, booster_number = 1, pev_profile_index = 2, next_booster_event = events$mass_pev_boosters[[2]], @@ -406,8 +384,8 @@ test_that('Mass booster coverages sample subpopulations correctly', { min_ages = c(1, 2, 3, 18) * 365, max_ages = (c(1, 2, 3, 18) + 1) * 365 - 1, min_wait = 0, - booster_timestep = c(1, 6) * 30, - booster_coverage = c(.9, .8), + booster_spacing = c(1, 6) * 30, + booster_coverage = matrix(c(.9, .8), nrow=1, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ) @@ -432,7 +410,8 @@ test_that('Mass booster coverages sample subpopulations correctly', { listener <- create_pev_booster_listener( variables = variables, - coverage = .9, + coverage = parameters$mass_pev_booster_coverage, + pev_distribution_timesteps = parameters$mass_pev_timesteps, booster_number = 1, pev_profile_index = 2, next_booster_event = events$mass_pev_boosters[[2]], @@ -485,8 +464,8 @@ test_that('mass pev targets correct age and respects min_wait', { min_ages = 0, max_ages = 19 * 365, min_wait = 2*365, - booster_timestep = c(1, 6) * 30, - booster_coverage = c(.9, .8), + booster_spacing = c(1, 6) * 30, + booster_coverage = matrix(c(.9, .8, .9, .8), nrow=2, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ) events <- create_events(parameters) @@ -547,8 +526,8 @@ test_that('Mass efficacy listener works correctly', { min_ages = c(1, 2, 3, 18) * 365, max_ages = (c(1, 2, 3, 18) + 1) * 365 - 1, min_wait = 0, - booster_timestep = c(1, 6) * 30, - booster_coverage = c(.9, .8), + booster_spacing = c(1, 6) * 30, + booster_coverage = matrix(c(.9, .8), nrow=1, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile) ) @@ -585,8 +564,8 @@ test_that('Mass dose events are not ruined by lazy evaluation', { min_ages = c(1, 2, 3, 18) * 365, max_ages = (c(1, 2, 3, 18) + 1) * 365 - 1, min_wait = 0, - booster_timestep = c(1, 6, 12) * 30, - booster_coverage = c(.9, .8, .7), + booster_spacing = c(1, 6, 12) * 30, + booster_coverage = matrix(c(.9, .8, .7), nrow=1, ncol=3), booster_profile = list(rtss_booster_profile, rtss_booster_profile, rtss_booster_profile) ) @@ -596,12 +575,11 @@ test_that('Mass dose events are not ruined by lazy evaluation', { attach_pev_dose_listeners( variables = variables, parameters = parameters, + pev_distribution_timesteps = parameters$mass_pev_timesteps, dose_events = events$mass_pev_doses, booster_events = events$mass_pev_boosters, - booster_delays = parameters$mass_pev_booster_timestep, + booster_delays = parameters$mass_pev_booster_spacing, booster_coverages = parameters$mass_pev_booster_coverage, - booster_timed_coverage = NULL, - booster_timed_coverage_timestep = NULL, pev_profile_indices = parameters$mass_pev_profile_indices, strategy = 'mass', renderer = mock_render(1) @@ -622,8 +600,8 @@ test_that('Mass dose events are not ruined by lazy evaluation', { expect_equal( as.list(environment( events$mass_pev_boosters[[1]]$.listeners[[1]] - ))$coverage, - .9 + ))$booster_number, + 1 ) }) @@ -657,7 +635,7 @@ test_that('Efficacies are calculated correctly', { ) }) -test_that('pev timed booster coverage works with NULL', { +test_that('pev timed booster coverage can select the first coverage for the first booster', { timestep <- 5 * 365 parameters <- get_parameters(list(human_population = 5)) parameters <- set_pev_epi( @@ -667,10 +645,8 @@ test_that('pev timed booster coverage works with NULL', { coverages = 0.8, min_wait = 6 * 30, age = 18 * 365, - booster_timestep = c(3, 12) * 30, - booster_coverage = c(.9, .8), - booster_timed_coverage = c(.5, .7), - booster_timed_coverage_timestep = c(timestep, timestep + 365), + booster_spacing = c(3, 12) * 30, + booster_coverage = matrix(c(.9, .8), nrow=1, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile), ) events <- create_events(parameters) @@ -679,9 +655,8 @@ test_that('pev timed booster coverage works with NULL', { listener <- create_pev_booster_listener( variables = create_variables(parameters), - coverage = .9, - timed_coverage = NULL, - timed_coverage_timestep = NULL, + coverage = parameters$pev_epi_booster_coverage, + pev_distribution_timesteps = parameters$pev_epi_timesteps, booster_number = 1, pev_profile_index = 2, next_booster_event = booster_event, @@ -710,20 +685,18 @@ test_that('pev timed booster coverage works with NULL', { }) -test_that('pev boosters take into account the timed coverage', { +test_that('pev boosters can select the second coverage for the first booster', { timestep <- 5 * 365 parameters <- get_parameters(list(human_population = 5)) parameters <- set_pev_epi( parameters, profile = rtss_profile, - timesteps = 10, - coverages = 0.8, + timesteps = c(10, 30), + coverages = c(0.8, 0.4), min_wait = 6 * 30, age = 18 * 365, - booster_timestep = c(3, 12) * 30, - booster_coverage = c(.9, .8), - booster_timed_coverage = c(.5, .7), - booster_timed_coverage_timestep = c(timestep, timestep + 365), + booster_spacing = c(3, 12) * 30, + booster_coverage = matrix(c(.9, .45, .8, .8), nrow=2, ncol=2), booster_profile = list(rtss_booster_profile, rtss_booster_profile), ) events <- create_events(parameters) @@ -732,9 +705,8 @@ test_that('pev boosters take into account the timed coverage', { listener <- create_pev_booster_listener( variables = create_variables(parameters), - coverage = .9, - timed_coverage = c(.5, .7), - timed_coverage_timestep = c(timestep, timestep + 365), + coverage = parameters$pev_epi_booster_coverage, + pev_distribution_timesteps = parameters$pev_epi_timesteps, booster_number = 1, pev_profile_index = 2, next_booster_event = booster_event, diff --git a/vignettes/Vaccines.Rmd b/vignettes/Vaccines.Rmd index 51bffd0e..02eb9358 100644 --- a/vignettes/Vaccines.Rmd +++ b/vignettes/Vaccines.Rmd @@ -158,8 +158,8 @@ rtssmassparams <- set_mass_pev( min_wait = 0, # The minimum acceptable time since the last vaccination is 0 because in our case we are only implementing one round of vaccination. min_ages = 5 * month, # The minimum age for the target population to be vaccinated. max_ages = 50 * year, # The maximum age for the target population to be vaccinated. - booster_timestep = 12 * month, # The booster is given at 12 months after the primary series. - booster_coverage = 0.95, # Coverage of the booster dose is 95%. + booster_spacing = 12 * month, # The booster is given at 12 months after the primary series. + booster_coverage = matrix(0.95), # Coverage of the booster dose is 95%. booster_profile = list(rtss_booster_profile) # We will model implementation of the RTSS booster. ) @@ -228,8 +228,8 @@ seasmass_simparams <- set_mass_pev( min_ages = 5 * month, # The minimum age for the target population to be vaccinated. max_ages = 50 * year, # The maximum age for the target population to be vaccinated. min_wait = 0, # There is no minimum wait between the last vaccination. - booster_timestep = round(c(12 * month + 2 * month)), # The booster is given 14 months after the first dose. - booster_coverage = 1, # 100% of the vaccinated population is boosted. + booster_spacing = round(c(12 * month + 2 * month)), # The booster is given 14 months after the first dose. + booster_coverage = matrix(1), # 100% of the vaccinated population is boosted. booster_profile = list(rtss_booster_profile) # We will model implementation of the RTSS booster. ) @@ -269,8 +269,8 @@ rtssepiparams <- set_pev_epi( coverages = 1, # Vaccine coverage is 100%. min_wait = 0, # There is no minimum wait since the last vaccination. age = 5 * month, # Individuals will be vaccinated once they reach 5 months of age. - booster_timestep = 12 * month, # The booster is administered 12 months following the third dose. - booster_coverage = 0.95, # 95% of those vaccinated with the primary series will be boosted. + booster_spacing = 12 * month, # The booster is administered 12 months following the third dose. + booster_coverage = matrix(0.95), # 95% of those vaccinated with the primary series will be boosted. booster_profile = list(rtss_booster_profile) # We will model implementation of the RTSS booster. ) @@ -322,8 +322,8 @@ rtssepiseasonalparams <- set_pev_epi( coverages = 1, # Vaccine coverage is 100%. min_wait = 6 * month, # When seasonal_boosters = TRUE, this is the minimum time between an individual receiving the final dose and the first booster. age = 5 * month, # Individuals will be vaccinated once they reach 5 months of age. - booster_timestep = peak - month * 3.5 , # Because seasonal_boosters = TRUE, the timestep here is relative to the start of the year. Here, we will give a booster at 3.5 months prior to peak transmission. - booster_coverage = 0.95, # 95% of the vaccinated population is boosted. + booster_spacing = peak - month * 3.5 , # Because seasonal_boosters = TRUE, the timestep here is relative to the start of the year. Here, we will give a booster at 3.5 months prior to peak transmission. + booster_coverage = matrix(0.95), # 95% of the vaccinated population is boosted. seasonal_boosters = TRUE, # Boosters will be given based on a seasonal schedule, so the timing in the boosters= argument above will be relative to the start of the year instead of relative to the 3rd dose. booster_profile = list(rtss_booster_profile) # We will model implementation of the RTSS booster. ) @@ -362,8 +362,8 @@ rtssepiparams2 <- set_pev_epi( coverages = 1, # Vaccine coverage is 100%. age = 5 * month, # Individuals will be vaccinated once they reach 5 months of age. min_wait = 0, # When seasonal_boosters = FALSE, this is the minimum time between doses. - booster_timestep = c(12 * month, 24 * month), # Here, we are testing a strategy with 2 boosters, one at 1 year after the 3rd dose and the second 2 years after the 3rd dose. - booster_coverage = c(1, 1), # For each of the two boosters, coverage is 100%. + booster_spacing = c(12 * month, 24 * month), # Here, we are testing a strategy with 2 boosters, one at 1 year after the 3rd dose and the second 2 years after the 3rd dose. + booster_coverage = matrix(c(1, 1), nrow=1, ncol=2), # For each of the two boosters, coverage is 100%. booster_profile = list(rtss_booster_profile, rtss_booster_profile) # We will model implementation of the RTSS booster. ) From 45486addda5a53ef5f5756e84d173ac5e4185c79 Mon Sep 17 00:00:00 2001 From: Giovanni Charles Date: Tue, 9 Jan 2024 10:10:45 +0000 Subject: [PATCH 4/4] Check that booster_spacing is monotonically increasing --- R/pev_parameters.R | 15 +++++++++++++++ tests/testthat/test-pev-epi.R | 20 ++++++++++++++++++++ tests/testthat/test-pev.R | 20 ++++++++++++++++++++ 3 files changed, 55 insertions(+) diff --git a/R/pev_parameters.R b/R/pev_parameters.R index 73947b29..7edcb39c 100644 --- a/R/pev_parameters.R +++ b/R/pev_parameters.R @@ -98,6 +98,13 @@ set_pev_epi <- function( 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) @@ -178,6 +185,14 @@ set_mass_pev <- function( if (length(min_ages) != length(max_ages)) { stop('min and max ages do 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') diff --git a/tests/testthat/test-pev-epi.R b/tests/testthat/test-pev-epi.R index 56db32e7..6555700c 100644 --- a/tests/testthat/test-pev-epi.R +++ b/tests/testthat/test-pev-epi.R @@ -70,6 +70,26 @@ test_that('set_pev_epi checks booster coverage matrix shape', { ) }) +test_that('set_pev_epi checks that booster_spacing are increasing', { + parameters <- get_parameters() + 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_spacing = c(5, 5) * 30, + booster_coverage = matrix(c(.9, .8), nrow=2, ncol=1), + booster_profile = list(rtss_booster_profile, rtss_booster_profile) + ), + 'booster_spacing must be monotonically increasing', + fixed = TRUE + ) +}) + + test_that('pev epi targets correct age and respects min_wait', { 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 11a9030b..88b95b35 100644 --- a/tests/testthat/test-pev.R +++ b/tests/testthat/test-pev.R @@ -74,6 +74,26 @@ test_that('set_mass_pev checks booster coverage matrix shape', { ) }) +test_that('set_mass_pev checks booster_spacing is increasing', { + parameters <- get_parameters() + expect_error( + parameters <- set_mass_pev( + parameters, + profile = rtss_profile, + coverages = c(0.1), + timesteps = c(10), + min_wait = 0, + min_ages = 5 * 30, + max_ages = 17 * 30, + booster_spacing = c(5, 5) * 30, + booster_coverage = matrix(c(.9, .8), nrow=2, ncol=1), + booster_profile = list(rtss_booster_profile, rtss_booster_profile) + ), + 'booster_spacing must be monotonically increasing', + fixed = TRUE + ) +}) + test_that('Mass vaccination fails pre-emptively for unaligned booster parameters', { parameters <- get_parameters() expect_error(