diff --git a/DESCRIPTION b/DESCRIPTION
index 3396705b..b7aaa69a 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: malariasimulation
Title: An individual based model for malaria
-Version: 1.6.0
+Version: 2.0.0
Authors@R: c(
person(
given = "Giovanni",
@@ -70,12 +70,12 @@ Remotes:
mrc-ide/malariaEquilibrium,
mrc-ide/individual
Imports:
- individual (>= 0.1.7),
+ individual (>= 0.1.17),
malariaEquilibrium (>= 1.0.1),
Rcpp,
statmod,
MASS,
- dqrng,
+ dqrng (>= 0.4),
sitmo,
BH,
R6,
@@ -91,7 +91,7 @@ Suggests:
ggplot2,
covr,
mgcv
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
Roxygen: list(markdown = TRUE)
LinkingTo:
Rcpp,
diff --git a/NAMESPACE b/NAMESPACE
index 4fd1b1da..167c0f0e 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -13,16 +13,21 @@ export(get_parameters)
export(parameterise_mosquito_equilibrium)
export(parameterise_total_M)
export(peak_season_offset)
+export(r21_booster_profile)
+export(r21_profile)
export(rtss_booster_profile)
export(rtss_profile)
export(run_metapop_simulation)
+export(run_resumable_simulation)
export(run_simulation)
export(run_simulation_with_repetitions)
+export(set_antimalarial_resistance)
export(set_bednets)
export(set_carrying_capacity)
export(set_clinical_treatment)
export(set_demography)
export(set_drugs)
+export(set_epi_outputs)
export(set_equilibrium)
export(set_mass_pev)
export(set_mda)
diff --git a/NEWS.md b/NEWS.md
index 826bf0d0..860567da 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,10 @@
+# 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.
+ * Fix bug with min_wait. Min wait was working off of the final primary dose. It
+ now works of of the first dose.
+
# malariasimulation 1.6.0
* Fix MDA bug where undetectable asymptomatics are treated
diff --git a/R/RcppExports.R b/R/RcppExports.R
index 73a51dd0..ad658f2c 100644
--- a/R/RcppExports.R
+++ b/R/RcppExports.R
@@ -9,6 +9,14 @@ adult_mosquito_model_update <- function(model, mu, foim, susceptible, f) {
invisible(.Call(`_malariasimulation_adult_mosquito_model_update`, model, mu, foim, susceptible, f))
}
+adult_mosquito_model_save_state <- function(model) {
+ .Call(`_malariasimulation_adult_mosquito_model_save_state`, model)
+}
+
+adult_mosquito_model_restore_state <- function(model, state) {
+ invisible(.Call(`_malariasimulation_adult_mosquito_model_restore_state`, model, state))
+}
+
create_adult_solver <- function(model, init, r_tol, a_tol, max_steps) {
.Call(`_malariasimulation_create_adult_solver`, model, init, r_tol, a_tol, max_steps)
}
@@ -37,10 +45,18 @@ rainfall <- function(t, g0, g, h, floor) {
.Call(`_malariasimulation_rainfall`, t, g0, g, h, floor)
}
+exponential_process_cpp <- function(variable, rate) {
+ .Call(`_malariasimulation_exponential_process_cpp`, variable, rate)
+}
+
solver_get_states <- function(solver) {
.Call(`_malariasimulation_solver_get_states`, solver)
}
+solver_set_states <- function(solver, t, state) {
+ invisible(.Call(`_malariasimulation_solver_set_states`, solver, t, state))
+}
+
solver_step <- function(solver) {
invisible(.Call(`_malariasimulation_solver_step`, solver))
}
@@ -57,10 +73,26 @@ timeseries_push <- function(timeseries, value, timestep) {
invisible(.Call(`_malariasimulation_timeseries_push`, timeseries, value, timestep))
}
+timeseries_save_state <- function(timeseries) {
+ .Call(`_malariasimulation_timeseries_save_state`, timeseries)
+}
+
+timeseries_restore_state <- function(timeseries, state) {
+ invisible(.Call(`_malariasimulation_timeseries_restore_state`, timeseries, state))
+}
+
random_seed <- function(seed) {
invisible(.Call(`_malariasimulation_random_seed`, seed))
}
+random_save_state <- function() {
+ .Call(`_malariasimulation_random_save_state`)
+}
+
+random_restore_state <- function(state) {
+ invisible(.Call(`_malariasimulation_random_restore_state`, state))
+}
+
bernoulli_multi_p_cpp <- function(p) {
.Call(`_malariasimulation_bernoulli_multi_p_cpp`, p)
}
diff --git a/R/antimalarial_resistance.R b/R/antimalarial_resistance.R
new file mode 100644
index 00000000..121de96c
--- /dev/null
+++ b/R/antimalarial_resistance.R
@@ -0,0 +1,146 @@
+#' @title Parameterise antimalarial resistance
+#' @description
+#' Parameterise antimalarial resistance
+#'
+#' @param parameters the model parameters
+#' @param drug the index of the drug which resistance is being set, as set by the set_drugs() function, in the parameter list
+#' @param timesteps vector of time steps for each update to resistance proportion and resistance outcome probability
+#' @param artemisinin_resistance_proportion vector of updates to the proportions of infections that are artemisinin resistant at time t
+#' @param partner_drug_resistance_proportion vector of updates to the proportions of infections that are partner-drug resistant at time t
+#' @param slow_parasite_clearance_probability vector of updates to the proportion of artemisinin-resistant infections that result in early treatment failure
+#' @param early_treatment_failure_probability vector of updates to the proportion of artemisinin-resistant infections that result in slow parasite clearance
+#' @param late_clinical_failure_probability vector of updates to the proportion of partner-drug-resistant infections that result in late clinical failure
+#' @param late_parasitological_failure_probability vector of updates to the proportion of partner-drug-resistant infections that result in late parasitological failure
+#' @param reinfection_during_prophylaxis_probability vector of updates to the proportion of partner-drug-resistant infections that result in reinfection during prophylaxis
+#' @param slow_parasite_clearance_time single value representing the mean time individual's experiencing slow parasite clearance reside in the treated state
+#' @export
+set_antimalarial_resistance <- function(parameters,
+ drug,
+ timesteps,
+ artemisinin_resistance_proportion,
+ partner_drug_resistance_proportion,
+ slow_parasite_clearance_probability,
+ early_treatment_failure_probability,
+ late_clinical_failure_probability,
+ late_parasitological_failure_probability,
+ reinfection_during_prophylaxis_probability,
+ slow_parasite_clearance_time) {
+
+ if(any(partner_drug_resistance_proportion > 0,
+ late_clinical_failure_probability > 0,
+ late_parasitological_failure_probability > 0,
+ reinfection_during_prophylaxis_probability > 0)) {
+ stop("Parameters set for unimplemented feature - late clinical failure, late parasitological failure, or reinfection during prophylaxis")
+ }
+
+ if(any(c(length(artemisinin_resistance_proportion),
+ length(partner_drug_resistance_proportion),
+ length(slow_parasite_clearance_probability),
+ length(early_treatment_failure_probability),
+ length(late_clinical_failure_probability),
+ length(late_parasitological_failure_probability),
+ length(reinfection_during_prophylaxis_probability)) != length(timesteps))) {
+ stop("Length of one or more resistance parameter vectors does not match time steps specified for update")
+ }
+
+ if(any(artemisinin_resistance_proportion < 0 | artemisinin_resistance_proportion > 1 |
+ partner_drug_resistance_proportion < 0 | partner_drug_resistance_proportion > 1)) {
+ stop("Artemisinin and partner-drug resistance proportions must fall between 0 and 1")
+ }
+
+ if(any(slow_parasite_clearance_probability < 0 | slow_parasite_clearance_probability > 1 |
+ early_treatment_failure_probability < 0 | early_treatment_failure_probability > 1 |
+ late_clinical_failure_probability < 0 | late_clinical_failure_probability > 1 |
+ late_parasitological_failure_probability < 0 | late_parasitological_failure_probability > 1 |
+ reinfection_during_prophylaxis_probability < 0 | reinfection_during_prophylaxis_probability > 1)) {
+ stop("Resistance outcome probabilities must fall between 0 and 1")
+ }
+
+ if(length(slow_parasite_clearance_time) != 1) {
+ stop("Error: length of slow_parasite_clearance_time not equal to 1")
+ }
+
+ if(slow_parasite_clearance_time <= 0) {
+ stop("Error: slow_parasite_clearance_time is non-positive")
+ }
+
+ parameters$antimalarial_resistance <- TRUE
+
+ n_drugs <- length(parameters$drug_efficacy)
+
+ if (drug < 1 | drug > n_drugs) {
+ stop('Drug index is invalid, please set drugs using set_drugs')
+ }
+
+ drug_index <- which(parameters$antimalarial_resistance_drug == drug)
+
+ if (length(drug_index) == 0) {
+ drug_index <- length(parameters$antimalarial_resistance_drug) + 1
+ }
+
+ parameters$antimalarial_resistance_drug[[drug_index]] <- drug
+ parameters$antimalarial_resistance_timesteps[[drug_index]] <- timesteps
+ parameters$artemisinin_resistance_proportion[[drug_index]] <- artemisinin_resistance_proportion
+ parameters$partner_drug_resistance_proportion[[drug_index]] <- partner_drug_resistance_proportion
+ parameters$slow_parasite_clearance_probability[[drug_index]] <- slow_parasite_clearance_probability
+ parameters$early_treatment_failure_probability[[drug_index]] <- early_treatment_failure_probability
+ parameters$late_clinical_failure_probability[[drug_index]] <- late_clinical_failure_probability
+ parameters$late_parasitological_failure_probability[[drug_index]] <- late_parasitological_failure_probability
+ parameters$reinfection_during_prophylaxis_probability[[drug_index]] <- reinfection_during_prophylaxis_probability
+ parameters$dt_slow_parasite_clearance[[drug_index]] <- slow_parasite_clearance_time
+
+ return(parameters)
+
+}
+
+#' @title Retrieve resistance parameters
+#' @description
+#' Retrieve the resistance parameters associated with the drug each individual receiving clinical
+#' treatment has been administered in the current time step.
+#'
+#' @param parameters the model parameters
+#' @param drugs vector of integers representing the drugs administered to each individual receiving treatment
+#' @param timestep the current time step
+get_antimalarial_resistance_parameters <- function(parameters, drugs, timestep) {
+
+ if(!parameters$antimalarial_resistance) {
+ stop("Error: Antimalarial resistance has not been parameterised; antimalarial_resistance = FALSE")
+ }
+
+ blank_vector <- numeric(length = length(drugs))
+ artemisinin_resistance_proportion <- blank_vector
+ partner_drug_resistance_proportion <- blank_vector
+ slow_parasite_clearance_probability <- blank_vector
+ early_treatment_failure_probability <- blank_vector
+ late_clinical_failure_probability <- blank_vector
+ late_parasitological_failure_probability <- blank_vector
+ reinfection_during_prophylaxis_probability <- blank_vector
+ dt_slow_parasite_clearance <- rep(parameters$dt, length = length(drugs))
+
+ for(i in seq_along(parameters$antimalarial_resistance_drug)) {
+ drug <- parameters$antimalarial_resistance_drug[[i]]
+ treated_with_drug <- which(drugs == drug)
+ resistance_timestep <- match_timestep(ts = parameters$antimalarial_resistance_timesteps[[i]], t = timestep)
+ artemisinin_resistance_proportion[treated_with_drug] <- parameters$artemisinin_resistance_proportion[[i]][resistance_timestep]
+ partner_drug_resistance_proportion[treated_with_drug] <- parameters$partner_drug_resistance_proportion[[i]][resistance_timestep]
+ slow_parasite_clearance_probability[treated_with_drug] <- parameters$slow_parasite_clearance_probability[[i]][resistance_timestep]
+ early_treatment_failure_probability[treated_with_drug] <- parameters$early_treatment_failure_probability[[i]][resistance_timestep]
+ late_clinical_failure_probability[treated_with_drug] <- parameters$late_clinical_failure_probability[[i]][resistance_timestep]
+ late_parasitological_failure_probability[treated_with_drug] <- parameters$late_parasitological_failure_probability[[i]][resistance_timestep]
+ reinfection_during_prophylaxis_probability[treated_with_drug] <- parameters$reinfection_during_prophylaxis_probability[[i]][resistance_timestep]
+ dt_slow_parasite_clearance[treated_with_drug] <- parameters$dt_slow_parasite_clearance[[i]]
+ }
+
+ resistance_parameters <- list()
+ resistance_parameters$artemisinin_resistance_proportion <- artemisinin_resistance_proportion
+ resistance_parameters$partner_drug_resistance_proportion <- partner_drug_resistance_proportion
+ resistance_parameters$slow_parasite_clearance_probability <- slow_parasite_clearance_probability
+ resistance_parameters$early_treatment_failure_probability <- early_treatment_failure_probability
+ resistance_parameters$late_clinical_failure_probability <- late_clinical_failure_probability
+ resistance_parameters$late_parasitological_failure_probability <- late_parasitological_failure_probability
+ resistance_parameters$reinfection_during_prophylaxis_probability <- reinfection_during_prophylaxis_probability
+ resistance_parameters$dt_slow_parasite_clearance <- dt_slow_parasite_clearance
+
+ return(resistance_parameters)
+
+}
diff --git a/R/biting_process.R b/R/biting_process.R
index ec09620d..df494604 100644
--- a/R/biting_process.R
+++ b/R/biting_process.R
@@ -11,27 +11,29 @@
#' @param lagged_infectivity a list of LaggedValue objects with historical sums
#' of infectivity, one for every metapopulation
#' @param lagged_eir a LaggedValue class with historical EIRs
-#' @param mixing a vector of mixing coefficients for the lagged_infectivity
-#' values (default: 1)
+#' @param mixing_fn a function to retrieve the mixed EIR and infectivity based
+#' on the other populations
#' @param mixing_index an index for this population's position in the
#' lagged_infectivity list (default: 1)
+#' @param infection_outcome competing hazards object for infection rates
+#' @param timestep the current timestep
#' @noRd
create_biting_process <- function(
- renderer,
- solvers,
- models,
- variables,
- events,
- parameters,
- lagged_infectivity,
- lagged_eir,
- mixing = 1,
- mixing_index = 1
-) {
+ renderer,
+ solvers,
+ models,
+ variables,
+ events,
+ parameters,
+ lagged_infectivity,
+ lagged_eir,
+ mixing_fn = NULL,
+ mixing_index = 1,
+ infection_outcome
+ ) {
function(timestep) {
# Calculate combined EIR
age <- get_age(variables$birth$get_values(), timestep)
-
bitten_humans <- simulate_bites(
renderer,
solvers,
@@ -43,7 +45,7 @@ create_biting_process <- function(
timestep,
lagged_infectivity,
lagged_eir,
- mixing,
+ mixing_fn,
mixing_index
)
@@ -54,26 +56,27 @@ create_biting_process <- function(
age,
parameters,
timestep,
- renderer
+ renderer,
+ infection_outcome
)
}
}
#' @importFrom stats rpois
simulate_bites <- function(
- renderer,
- solvers,
- models,
- variables,
- events,
- age,
- parameters,
- timestep,
- lagged_infectivity,
- lagged_eir,
- mixing = 1,
- mixing_index = 1
-) {
+ renderer,
+ solvers,
+ models,
+ variables,
+ events,
+ age,
+ parameters,
+ timestep,
+ lagged_infectivity,
+ lagged_eir,
+ mixing_fn = NULL,
+ mixing_index = 1
+ ) {
bitten_humans <- individual::Bitset$new(parameters$human_population)
human_infectivity <- variables$infectivity$get_values()
@@ -103,7 +106,7 @@ simulate_bites <- function(
for (s_i in seq_along(parameters$species)) {
species_name <- parameters$species[[s_i]]
- solver_states <- solver_get_states(solvers[[s_i]])
+ solver_states <- solvers[[s_i]]$get_states()
p_bitten <- prob_bitten(timestep, variables, s_i, parameters)
Q0 <- parameters$Q0[[s_i]]
W <- average_p_successful(p_bitten$prob_bitten_survives, .pi, Q0)
@@ -111,7 +114,7 @@ simulate_bites <- function(
f <- blood_meal_rate(s_i, Z, parameters)
a <- .human_blood_meal_rate(f, s_i, W, parameters)
lambda <- effective_biting_rates(a, .pi, p_bitten)
-
+
if (parameters$individual_mosquitoes) {
species_index <- variables$species$get_index_of(
parameters$species[[s_i]]
@@ -129,16 +132,18 @@ simulate_bites <- function(
}
# store the current population's EIR for later
- lagged_eir[[mixing_index]][[s_i]]$save(n_infectious * a, timestep)
-
- # calculated the EIR for this timestep after mixing
- species_eir <- sum(
- vnapply(
- lagged_eir,
- function(l) l[[s_i]]$get(timestep - parameters$de)
- ) * mixing
+ lagged_eir[[s_i]]$save(
+ n_infectious * a,
+ timestep
)
-
+
+ # lagged EIR
+ if (is.null(mixing_fn)) {
+ species_eir <- lagged_eir[[s_i]]$get(timestep - parameters$de)
+ } else {
+ species_eir <- mixing_fn(timestep=timestep)$eir[[mixing_index, s_i]]
+ }
+
renderer$render(paste0('EIR_', species_name), species_eir, timestep)
EIR <- EIR + species_eir
expected_bites <- species_eir * mean(psi)
@@ -150,16 +155,16 @@ simulate_bites <- function(
)
}
}
-
- infectivity <- vnapply(
- lagged_infectivity,
- function(l) l$get(timestep - parameters$delay_gam)
- )
- lagged_infectivity[[mixing_index]]$save(
- sum(human_infectivity * .pi),
- timestep
- )
- foim <- calculate_foim(a, infectivity, mixing)
+
+ if (is.null(mixing_fn)) {
+ infectivity <- lagged_infectivity$get(timestep - parameters$delay_gam)
+ } else {
+ infectivity <- mixing_fn(timestep=timestep)$inf[[mixing_index]]
+ }
+
+ lagged_infectivity$save(sum(human_infectivity * .pi), timestep)
+
+ foim <- calculate_foim(a, infectivity)
renderer$render(paste0('FOIM_', species_name), foim, timestep)
mu <- death_rate(f, W, Z, s_i, parameters)
renderer$render(paste0('mu_', species_name), mu, timestep)
@@ -167,7 +172,7 @@ simulate_bites <- function(
if (parameters$individual_mosquitoes) {
# update the ODE with stats for ovoposition calculations
aquatic_mosquito_model_update(
- models[[s_i]],
+ models[[s_i]]$.model,
species_index$size(),
f,
mu
@@ -189,7 +194,7 @@ simulate_bites <- function(
)
} else {
adult_mosquito_model_update(
- models[[s_i]],
+ models[[s_i]]$.model,
mu,
foim,
solver_states[[ADULT_ODE_INDICES['Sm']]],
@@ -210,9 +215,7 @@ simulate_bites <- function(
calculate_eir <- function(species, solvers, variables, parameters, timestep) {
a <- human_blood_meal_rate(species, variables, parameters, timestep)
infectious <- calculate_infectious(species, solvers, variables, parameters)
- age <- get_age(variables$birth$get_values(), timestep)
- psi <- unique_biting_rate(age, parameters)
- infectious * a * mean(psi)
+ infectious * a
}
effective_biting_rates <- function(a, .pi, p_bitten) {
@@ -235,18 +238,17 @@ calculate_infectious <- function(species, solvers, variables, parameters) {
)
)
}
- calculate_infectious_compartmental(solver_get_states(solvers[[species]]))
+ calculate_infectious_compartmental(solvers[[species]]$get_states())
}
calculate_infectious_individual <- function(
- species,
- variables,
- infectious_index,
- adult_index,
- species_index,
- parameters
-) {
-
+ species,
+ variables,
+ infectious_index,
+ adult_index,
+ species_index,
+ parameters
+ ) {
infectious_index$copy()$and(species_index)$size()
}
@@ -302,10 +304,8 @@ unique_biting_rate <- function(age, parameters) {
#' @title Calculate the force of infection towards mosquitoes
#'
#' @param a human blood meal rate
-#' @param infectivity_sum a vector of sums of infectivity weighted by relative
-#' biting rate for each population
-#' @param mixing a vector of mixing coefficients for each population
+#' @param infectivity_sum the sum of each individual's infectivity
#' @noRd
-calculate_foim <- function(a, infectivity_sum, mixing) {
- a * sum(infectivity_sum * mixing)
+calculate_foim <- function(a, infectivity_sum) {
+ a * infectivity_sum
}
diff --git a/R/compartmental.R b/R/compartmental.R
index edba33a6..4e16c7c1 100644
--- a/R/compartmental.R
+++ b/R/compartmental.R
@@ -16,7 +16,7 @@ parameterise_mosquito_models <- function(parameters, timesteps) {
for(j in 1:length(parameters$carrying_capacity_timesteps)){
timeseries_push(
k_timeseries,
- parameters$carrying_capacity_values[j,i],
+ parameters$carrying_capacity_scalers[j,i] * k0,
parameters$carrying_capacity_timesteps[j]
)
}
@@ -50,16 +50,16 @@ parameterise_mosquito_models <- function(parameters, timesteps) {
m
)[ADULT_ODE_INDICES['Sm']]
return(
- create_adult_mosquito_model(
+ AdultMosquitoModel$new(create_adult_mosquito_model(
growth_model,
parameters$mum[[i]],
parameters$dem,
susceptible * parameters$init_foim,
parameters$init_foim
- )
+ ))
)
}
- growth_model
+ AquaticMosquitoModel$new(growth_model)
}
)
}
@@ -72,22 +72,22 @@ parameterise_solvers <- function(models, parameters) {
init <- initial_mosquito_counts(parameters, i, parameters$init_foim, m)
if (!parameters$individual_mosquitoes) {
return(
- create_adult_solver(
- models[[i]],
+ Solver$new(create_adult_solver(
+ models[[i]]$.model,
init,
parameters$r_tol,
parameters$a_tol,
parameters$ode_max_steps
- )
+ ))
)
}
- create_aquatic_solver(
- models[[i]],
+ Solver$new(create_aquatic_solver(
+ models[[i]]$.model,
init[ODE_INDICES],
parameters$r_tol,
parameters$a_tol,
parameters$ode_max_steps
- )
+ ))
}
)
}
@@ -103,7 +103,7 @@ create_compartmental_rendering_process <- function(renderer, solvers, parameters
counts <- rep(0, length(indices))
for (s_i in seq_along(solvers)) {
if (parameters$species_proportions[[s_i]] > 0) {
- row <- solver_get_states(solvers[[s_i]])
+ row <- solvers[[s_i]]$get_states()
} else {
row <- rep(0, length(indices))
}
@@ -128,8 +128,67 @@ create_solver_stepping_process <- function(solvers, parameters) {
function(timestep) {
for (i in seq_along(solvers)) {
if (parameters$species_proportions[[i]] > 0) {
- solver_step(solvers[[i]])
+ solvers[[i]]$step()
}
}
}
}
+
+Solver <- R6::R6Class(
+ 'Solver',
+ private = list(
+ .solver = NULL
+ ),
+ public = list(
+ initialize = function(solver) {
+ private$.solver <- solver
+ },
+ step = function() {
+ solver_step(private$.solver)
+ },
+ get_states = function() {
+ solver_get_states(private$.solver)
+ },
+
+ # This is the same as `get_states`, just exposed under the interface that
+ # is expected of stateful objects.
+ save_state = function() {
+ solver_get_states(private$.solver)
+ },
+ restore_state = function(t, state) {
+ solver_set_states(private$.solver, t, state)
+ }
+ )
+)
+
+AquaticMosquitoModel <- R6::R6Class(
+ 'AquaticMosquitoModel',
+ public = list(
+ .model = NULL,
+ initialize = function(model) {
+ self$.model <- model
+ },
+
+ # The aquatic mosquito model doesn't have any state to save or restore (the
+ # state of the ODE is stored separately). We still provide these methods to
+ # conform to the expected interface.
+ save_state = function() { NULL },
+ restore_state = function(t, state) { }
+ )
+)
+
+AdultMosquitoModel <- R6::R6Class(
+ 'AdultMosquitoModel',
+ public = list(
+ .model = NULL,
+ initialize = function(model) {
+ self$.model <- model
+ },
+ save_state = function() {
+ adult_mosquito_model_save_state(self$.model)
+ },
+ restore_state = function(t, state) {
+ adult_mosquito_model_restore_state(self$.model, state)
+ }
+ )
+)
diff --git a/R/competing_hazards.R b/R/competing_hazards.R
new file mode 100644
index 00000000..13c522ad
--- /dev/null
+++ b/R/competing_hazards.R
@@ -0,0 +1,95 @@
+## Define classes to resolve competing hazards
+CompetingOutcome <- R6::R6Class(
+ "CompetingOutcome",
+ private = list(
+ targeted_process = NULL
+ ),
+ public = list(
+ initialize = function(targeted_process, size){
+ if (!is.function(targeted_process)){
+ stop("targeted_process must be a function")
+ }
+ if (!is.numeric(size) || size <= 0){
+ stop("size must be positive integer")
+ }
+ private$targeted_process <- targeted_process
+
+ self$target <- individual::Bitset$new(size)
+ self$rates <- NULL
+ },
+ set_rates = function(target, rates){
+ stopifnot(target$size() == length(rates))
+
+ self$target$copy_from(target)
+ self$rates <- rates
+ },
+ execute = function(t, target){
+ private$targeted_process(t, target)
+ },
+ reset = function() {
+ self$target$clear()
+ self$rates <- NULL
+ },
+ target = NULL,
+ rates = NULL
+ )
+)
+
+CompetingHazard <- R6::R6Class(
+ "CompetingHazard",
+ private = list(
+ size = NULL,
+ outcomes = list(),
+ # RNG is passed in because mockery is not able to stub runif
+ # TODO: change when fixed
+ rng = NULL
+ ),
+ public = list(
+ initialize = function(size, outcomes, rng = runif){
+ if (length(outcomes) == 0){
+ stop("At least one outcome must be provided")
+ }
+ if (!all(sapply(outcomes, function(x) inherits(x, "CompetingOutcome")))){
+ stop("All outcomes must be of class CompetingOutcome")
+ }
+ private$size <- size
+ private$outcomes <- outcomes
+ private$rng <- rng
+ },
+ resolve = function(t){
+ candidates <- individual::Bitset$new(private$size)
+ for (o in private$outcomes) {
+ candidates$or(o$target)
+ }
+
+ rates <- matrix(ncol = length(private$outcomes), nrow = candidates$size(), 0)
+ for (i in seq_along(private$outcomes)) {
+ idx <- bitset_index(
+ candidates,
+ private$outcomes[[i]]$target)
+
+ rates[idx, i] <- private$outcomes[[i]]$rates
+ }
+
+ total_rates <- rowSums(rates)
+ probs <- rate_to_prob(total_rates) * (rates / total_rates)
+ probs[is.na(probs)] <- 0
+
+ rng <- private$rng(candidates$size())
+
+ cumulative <- rep(0, candidates$size())
+
+ for (o in seq_along(private$outcomes)) {
+ next_cumulative <- cumulative + probs[,o]
+ selected <- (rng > cumulative) & (rng <= next_cumulative)
+ cumulative <- next_cumulative
+
+ target <- bitset_at(candidates, selected)
+ if (target$size() > 0) {
+ private$outcomes[[o]]$execute(t, target)
+ }
+ private$outcomes[[o]]$reset()
+ }
+ }
+ )
+)
diff --git a/R/correlation.R b/R/correlation.R
index 41ea6a82..bb98fb3b 100644
--- a/R/correlation.R
+++ b/R/correlation.R
@@ -9,7 +9,26 @@ INTS <- c(
)
#' Class: Correlation parameters
-#' Describes an event in the simulation
+#'
+#' This class implements functionality that allows interventions to be
+#' correlated, positively or negatively. By default, interventions are applied
+#' independently and an individual's probability of receiving two interventions
+#' (either two separate interventions or two rounds of the same one) is the
+#' product of the probability of receiving each one.
+#'
+#' By setting a positive correlation between two interventions, we can make it
+#' so that the individuals that receive intervention A are more likely to
+#' receive intervention B. Conversely, a negative correlation will make it such
+#' that individuals that receive intervention A are less likely to also receive
+#' intervention B.
+#'
+#' Broadly speaking, the implementation works by assigning at startup a weight
+#' to each individual and intervention pair, reflecting how likely an individual
+#' is to receive that intervention. Those weights are derived stochastically
+#' from the configured correlation parameters.
+#'
+#' For a detailed breakdown of the calculations, see Protocol S2 of
+#' Griffin et al. (2010).
CorrelationParameters <- R6::R6Class(
'CorrelationParameters',
private = list(
@@ -19,16 +38,49 @@ CorrelationParameters <- R6::R6Class(
rho_matrix = NULL,
rho = function() diag(private$rho_matrix),
.sigma = NULL,
- .mvnorm = NULL
+ .mvnorm = NULL,
+
+ #' Derive the mvnorm from the configured correlations.
+ #'
+ #' If a \code{restored_mvnorm} is specified, its columns (corresponding to
+ #' restored interventions) will be re-used as is. Missing columns (for new
+ #' interventions) are derived in accordance with the restored data.
+ calculate_mvnorm = function(restored_mvnorm = matrix(ncol=0, nrow=private$population)) {
+ sigma <- self$sigma()
+ V <- outer(sigma, sigma) * private$rho_matrix
+ diag(V) <- sigma ^ 2
+
+ restored_interventions <- match(colnames(restored_mvnorm), private$interventions)
+ new_interventions <- setdiff(seq_along(private$interventions), restored_interventions)
+
+ mvnorm <- matrix(
+ nrow = private$population,
+ ncol = length(private$interventions),
+ dimnames = list(NULL, private$interventions)
+ )
+ mvnorm[,restored_interventions] <- restored_mvnorm
+ if (length(new_interventions) > 0) {
+ mvnorm[,new_interventions] <- rcondmvnorm(
+ private$population,
+ mean = rep(0, length(private$interventions)),
+ sigma = V,
+ given = restored_mvnorm,
+ dependent.ind = new_interventions,
+ given.ind = restored_interventions
+ )
+ }
+
+ mvnorm
+ }
),
public = list(
#' @description initialise correlation parameters
- #' @param parameters model parameters
- initialize = function(parameters) {
- # Find a list of enabled interventions
- enabled <- vlapply(INTS, function(name) parameters[[name]])
- private$interventions <- INTS[enabled]
+ #' @param population popularion size
+ #' @param interventions character vector with the name of enabled interventions
+ initialize = function(population, interventions) {
+ private$population <- population
+ private$interventions <- interventions
# Initialise a rho matrix for our interventions
n_ints <- private$n_ints()
@@ -38,9 +90,6 @@ CorrelationParameters <- R6::R6Class(
ncol = n_ints,
dimnames = list(private$interventions, private$interventions)
)
-
- # Store population for mvnorm draws
- private$population <- parameters$human_population
},
#' @description Add rho between rounds
@@ -48,6 +97,8 @@ CorrelationParameters <- R6::R6Class(
#' @param rho value between 0 and 1 representing the correlation between rounds of
#' the intervention
inter_round_rho = function(int, rho) {
+ stopifnot(is.null(private$.sigma) && is.null(private$.mvnorm))
+
if (!(int %in% private$interventions)) {
stop(paste0('invalid intervention name: ', int))
}
@@ -58,8 +109,6 @@ CorrelationParameters <- R6::R6Class(
rho <- 1 - .Machine$double.eps
}
private$rho_matrix[[int, int]] <- rho
- private$.sigma <- NULL
- private$.mvnorm <- NULL
},
#' @description Add rho between interventions
@@ -69,6 +118,8 @@ CorrelationParameters <- R6::R6Class(
#' @param rho value between -1 and 1 representing the correlation between rounds of
#' the intervention
inter_intervention_rho = function(int_1, int_2, rho) {
+ stopifnot(is.null(private$.sigma) && is.null(private$.mvnorm))
+
if (!(int_1 %in% private$interventions)) {
stop(paste0('invalid intervention name: ', int_1))
}
@@ -86,8 +137,6 @@ CorrelationParameters <- R6::R6Class(
}
private$rho_matrix[[int_1, int_2]] <- rho
private$rho_matrix[[int_2, int_1]] <- rho
- private$.sigma <- NULL
- private$.mvnorm <- NULL
},
#' @description Standard deviation of each intervention between rounds
@@ -101,20 +150,36 @@ CorrelationParameters <- R6::R6Class(
},
#' @description multivariate norm draws for these parameters
- #' @importFrom MASS mvrnorm
mvnorm = function() {
if (is.null(private$.mvnorm)) {
- sigma <- self$sigma()
- V <- outer(sigma, sigma) * private$rho_matrix
- diag(V) <- sigma ^ 2
- private$.mvnorm <- mvrnorm(
- private$population,
- rep(0, length(private$interventions)),
- V
- )
- dimnames(private$.mvnorm)[[2]] <- private$interventions
+ private$.mvnorm <- private$calculate_mvnorm()
}
private$.mvnorm
+ },
+
+ #' @description Save the correlation state.
+ save_state = function() {
+ # mvnorm is sampled at random lazily on its first use. We need to save it
+ # in order to restore the same value when resuming the simulation,
+ # otherwise we would be drawing a new, probably different, value.
+ # The rest of the object is derived deterministically from the parameters
+ # and does not need saving.
+ list(mvnorm=self$mvnorm())
+ },
+
+ #' @description Restore the correlation state.
+ #'
+ #' Only the randomly drawn weights are restored. The object needs to be
+ #' initialized with the same rhos.
+ #'
+ #' @param timestep the timestep at which simulation is resumed. This
+ #' parameter's value is ignored, it only exists to conform to a uniform
+ #' interface.
+ #' @param state a previously saved correlation state, as returned by the
+ #' save_state method.
+ restore_state = function(timestep, state) {
+ stopifnot(is.null(private$.sigma) && is.null(private$.mvnorm))
+ private$.mvnorm <- private$calculate_mvnorm(state$mvnorm)
}
)
)
@@ -139,7 +204,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
#' )
@@ -164,7 +229,10 @@ CorrelationParameters <- R6::R6Class(
#'
#' # You can now pass the correlation parameters to the run_simulation function
get_correlation_parameters <- function(parameters) {
- CorrelationParameters$new(parameters)
+ # Find a list of enabled interventions
+ enabled <- vlapply(INTS, function(name) parameters[[name]])
+
+ CorrelationParameters$new(parameters$human_population, INTS[enabled])
}
#' @title Sample a population to intervene in given the correlation parameters
@@ -181,3 +249,85 @@ sample_intervention <- function(target, intervention, p, correlations) {
z <- rnorm(length(target))
u0 + correlations$mvnorm()[target, intervention] + z < 0
}
+
+#' Simulate from a conditional multivariate normal distribution.
+#'
+#' Given a multidimensional variable Z which follows a multivariate normal
+#' distribution, this function allows one to draw samples for a subset of Z,
+#' while putting conditions on the values of the rest of Z.
+#'
+#' This effectively allows one to grow a MVN distributed matrix (with columns as
+#' the dimensions and a row per sampled vector), adding new dimensions after the
+#' fact. The existing columns are used as the condition set on the distribution,
+#' and the values returned by this function are used as the new dimensions.
+#'
+#' The maths behind the implementation are described in various online sources:
+#' - https://statproofbook.github.io/P/mvn-cond.html
+#' - https://www.stats.ox.ac.uk/~doucet/doucet_simulationconditionalgaussian.pdf
+#' - https://en.wikipedia.org/wiki/Multivariate_normal_distribution#Conditional_distributions
+#'
+#' @param n the number of samples to simulate
+#' @param mean the mean vector of the distribution, including both given and
+#' dependent variables
+#' @param sigma the variance-covariance matrix of the distribution, including
+#' both given and dependent variables
+#' @param given a matrix of given values used as conditions when simulating the
+#' distribution. The matrix should have \code{n} rows, each one specifying a
+#' different set of values for the given variables.
+#' @param dependent.ind the indices within \code{mean} and \code{sigma} of the
+#' variables to simulate.
+#' @param given.ind the indices within \code{mean} and \code{sigma} of the
+#' variables for which conditions are given. The length of this vector must be
+#' equal to the number of columns of the \code{given} matrix. If empty or NULL,
+#' this function is equivalent to simulating from an unconditional multivariate
+#' normal distribution.
+#' @return a matrix with \code{n} rows and \code{length(dependent.ind)} columns,
+#' containing the simulated value.
+#' @importFrom MASS mvrnorm
+#' @noRd
+rcondmvnorm <- function(n, mean, sigma, given, dependent.ind, given.ind) {
+ stopifnot(length(mean) == nrow(sigma))
+ stopifnot(length(mean) == ncol(sigma))
+ stopifnot(nrow(given) == n)
+ stopifnot(ncol(given) == length(given.ind))
+
+ sigma11 <- sigma[dependent.ind, dependent.ind, drop=FALSE]
+ sigma12 <- sigma[dependent.ind, given.ind, drop=FALSE]
+ sigma21 <- sigma[given.ind, dependent.ind, drop=FALSE]
+ sigma22 <- sigma[given.ind, given.ind, drop=FALSE]
+
+ if (all(sigma22 == 0)) {
+ # This covers two cases: there were no given variables and therefore their
+ # variance-covariance matrix is empty, or there were given variables but
+ # they had a variance of zero. The general formula can't support the latter
+ # case since it tries to invert the matrix, but we can safely ignore the
+ # values since they are all equal to their mean and don't influence the
+ # dependent variables.
+ #
+ # In both cases we revert to a standard MVN with no condition.
+ mvrnorm(n, mean[dependent.ind], sigma11)
+ } else {
+ # Available implementations of the conditional multivariate normal assume
+ # every sample is drawn using the same condition on the given variables.
+ # This is not true in our usecase, where every individual has already had an
+ # independent vector of values drawn for the given variable. We are
+ # effectively drawing from as many different distributions as there are
+ # individuals. Thankfully the same conditional covariance matrix can be
+ # used for all the distributions, only the mean vector needs to be
+ # different. We draw the underlying samples from the MVN at mean 0, and
+ # offset that later on a per-individual basis.
+ #
+ # To work over all the vectors directly they need to be as columns, which
+ # is why we start by transposing `given`. R will recycle the `m` matrix and
+ # `mean` vectors across all the columns. The last step is to transpose the
+ # result back into the expected configuration.
+
+ m <- sigma12 %*% solve(sigma22)
+ residual <- t(given) - mean[given.ind]
+ cond_mu <- t(m %*% residual + mean[dependent.ind])
+ cond_sigma <- sigma11 - m %*% sigma21
+
+ samples <- mvrnorm(n, rep(0, length(dependent.ind)), cond_sigma)
+ samples + cond_mu
+ }
+}
diff --git a/R/disease_progression.R b/R/disease_progression.R
index 05367252..98710c44 100644
--- a/R/disease_progression.R
+++ b/R/disease_progression.R
@@ -1,3 +1,70 @@
+#' @title Calculate disease progression rates
+#' @description Calculates disease progression rates for each individual in the population
+#' for storage in competing hazards object and subsequent resolution
+#'
+#' @param variables the available human variables
+#' @param progression_outcome competing hazards object for disease progression rates
+#' @noRd
+create_progression_rates_process <- function(
+ variables,
+ progression_outcome
+) {
+ function(timestep){
+ target <- variables$state$get_index_of("S")$not()
+ progression_outcome$set_rates(
+ target,
+ variables$progression_rates$get_values(target))
+ }
+}
+
+
+#' @title Disease progression outcomes
+#' @description Following resolution of competing hazards, update state and
+#' infectivity of sampled individuals
+#'
+#' @param timestep the current timestep
+#' @param target the sampled progressing individuals
+#' @param variables the available human variables
+#' @param parameters model parameters
+#' @param renderer competing hazards object for disease progression rates
+#' @noRd
+progression_outcome_process <- function(
+ timestep,
+ target,
+ variables,
+ parameters,
+ renderer
+){
+
+ update_to_asymptomatic_infection(
+ variables,
+ parameters,
+ timestep,
+ variables$state$get_index_of("D")$and(target)
+ )
+
+ update_infection(
+ variables$state,
+ "U",
+ variables$infectivity,
+ parameters$cu,
+ variables$progression_rates,
+ 1/parameters$du,
+ variables$state$get_index_of("A")$and(target)
+ )
+
+ update_infection(
+ variables$state,
+ "S",
+ variables$infectivity,
+ 0,
+ variables$progression_rates,
+ 0,
+ variables$state$get_index_of(c("U","Tr"))$and(target)
+ )
+
+}
+
#' @title Update the state of an individual as infection events occur
#' @description Randomly moves individuals towards the later stages of disease
#' and updates their infectivity
@@ -6,53 +73,21 @@
#' @param to_state the destination disease state
#' @param infectivity the handle for the infectivity variable
#' @param new_infectivity the new infectivity of the progressed individuals
+#' @param progression_rates the handle for the progression_rates variable
+#' @param new_progression the new disease progression rate of the progressed individuals
#' @noRd
update_infection <- function(
- state,
- to_state,
- infectivity,
- new_infectivity,
- to_move
- ) {
+ state,
+ to_state,
+ infectivity,
+ new_infectivity,
+ progression_rates,
+ new_progression_rate,
+ to_move
+) {
state$queue_update(to_state, to_move)
infectivity$queue_update(new_infectivity, to_move)
-}
-
-create_progression_process <- function(
- state,
- from_state,
- to_state,
- rate,
- infectivity,
- new_infectivity
- ) {
- function(timestep) {
- to_move <- state$get_index_of(from_state)$sample(1/rate)
- update_infection(
- state,
- to_state,
- infectivity,
- new_infectivity,
- to_move
- )
- }
-}
-
-create_asymptomatic_progression_process <- function(
- state,
- rate,
- variables,
- parameters
- ) {
- function(timestep) {
- to_move <- state$get_index_of('D')$sample(1/rate)
- update_to_asymptomatic_infection(
- variables,
- parameters,
- timestep,
- to_move
- )
- }
+ progression_rates$queue_update(new_progression_rate, to_move)
}
#' @title Modelling the progression to asymptomatic disease
@@ -63,11 +98,11 @@ create_asymptomatic_progression_process <- function(
#' @param parameters model parameters
#' @noRd
update_to_asymptomatic_infection <- function(
- variables,
- parameters,
- timestep,
- to_move
- ) {
+ variables,
+ parameters,
+ timestep,
+ to_move
+) {
if (to_move$size() > 0) {
variables$state$queue_update('A', to_move)
new_infectivity <- asymptomatic_infectivity(
@@ -82,5 +117,9 @@ update_to_asymptomatic_infection <- function(
new_infectivity,
to_move
)
+ variables$progression_rates$queue_update(
+ 1/parameters$da,
+ to_move
+ )
}
}
diff --git a/R/events.R b/R/events.R
index 879d72bd..de0c7c1f 100644
--- a/R/events.R
+++ b/R/events.R
@@ -1,11 +1,11 @@
create_events <- function(parameters) {
events <- list(
# MDA events
- mda_administer = individual::Event$new(),
- smc_administer = individual::Event$new(),
+ mda_administer = individual::Event$new(restore=FALSE),
+ smc_administer = individual::Event$new(restore=FALSE),
# TBV event
- tbv_vaccination = individual::Event$new(),
+ tbv_vaccination = individual::Event$new(restore=FALSE),
# Bednet events
throw_away_net = individual::TargetedEvent$new(parameters$human_population)
@@ -18,10 +18,10 @@ 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()
+ events$mass_pev <- individual::Event$new(restore=FALSE)
events$mass_pev_doses <- mass_pev_doses
events$mass_pev_boosters <- mass_pev_boosters
}
@@ -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
@@ -63,16 +63,16 @@ initialise_events <- function(events, variables, parameters) {
# Initialise scheduled interventions
if (!is.null(parameters$mass_pev_timesteps)) {
- events$mass_pev$schedule(parameters$mass_pev_timesteps[[1]] - 1)
+ events$mass_pev$schedule(parameters$mass_pev_timesteps - 1)
}
if (parameters$mda) {
- events$mda_administer$schedule(parameters$mda_timesteps[[1]] - 1)
+ events$mda_administer$schedule(parameters$mda_timesteps - 1)
}
if (parameters$smc) {
- events$smc_administer$schedule(parameters$smc_timesteps[[1]] - 1)
+ events$smc_administer$schedule(parameters$smc_timesteps - 1)
}
if (parameters$tbv) {
- events$tbv_vaccination$schedule(parameters$tbv_timesteps[[1]] - 1)
+ events$tbv_vaccination$schedule(parameters$tbv_timesteps - 1)
}
}
@@ -129,9 +129,10 @@ 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_profile_indices,
'mass',
@@ -143,9 +144,10 @@ 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_profile_indices,
'epi',
@@ -156,7 +158,6 @@ attach_event_listeners <- function(
if (parameters$mda == 1) {
events$mda_administer$add_listener(create_mda_listeners(
variables,
- events$mda_administer,
parameters$mda_drug,
parameters$mda_timesteps,
parameters$mda_coverages,
@@ -172,7 +173,6 @@ attach_event_listeners <- function(
if (parameters$smc == 1) {
events$smc_administer$add_listener(create_mda_listeners(
variables,
- events$smc_administer,
parameters$smc_drug,
parameters$smc_timesteps,
parameters$smc_coverages,
diff --git a/R/human_infection.R b/R/human_infection.R
index b623a2d8..ae2cfe97 100644
--- a/R/human_infection.R
+++ b/R/human_infection.R
@@ -1,23 +1,26 @@
#' @title Simulate malaria infection in humans
#' @description
-#' Updates human states and variables to represent asymptomatic/clinical/severe
-#' and treated malaria; and resulting boosts in immunity
+#' This function ends with the assignment of rates of infection to the competing
+#' hazard resolution object and boosts immunity given infectious bites.
#' @param variables a list of all of the model variables
#' @param events a list of all of the model events
#' @param bitten_humans a bitset of bitten humans
#' @param age of each human (timesteps)
#' @param parameters of the model
#' @param timestep current timestep
+#' @param renderer the model renderer object
+#' @param infection_outcome competing hazards object for infection rates
#' @noRd
simulate_infection <- function(
- variables,
- events,
- bitten_humans,
- age,
- parameters,
- timestep,
- renderer
- ) {
+ variables,
+ events,
+ bitten_humans,
+ age,
+ parameters,
+ timestep,
+ renderer,
+ infection_outcome
+) {
if (bitten_humans$size() > 0) {
boost_immunity(
variables$ib,
@@ -29,70 +32,18 @@ simulate_infection <- function(
}
# Calculate Infected
- infected_humans <- calculate_infections(
+ calculate_infections(
variables,
bitten_humans,
parameters,
renderer,
- timestep
- )
-
- if (infected_humans$size() > 0) {
- boost_immunity(
- variables$ica,
- infected_humans,
- variables$last_boosted_ica,
- timestep,
- parameters$uc
- )
- boost_immunity(
- variables$id,
- infected_humans,
- variables$last_boosted_id,
- timestep,
- parameters$ud
- )
- }
-
- clinical_infections <- calculate_clinical_infections(
- variables,
- infected_humans,
- parameters,
- renderer,
- timestep
- )
-
- update_severe_disease(
timestep,
- infected_humans,
- variables,
- parameters,
- renderer
- )
-
- treated <- calculate_treated(
- variables,
- clinical_infections,
- parameters,
- timestep,
- renderer
- )
-
- renderer$render('n_infections', infected_humans$size(), timestep)
-
- schedule_infections(
- variables,
- clinical_infections,
- treated,
- infected_humans,
- parameters,
- timestep
+ infection_outcome
)
}
#' @title Calculate overall infections for bitten humans
-#' @description
-#' Sample infected humans given prophylaxis and vaccination
+#' @description Infection rates are stored in the infection outcome competing hazards object
#' @param variables a list of all of the model variables
#' @param bitten_humans bitset of bitten humans
#' @param parameters model parameters
@@ -100,12 +51,13 @@ simulate_infection <- function(
#' @param timestep current timestep
#' @noRd
calculate_infections <- function(
- variables,
- bitten_humans,
- parameters,
- renderer,
- timestep
- ) {
+ variables,
+ bitten_humans,
+ parameters,
+ renderer,
+ timestep,
+ infection_outcome
+) {
source_humans <- variables$state$get_index_of(
c('S', 'A', 'U'))$and(bitten_humans)
@@ -129,9 +81,10 @@ calculate_infections <- function(
# calculate vaccine efficacy
vaccine_efficacy <- rep(0, length(source_vector))
- vaccine_times <- variables$pev_timestep$get_values(source_vector)
- vaccinated <- vaccine_times > -1
+ vaccine_times <- variables$last_eff_pev_timestep$get_values(source_vector)
pev_profile <- variables$pev_profile$get_values(source_vector)
+ # get vector of individuals who have received their 3rd dose
+ vaccinated <- vaccine_times > -1
pev_profile <- pev_profile[vaccinated]
if (length(vaccinated) > 0) {
antibodies <- calculate_pev_antibodies(
@@ -154,21 +107,105 @@ calculate_infections <- function(
}
prob <- b * (1 - prophylaxis) * (1 - vaccine_efficacy)
- infected <- bitset_at(source_humans, bernoulli_multi_p(prob))
- incidence_renderer(
+ ## probability of incidence must be rendered at each timestep
+ incidence_probability_renderer(
variables$birth,
renderer,
- infected,
source_humans,
prob,
+ "inc_",
+ parameters$incidence_min_ages,
+ parameters$incidence_max_ages,
+ timestep
+ )
+
+ ## capture infection rates to resolve in competing hazards
+ infection_outcome$set_rates(
+ source_humans,
+ prob_to_rate(prob))
+}
+
+#' @title Assigns infections to appropriate human states
+#' @description
+#' Updates human states and variables to represent asymptomatic/clinical/severe
+#' and treated malaria; and resulting boosts in immunity
+#' @param timestep current timestep
+#' @param infected_humans bitset of infected humans
+#' @param variables a list of all of the model variables
+#' @param renderer model render object
+#' @param parameters model parameters
+#' @param prob vector of population probabilities of infection
+#' @noRd
+infection_outcome_process <- function(
+ timestep,
+ infected_humans,
+ variables,
+ renderer,
+ parameters,
+ prob){
+
+ incidence_renderer(
+ variables$birth,
+ renderer,
+ infected_humans,
'inc_',
parameters$incidence_rendering_min_ages,
parameters$incidence_rendering_max_ages,
timestep
)
-
- infected
+
+ if (infected_humans$size() > 0) {
+ boost_immunity(
+ variables$ica,
+ infected_humans,
+ variables$last_boosted_ica,
+ timestep,
+ parameters$uc
+ )
+ boost_immunity(
+ variables$id,
+ infected_humans,
+ variables$last_boosted_id,
+ timestep,
+ parameters$ud
+ )
+ }
+
+ clinical_infections <- calculate_clinical_infections(
+ variables,
+ infected_humans,
+ parameters,
+ renderer,
+ timestep
+ )
+
+ update_severe_disease(
+ timestep,
+ infected_humans,
+ variables,
+ parameters,
+ renderer
+ )
+
+ treated <- calculate_treated(
+ variables,
+ clinical_infections,
+ parameters,
+ timestep,
+ renderer
+ )
+
+ renderer$render('n_infections', infected_humans$size(), timestep)
+
+ schedule_infections(
+ variables,
+ clinical_infections,
+ treated,
+ infected_humans,
+ parameters,
+ timestep
+ )
}
#' @title Calculate clinical infections
@@ -181,12 +218,12 @@ calculate_infections <- function(
#' @param timestep current timestep
#' @noRd
calculate_clinical_infections <- function(
- variables,
- infections,
- parameters,
- renderer,
- timestep
- ) {
+ variables,
+ infections,
+ parameters,
+ renderer,
+ timestep
+) {
ica <- variables$ica$get_values(infections)
icm <- variables$icm$get_values(infections)
phi <- clinical_immunity(ica, icm, parameters)
@@ -195,6 +232,14 @@ calculate_clinical_infections <- function(
variables$birth,
renderer,
clinical_infections,
+ 'inc_clinical_',
+ parameters$clinical_incidence_rendering_min_ages,
+ parameters$clinical_incidence_rendering_max_ages,
+ timestep
+ )
+ incidence_probability_renderer(
+ variables$birth,
+ renderer,
infections,
phi,
'inc_clinical_',
@@ -215,12 +260,12 @@ calculate_clinical_infections <- function(
#' @param renderer model outputs
#' @noRd
update_severe_disease <- function(
- timestep,
- infections,
- variables,
- parameters,
- renderer
- ) {
+ timestep,
+ infections,
+ variables,
+ parameters,
+ renderer
+) {
age <- get_age(variables$birth$get_values(infections), timestep)
iva <- variables$iva$get_values(infections)
ivm <- variables$ivm$get_values(infections)
@@ -236,6 +281,14 @@ update_severe_disease <- function(
variables$birth,
renderer,
severe_infections,
+ 'inc_severe_',
+ parameters$severe_incidence_rendering_min_ages,
+ parameters$severe_incidence_rendering_max_ages,
+ timestep
+ )
+ incidence_probability_renderer(
+ variables$birth,
+ renderer,
infections,
theta,
'inc_severe_',
@@ -262,23 +315,27 @@ update_severe_disease <- function(
#' @param renderer simulation renderer
#' @noRd
calculate_treated <- function(
- variables,
- clinical_infections,
- parameters,
- timestep,
- renderer
- ) {
+ variables,
+ clinical_infections,
+ parameters,
+ timestep,
+ renderer
+) {
+
+ if(clinical_infections$size() == 0) {
+ return(individual::Bitset$new(parameters$human_population))
+ }
+
treatment_coverages <- get_treatment_coverages(parameters, timestep)
ft <- sum(treatment_coverages)
-
+
if (ft == 0) {
return(individual::Bitset$new(parameters$human_population))
}
-
+
renderer$render('ft', ft, timestep)
seek_treatment <- sample_bitset(clinical_infections, ft)
n_treat <- seek_treatment$size()
-
renderer$render('n_treated', n_treat, timestep)
drugs <- as.numeric(parameters$clinical_treatment_drugs[
@@ -289,27 +346,124 @@ calculate_treated <- function(
replace = TRUE
)
])
-
- successful <- bernoulli_multi_p(parameters$drug_efficacy[drugs])
- treated_index <- bitset_at(seek_treatment, successful)
-
- # Update those who have been treated
- if (treated_index$size() > 0) {
- variables$state$queue_update('Tr', treated_index)
- variables$infectivity$queue_update(
- parameters$cd * parameters$drug_rel_c[drugs[successful]],
- treated_index
+
+ successfully_treated <- calculate_successful_treatments(
+ parameters,
+ seek_treatment,
+ drugs,
+ timestep,
+ renderer,
+ ""
+ )
+
+ if (successfully_treated$successfully_treated$size() > 0) {
+
+ if(parameters$antimalarial_resistance) {
+ dt_update_vector <- successfully_treated$dt_spc_combined
+ } else {
+ dt_update_vector <- parameters$dt
+ }
+
+ update_infection(
+ variables$state,
+ 'Tr',
+ variables$infectivity,
+ parameters$cd * parameters$drug_rel_c[successfully_treated$drugs],
+ variables$progression_rates,
+ 1/dt_update_vector,
+ successfully_treated$successfully_treated
)
+
variables$drug$queue_update(
- drugs[successful],
- treated_index
+ successfully_treated$drugs,
+ successfully_treated$successfully_treated
)
variables$drug_time$queue_update(
timestep,
- treated_index
+ successfully_treated$successfully_treated
)
}
- treated_index
+
+ successfully_treated$successfully_treated
+
+}
+
+
+#' @title Calculate successfully treated humans
+#' @description
+#' Sample successful treatments based on drug efficacy and antimalarial resistance
+#' @param parameters model parameters
+#' @param target bitset of treated humans
+#' @param drugs drug index
+#' @param timestep the current timestep
+#' @param renderer simulation renderer
+#' @param int_name the intervention name to use for rendering, use "" for frontline treatment
+#' @noRd
+calculate_successful_treatments <- function(
+ parameters,
+ target,
+ drugs,
+ timestep,
+ renderer,
+ int_name){
+
+ #+++ DRUG EFFICACY +++#
+ #+++++++++++++++++++++#
+ effectively_treated_index <- bernoulli_multi_p(parameters$drug_efficacy[drugs])
+ effectively_treated <- bitset_at(target, effectively_treated_index)
+ drugs <- drugs[effectively_treated_index]
+ n_drug_efficacy_failures <- target$size() - effectively_treated$size()
+ renderer$render(paste0('n_', int_name, 'drug_efficacy_failures'), n_drug_efficacy_failures, timestep)
+
+ #+++ ANTIMALARIAL RESISTANCE +++#
+ #+++++++++++++++++++++++++++++++#
+ if(parameters$antimalarial_resistance) {
+ resistance_parameters <- get_antimalarial_resistance_parameters(
+ parameters = parameters,
+ drugs = drugs,
+ timestep = timestep
+ )
+
+ #+++ EARLY TREATMENT FAILURE +++#
+ #+++++++++++++++++++++++++++++++#
+ early_treatment_failure_probability <- resistance_parameters$artemisinin_resistance_proportion * resistance_parameters$early_treatment_failure_probability
+ successfully_treated_indices <- bernoulli_multi_p(p = 1 - early_treatment_failure_probability)
+ successfully_treated <- bitset_at(effectively_treated, successfully_treated_indices)
+ n_early_treatment_failure <- effectively_treated$size() - successfully_treated$size()
+ renderer$render(paste0('n_', int_name, 'early_treatment_failure'), n_early_treatment_failure, timestep)
+ drugs <- drugs[successfully_treated_indices]
+ dt_slow_parasite_clearance <- resistance_parameters$dt_slow_parasite_clearance[successfully_treated_indices]
+
+ #+++ SLOW PARASITE CLEARANCE +++#
+ #+++++++++++++++++++++++++++++++#
+ slow_parasite_clearance_probability <- resistance_parameters$artemisinin_resistance_proportion[successfully_treated_indices] *
+ resistance_parameters$slow_parasite_clearance_probability[successfully_treated_indices]
+ slow_parasite_clearance_indices <- bernoulli_multi_p(p = slow_parasite_clearance_probability)
+ slow_parasite_clearance_individuals <- bitset_at(successfully_treated, slow_parasite_clearance_indices)
+ renderer$render(paste0('n_', int_name, 'slow_parasite_clearance'), slow_parasite_clearance_individuals$size(), timestep)
+ non_slow_parasite_clearance_individuals <- successfully_treated$copy()$set_difference(slow_parasite_clearance_individuals)
+ renderer$render(paste0('n_', int_name, 'successfully_treated'), successfully_treated$size(), timestep)
+ dt_slow_parasite_clearance <- dt_slow_parasite_clearance[slow_parasite_clearance_indices]
+
+ dt_spc_combined <- rep(parameters$dt, length(successfully_treated_indices))
+ dt_spc_combined[slow_parasite_clearance_indices] <- dt_slow_parasite_clearance
+
+ successfully_treated_list <- list(
+ drugs = drugs,
+ successfully_treated = successfully_treated,
+ dt_spc_combined = dt_spc_combined)
+
+ } else {
+
+ successfully_treated <- effectively_treated
+ renderer$render(paste0('n_', int_name, 'successfully_treated'), successfully_treated$size(), timestep)
+
+ successfully_treated_list <- list(
+ drugs = drugs,
+ successfully_treated = successfully_treated)
+
+ }
+ successfully_treated_list
}
#' @title Schedule infections
@@ -322,13 +476,14 @@ calculate_treated <- function(
#' @param parameters model parameters
#' @noRd
schedule_infections <- function(
- variables,
- clinical_infections,
- treated,
- infections,
- parameters,
- timestep
- ) {
+ variables,
+ clinical_infections,
+ treated,
+ infections,
+ parameters,
+ timestep
+) {
+
included <- treated$not(TRUE)
to_infect <- clinical_infections$and(included)
@@ -342,6 +497,8 @@ schedule_infections <- function(
'D',
variables$infectivity,
parameters$cd,
+ variables$progression_rates,
+ 1/parameters$dd,
to_infect
)
}
@@ -360,12 +517,12 @@ schedule_infections <- function(
# Utility functions
# =================
boost_immunity <- function(
- immunity_variable,
- exposed_index,
- last_boosted_variable,
- timestep,
- delay
- ) {
+ immunity_variable,
+ exposed_index,
+ last_boosted_variable,
+ timestep,
+ delay
+) {
# record who can be boosted
exposed_index_vector <- exposed_index$to_vector()
last_boosted <- last_boosted_variable$get_values(exposed_index)
diff --git a/R/lag.R b/R/lag.R
index 35e47026..de8d1653 100644
--- a/R/lag.R
+++ b/R/lag.R
@@ -14,6 +14,14 @@ LaggedValue <- R6::R6Class(
get = function(timestep) {
timeseries_at(private$history, timestep, TRUE)
+ },
+
+ save_state = function() {
+ timeseries_save_state(private$history)
+ },
+
+ restore_state = function(t, state) {
+ timeseries_restore_state(private$history, state)
}
)
)
diff --git a/R/mda_parameters.R b/R/mda_parameters.R
index a07d7e70..f84b86e1 100644
--- a/R/mda_parameters.R
+++ b/R/mda_parameters.R
@@ -6,7 +6,6 @@
#' round
#' @param min_ages a vector of minimum ages of the target population for each round exclusive (in timesteps)
#' @param max_ages a vector of maximum ages of the target population for each round exclusive (in timesteps)
-#' drug
#' @export
set_mda <- function(
parameters,
@@ -77,9 +76,9 @@ set_smc <- function(
#' @title Parameterise a perennial malaria chemoprevention (PMC, formerly IPIi)
#' @param parameters a list of parameters to modify
#' @param drug the index of the drug to administer
-#' @param timesteps a vector of timesteps for each round of PMC
-#' @param coverages a vector of the proportion of the target population who receive each
-#' round
+#' @param timesteps a vector of timesteps for each change in coverage
+#' @param coverages a vector of proportions of the target population to receive
+#' the intervention
#' @param ages a vector of ages at which PMC is administered (in timesteps)
#' @export
set_pmc <- function(
diff --git a/R/mda_processes.R b/R/mda_processes.R
index 42960be4..81ba0b7e 100644
--- a/R/mda_processes.R
+++ b/R/mda_processes.R
@@ -1,6 +1,5 @@
#' @title Create listeners for MDA events
#' @param variables the variables available in the model
-#' @param administer_event the event schedule for drug administration
#' @param drug the drug to administer
#' @param timesteps timesteps for each round
#' @param coverages the coverage for each round
@@ -13,76 +12,130 @@
#' @description will create a listener for administering each round of drugs
#' @noRd
create_mda_listeners <- function(
- variables,
- administer_event,
- drug,
- timesteps,
- coverages,
- min_ages,
- max_ages,
- correlations,
- int_name,
- parameters,
- renderer
- ) {
+ variables,
+ drug,
+ timesteps,
+ coverages,
+ min_ages,
+ max_ages,
+ correlations,
+ int_name,
+ parameters,
+ renderer
+) {
+
renderer$set_default(paste0('n_', int_name, '_treated'), 0)
+ renderer$set_default(paste0('n_', int_name, '_drug_efficacy_failures'), 0)
+ renderer$set_default(paste0('n_', int_name, '_successfully_treated'), 0)
+
+ if(parameters$antimalarial_resistance){
+ renderer$set_default(paste0('n_', int_name, '_early_treatment_failure'), 0)
+ renderer$set_default(paste0('n_', int_name, '_slow_parasite_clearance'), 0)
+ }
+
function(timestep) {
time_index = which(timesteps == timestep)
+ if(time_index == 0){
+ return()
+ }
coverage <- coverages[[time_index]]
- age <- get_age(variables$birth$get_values(), timestep)
-
- in_age <- which((age > min_ages[[time_index]]) & (age < max_ages[[time_index]]))
+ if(coverage == 0){
+ return()
+ }
+ in_age <- variables$birth$get_index_of(
+ a = timestep - max_ages[[time_index]],
+ b = timestep - min_ages[[time_index]]
+ )$to_vector()
target <- in_age[sample_intervention(in_age, int_name, coverage, correlations)]
-
+
renderer$render(paste0('n_', int_name, '_treated'), length(target), timestep)
+ treated <- individual::Bitset$new(parameters$human_population)$insert(target)
+
+ to_move <- calculate_successful_treatments(
+ parameters,
+ treated,
+ rep(drug, treated$size()),
+ timestep,
+ renderer,
+ paste0(int_name,"_")
+ )
- successful_treatments <- bernoulli(
- length(target),
- parameters$drug_efficacy[[drug]]
+ update_mass_drug_admin(
+ to_move,
+ variables,
+ parameters,
+ timestep,
+ drug
)
- to_move <- individual::Bitset$new(parameters$human_population)
- to_move$insert(target[successful_treatments])
+
+ }
+}
- if (to_move$size() > 0) {
- # Move detectable
- clinical <- variables$state$get_index_of('D')
- asymptomatic <- variables$state$get_index_of('A')
- detectable <- calculate_asymptomatic_detectable(
+#' @title Update individuals during MDA/PMC
+#' @description Updates individuals disease states, infectivity, dt and drug variables
+#' @param target a list containing the successfully treated, the drug used and resistance parameters
+#' @param variables the variables available in the model
+#' @param parameters the model parameters
+#' @param timestep the current timestep
+#' @param drug the drug to administer
+#' @noRd
+update_mass_drug_admin <- function(
+ target,
+ variables,
+ parameters,
+ timestep,
+ drug
+){
+
+ if (target$successfully_treated$size() > 0) {
+ # Move clinical and detectable asymptomatic into treated
+ clinical <- variables$state$get_index_of('D')
+ asymptomatic <- variables$state$get_index_of('A')
+ detectable <- calculate_asymptomatic_detectable(
+ variables$state,
+ variables$birth,
+ variables$id,
+ parameters,
+ timestep
+ )
+ to_treated <- clinical$or(asymptomatic$and(detectable))$and(target$successfully_treated)
+
+ if(parameters$antimalarial_resistance) {
+ dt_update_vector <- target$dt_spc_combined[
+ target$successfully_treated$copy()$and(to_treated)$to_vector()
+ ]
+ } else {
+ dt_update_vector <- parameters$dt
+ }
+
+ update_infection(
+ variables$state,
+ 'Tr',
+ variables$infectivity,
+ variables$infectivity$get_values(to_treated) * parameters$drug_rel_c[[drug]],
+ variables$progression_rates,
+ 1/dt_update_vector,
+ to_treated
+ )
+
+ # Move everyone else (susceptible, subpatent, non-detected asymptomatic and treated) to susceptible
+ other <- target$successfully_treated$copy()$and(to_treated$not(TRUE))
+ if (other$size() > 0) {
+ update_infection(
variables$state,
- variables$birth,
- variables$id,
- parameters,
- timestep
- )
- to_treat <- clinical$or(asymptomatic$and(detectable))
- variables$state$queue_update(
- 'Tr',
- to_treat$copy()$and(to_move)
+ "S",
+ variables$infectivity,
+ 0,
+ variables$progression_rates,
+ 0,
+ other
)
-
- # Move everyone else
- other <- to_move$copy()$and(to_treat$not(TRUE))
- if (other$size() > 0) {
- variables$state$queue_update('S', other)
- }
-
- # Update infectivity
- variables$infectivity$queue_update(
- variables$infectivity$get_values(
- to_move
- ) * parameters$drug_rel_c[[drug]],
- to_move
- )
-
- # Update drug
- variables$drug$queue_update(drug, to_move)
- variables$drug_time$queue_update(timestep, to_move)
- }
-
- # Schedule next round
- if (time_index < length(timesteps)) {
- administer_event$schedule(timesteps[[time_index + 1]] - timestep)
}
+
+ # Update drug
+ variables$drug$queue_update(drug, target$successfully_treated)
+ variables$drug_time$queue_update(timestep, target$successfully_treated)
+
}
}
@@ -103,7 +156,7 @@ calculate_asymptomatic_detectable <- function(
immunity,
parameters,
timestep
- ) {
+) {
asymptomatic <- state$get_index_of('A')
prob <- probability_of_detection(
get_age(birth$get_values(asymptomatic), timestep),
diff --git a/R/mixing.R b/R/mixing.R
new file mode 100644
index 00000000..58e0b4fc
--- /dev/null
+++ b/R/mixing.R
@@ -0,0 +1,72 @@
+create_transmission_mixer <- function(
+ variables,
+ parameters,
+ lagged_eir,
+ lagged_infectivity,
+ mixing_tt,
+ export_mixing,
+ import_mixing,
+ p_captured_tt,
+ p_captured,
+ p_success
+ ) {
+ function (timestep) {
+ n_pops <- length(variables)
+ rdt_positive <- vnapply(
+ seq_len(n_pops),
+ function(i) {
+ rdt_detectable(variables[[i]], parameters[[i]], timestep)
+ }
+ )
+ mix_t <- match_timestep(mixing_tt, timestep)
+ p_mix_export <- export_mixing[[mix_t]]
+ p_mix_import <- import_mixing[[mix_t]]
+ p_captured_t <- p_captured[[match_timestep(p_captured_tt, timestep)]]
+ n_species <- length(parameters[[1]]$species)
+ species_eir <- t(vapply(
+ seq_along(lagged_eir),
+ function(i) {
+ vnapply(
+ lagged_eir[[i]],
+ function(l) l$get(timestep - parameters[[i]]$de)
+ )
+ },
+ numeric(n_species)
+ ))
+ if (n_species == 1) {
+ species_eir <- t(species_eir)
+ }
+ inf <- vnapply(
+ seq_along(lagged_infectivity),
+ function(i) lagged_infectivity[[i]]$get(timestep - parameters[[i]]$delay_gam)
+ )
+
+ test_and_treat_coeff <- (1 - p_captured_t * rdt_positive * p_success)
+ diag(test_and_treat_coeff) <- 1
+
+ eir <- vapply(
+ seq_len(n_species),
+ function(i) {
+ mixed_eir <- t(species_eir[,i] * p_mix_import)
+ rowSums(mixed_eir * test_and_treat_coeff)
+ },
+ numeric(n_pops)
+ )
+
+ inf <- rowSums(inf * p_mix_export * test_and_treat_coeff)
+
+ list(eir = eir, inf = inf)
+ }
+}
+
+# Estimates RDT prevalence from PCR prevalence,
+# We assume PCR prevalence is close to the true proportion of infectious people
+# in the population
+# values take from Wu et al 2015: https://doi.org/10.1038/nature16039
+rdt_detectable <- function(variables, parameters, timestep) {
+ infectious_prev <- variables$state$get_size_of(
+ c('D', 'A', 'U')) / parameters$human_population
+ logit_prev <- log(infectious_prev / (1 - infectious_prev))
+ logit_rdt <- parameters$rdt_intercept + parameters$rdt_coeff * logit_prev
+ exp(logit_rdt) / (1 + exp(logit_rdt))
+}
diff --git a/R/model.R b/R/model.R
index 48af9af9..a0d77a20 100644
--- a/R/model.R
+++ b/R/model.R
@@ -11,7 +11,7 @@
#' * infectivity: the infectivity from humans towards mosquitoes
#' * FOIM: the force of infection towards mosquitoes (per species)
#' * mu: the death rate of adult mosquitoes (per species)
-#' * EIR: the Entomological Inoculation Rate (per timestep, per species, over
+#' * EIR: the Entomological Inoculation Rate (per timestep, per species, over
#' the whole population)
#' * n_bitten: number of humans bitten by an infectious mosquito
#' * n_treated: number of humans treated for clinical or severe malaria this timestep
@@ -29,26 +29,23 @@
#' * n: number of humans between an inclusive age range at this timestep. This
#' defaults to n_730_3650. Other age ranges can be set with
#' prevalence_rendering_min_ages and prevalence_rendering_max_ages parameters.
-#' * n_detect: number of humans with an infection detectable by microscopy between an inclusive age range at this timestep. This
+#' * n_detect_lm (or pcr): number of humans with an infection detectable by microscopy (or pcr) between an inclusive age range at this timestep. This
#' defaults to n_detect_730_3650. Other age ranges can be set with
#' prevalence_rendering_min_ages and prevalence_rendering_max_ages parameters.
-#' * p_detect: the sum of probabilities of detection by microscopy between an
+#' * p_detect_lm (or pcr): the sum of probabilities of detection by microscopy (or pcr) between an
#' inclusive age range at this timestep. This
#' defaults to p_detect_730_3650. Other age ranges can be set with
#' prevalence_rendering_min_ages and prevalence_rendering_max_ages parameters.
-#' * n_severe: number of humans with a severe infection between an inclusive
-#' age range at this timestep. Age ranges can be set with
-#' severe_prevalence_rendering_min_ages and severe_prevalence_rendering_max_ages parameters.
#' * n_inc: number of new infections for humans between an inclusive age range at this timestep.
#' incidence columns can be set with
#' incidence_rendering_min_ages and incidence_rendering_max_ages parameters.
#' * p_inc: sum of probabilities of infection for humans between an inclusive age range at this timestep.
#' incidence columns can be set with
#' incidence_rendering_min_ages and incidence_rendering_max_ages parameters.
-#' * n_inc_clinical: number of new clinical infections for humans between an inclusive age range at this timestep.
+#' * n_inc_clinical: number of new clinical infections for humans between an inclusive age range at this timestep.
#' clinical incidence columns can be set with
#' clinical_incidence_rendering_min_ages and clinical_incidence_rendering_max_ages parameters.
-#' * p_inc_clinical: sub of probabilities of clinical infection for humans between an inclusive age range at this timestep.
+#' * p_inc_clinical: sub of probabilities of clinical infection for humans between an inclusive age range at this timestep.
#' clinical incidence columns can be set with
#' clinical_incidence_rendering_min_ages and clinical_incidence_rendering_max_ages parameters.
#' * n_inc_severe: number of new severe infections for humans between an inclusive age range at this timestep.
@@ -74,6 +71,10 @@
#' susceptible
#' * net_usage: the number people protected by a bed net
#' * mosquito_deaths: number of adult female mosquitoes who die this timestep
+#' * n_drug_efficacy_failures: number of clinically treated individuals whose treatment failed due to drug efficacy
+#' * n_early_treatment_failure: number of clinically treated individuals who experienced early treatment failure
+#' * n_successfully_treated: number of clinically treated individuals who are treated successfully (includes individuals who experience slow parasite clearance)
+#' * n_slow_parasite_clearance: number of clinically treated individuals who experienced slow parasite clearance
#'
#' @param timesteps the number of timesteps to run the simulation for (in days)
#' @param parameters a named list of parameters to use
@@ -84,6 +85,29 @@ run_simulation <- function(
timesteps,
parameters = NULL,
correlations = NULL
+) {
+ run_resumable_simulation(timesteps, parameters, correlations)$data
+}
+
+#' @title Run the simulation in a resumable way
+#'
+#' @description this function accepts an initial simulation state as an argument, and returns the
+#' final state after running all of its timesteps. This allows one run to be resumed, possibly
+#' having changed some of the parameters.
+#' @param timesteps the timestep at which to stop the simulation
+#' @param parameters a named list of parameters to use
+#' @param correlations correlation parameters
+#' @param initial_state the state from which the simulation is resumed
+#' @param restore_random_state if TRUE, restore the random number generator's state from the checkpoint.
+#' @return a list with two entries, one for the dataframe of results and one for the final
+#' simulation state.
+#' @export
+run_resumable_simulation <- function(
+ timesteps,
+ parameters = NULL,
+ correlations = NULL,
+ initial_state = NULL,
+ restore_random_state = FALSE
) {
random_seed(ceiling(runif(1) * .Machine$integer.max))
if (is.null(parameters)) {
@@ -96,6 +120,7 @@ run_simulation <- function(
events <- create_events(parameters)
initialise_events(events, variables, parameters)
renderer <- individual::Render$new(timesteps)
+ populate_incidence_rendering_columns(renderer, parameters)
attach_event_listeners(
events,
variables,
@@ -105,7 +130,26 @@ run_simulation <- function(
)
vector_models <- parameterise_mosquito_models(parameters, timesteps)
solvers <- parameterise_solvers(vector_models, parameters)
- individual::simulation_loop(
+
+ lagged_eir <- create_lagged_eir(variables, solvers, parameters)
+ lagged_infectivity <- create_lagged_infectivity(variables, parameters)
+
+ stateful_objects <- list(
+ RandomState$new(restore_random_state),
+ correlations,
+ vector_models,
+ solvers,
+ lagged_eir,
+ lagged_infectivity)
+
+ if (!is.null(initial_state)) {
+ individual::restore_object_state(
+ initial_state$timesteps,
+ stateful_objects,
+ initial_state$malariasimulation)
+ }
+
+ individual_state <- individual::simulation_loop(
processes = create_processes(
renderer,
variables,
@@ -114,14 +158,31 @@ run_simulation <- function(
vector_models,
solvers,
correlations,
- list(create_lagged_eir(variables, solvers, parameters)),
- list(create_lagged_infectivity(variables, parameters))
+ lagged_eir,
+ lagged_infectivity,
+ timesteps
),
variables = variables,
- events = unlist(events),
- timesteps = timesteps
+ events = events,
+ timesteps = timesteps,
+ state = initial_state$individual,
+ restore_random_state = restore_random_state
+ )
+
+ final_state <- list(
+ timesteps = timesteps,
+ individual = individual_state,
+ malariasimulation = individual::save_object_state(stateful_objects)
)
- renderer$to_dataframe()
+
+ data <- renderer$to_dataframe()
+ if (!is.null(initial_state)) {
+ # Drop the timesteps we didn't simulate from the data.
+ # It would just be full of NA.
+ data <- data[-(1:initial_state$timesteps),]
+ }
+
+ list(data=data, state=final_state)
}
#' @title Run a metapopulation model
@@ -130,36 +191,86 @@ run_simulation <- function(
#' @param parameters a list of model parameter lists for each population
#' @param correlations a list of correlation parameters for each population
#' (default: NULL)
-#' @param mixing matrix of mixing coefficients for infectivity towards
-#' mosquitoes. Rows = origin sites, columns = destinations. Each element must
-#' be between 0 and 1 and all rows must sum to 1.
-#' @return a list of dataframe of results
+#' @param mixing_tt a vector of time steps for each mixing matrix
+#' @param export_mixing a list of matrices of coefficients for exportation of infectivity.
+#' Rows = origin sites, columns = destinations. Each matrix element
+#' describes the mixing pattern from destination to origin. Each matrix element must
+#' be between 0 and 1. Each matrix is activated at the corresponding timestep in mixing_tt
+#' @param import_mixing a list of matrices of coefficients for importation of
+#' infectivity.
+#' @param p_captured_tt a vector of time steps for each p_captured matrix
+#' @param p_captured a list of matrices representing the probability that
+#' travel between sites is intervened by a test and treat border check.
+#' Dimensions are the same as for `export_mixing`
+#' @param p_success the probability that an individual who has tested positive
+#' (through an RDT) successfully clears their infection through treatment
+#' @return a list of dataframe of model outputs as in run_simulation
#' @export
run_metapop_simulation <- function(
- timesteps,
- parameters,
- correlations = NULL,
- mixing
-) {
+ timesteps,
+ parameters,
+ correlations = NULL,
+ mixing_tt,
+ export_mixing,
+ import_mixing,
+ p_captured_tt,
+ p_captured,
+ p_success
+ ) {
random_seed(ceiling(runif(1) * .Machine$integer.max))
- if (nrow(mixing) != ncol(mixing)) {
- stop('mixing matrix must be square')
+
+ for (mixing in list(export_mixing, import_mixing)) {
+ if (!is.list(mixing)) {
+ stop('mixing arguments must be a list of mixing matrices')
+ }
+
+ if (length(mixing_tt) != length(mixing)) {
+ stop('mixing_tt must be the same length as mixing matrices')
+ }
+
+ for (i in seq_along(mixing)) {
+ if (nrow(mixing[[i]]) != ncol(mixing[[i]])) {
+ stop(sprintf('mixing matrix %d must be square', i))
+ }
+ if (nrow(mixing[[i]]) != length(parameters)) {
+ stop(sprintf("mixing matrix %d's rows must match length of parameters", i))
+ }
+ if (!all(vlapply(seq_along(parameters), function(x) approx_sum(mixing[[i]][x,], 1)))) {
+ warning(sprintf("all of mixing matrix %d's rows must sum to 1", i))
+ }
+ if (!all(vlapply(seq_along(parameters), function(x) approx_sum(mixing[[i]][,x], 1)))) {
+ warning(sprintf('mixing matrix %d is asymmetrical', i))
+ }
+ }
+ if (length(mixing_tt) != length(mixing)) {
+ stop('mixing_tt must be the same size as mixing')
+ }
}
- if (nrow(mixing) != length(parameters)) {
- stop('mixing matrix rows must match length of parameters')
+
+ for (i in seq_along(p_captured)) {
+ if (nrow(p_captured[[i]]) != ncol(p_captured[[i]])) {
+ stop(sprintf('p_captured matrix %d must be square', i))
+ }
+ if (!all(diag(p_captured[[i]]) == 0)) {
+ warning(sprintf('p_captured matrix %d has a non-zero diagonal', i))
+ }
}
- if (!all(vlapply(seq_along(parameters), function(x) approx_sum(mixing[x,], 1)))) {
- stop('all mixing matrix rows must sum to 1')
+
+ if (!is.numeric(mixing_tt)) {
+ stop('mixing_tt must be numeric')
}
- if (!all(vlapply(seq_along(parameters), function(x) approx_sum(mixing[,x], 1)))) {
- warning('mixing matrix is asymmetrical')
+
+ if (length(p_captured_tt) != length(p_captured)) {
+ stop('p_captured_tt must be the same length as p_captured')
}
+
if (is.null(correlations)) {
correlations <- lapply(parameters, get_correlation_parameters)
}
variables <- lapply(parameters, create_variables)
events <- lapply(parameters, create_events)
renderer <- lapply(parameters, function(.) individual::Render$new(timesteps))
+ populate_metapopulation_incidence_rendering_columns(renderer, parameters)
for (i in seq_along(parameters)) {
# NOTE: forceAndCall is necessary here to make sure i refers to the current
# iteration
@@ -193,6 +304,22 @@ run_metapop_simulation <- function(
seq_along(parameters),
function(i) create_lagged_infectivity(variables[[i]], parameters[[i]])
)
+
+ mixing_fn <- time_cached(
+ create_transmission_mixer(
+ variables,
+ parameters,
+ lagged_eir,
+ lagged_infectivity,
+ mixing_tt,
+ export_mixing,
+ import_mixing,
+ p_captured_tt,
+ p_captured,
+ p_success
+ )
+ )
+
processes <- lapply(
seq_along(parameters),
function(i) {
@@ -204,9 +331,10 @@ run_metapop_simulation <- function(
vector_models[[i]],
solvers[[i]],
correlations[[i]],
- lagged_eir,
- lagged_infectivity,
- mixing[i,],
+ lagged_eir[[i]],
+ lagged_infectivity[[i]],
+ timesteps,
+ mixing_fn,
i
)
}
@@ -217,7 +345,7 @@ run_metapop_simulation <- function(
events = unlist(events),
timesteps = timesteps
)
-
+
lapply(renderer, function(r) r$to_dataframe())
}
@@ -248,4 +376,4 @@ run_simulation_with_repetitions <- function(
}
)
do.call("rbind", dfs)
-}
\ No newline at end of file
+}
diff --git a/R/mortality_processes.R b/R/mortality_processes.R
index 65b090cb..b68f5ee7 100644
--- a/R/mortality_processes.R
+++ b/R/mortality_processes.R
@@ -27,7 +27,7 @@ create_mortality_process <- function(variables, events, renderer, parameters) {
died <- individual::Bitset$new(pop)$insert(bernoulli_multi_p(deathrates))
renderer$render('natural_deaths', died$size(), timestep)
}
- reset_target(variables, events, died, 'S', timestep)
+ reset_target(variables, events, died, 'S', parameters, timestep)
sample_maternal_immunity(variables, died, timestep, parameters)
}
}
@@ -66,7 +66,7 @@ sample_maternal_immunity <- function(variables, target, timestep, parameters) {
# set their maternal immunities
birth_icm <- variables$ica$get_values(mothers) * parameters$pcm
- birth_ivm <- variables$ica$get_values(mothers) * parameters$pvm
+ birth_ivm <- variables$iva$get_values(mothers) * parameters$pvm
variables$icm$queue_update(birth_icm, target_group)
variables$ivm$queue_update(birth_ivm, target_group)
}
@@ -74,7 +74,7 @@ sample_maternal_immunity <- function(variables, target, timestep, parameters) {
}
}
-reset_target <- function(variables, events, target, state, timestep) {
+reset_target <- function(variables, events, target, state, parameters, timestep) {
if (target$size() > 0) {
# clear events
to_clear <- c(
@@ -106,13 +106,15 @@ reset_target <- function(variables, events, target, state, timestep) {
variables$drug_time$queue_update(-1, target)
# vaccination
- variables$pev_timestep$queue_update(-1, target)
+ variables$last_pev_timestep$queue_update(-1, target)
+ variables$last_eff_pev_timestep$queue_update(-1, target)
variables$pev_profile$queue_update(-1, target)
variables$tbv_vaccinated$queue_update(-1, target)
# onwards infectiousness
variables$infectivity$queue_update(0, target)
-
+ variables$progression_rates$queue_update(0, target)
+
# zeta and zeta group and vector controls survive rebirth
}
}
diff --git a/R/mosquito_biology.R b/R/mosquito_biology.R
index 381450d9..4225a46f 100644
--- a/R/mosquito_biology.R
+++ b/R/mosquito_biology.R
@@ -220,7 +220,7 @@ create_mosquito_emergence_process <- function(
p_counts <- vnapply(
solvers,
function(solver) {
- solver_get_states(solver)[[ODE_INDICES[['P']]]]
+ solver$get_states()[[ODE_INDICES[['P']]]]
}
)
n <- sum(p_counts) * rate
diff --git a/R/output_parameters.R b/R/output_parameters.R
new file mode 100644
index 00000000..d1890229
--- /dev/null
+++ b/R/output_parameters.R
@@ -0,0 +1,59 @@
+#' @title Parameterise age grouped output rendering
+#'
+#' @details this function produces contiguous age groups, inclusive of the lower
+#' age limit and exclusive of the upper age limit: e.g., c(0, 10, 100) will produce
+#' two age groups: 0-9 and 10-99 in days.
+#' @param parameters the model parameters
+#' @param age_group age breaks for population size outputs; default = NULL
+#' @param incidence age breaks for incidence outputs (D+Tr+A); default = NULL
+#' @param clinical_incidence age breaks for clinical incidence outputs (symptomatic); default = c(0, 1825)
+#' @param severe_incidence age breaks for severe incidence outputs; default = NULL
+#' @param prevalence age breaks for clinical prevalence outputs (pcr and lm detectable infections); default = c(730, 3650)
+#' @param ica age breaks for average acquired clinical immunity; default = NULL
+#' @param icm age breaks for average maternal clinical immunity; default = NULL
+#' @param iva age breaks for average acquired severe immunity; default = NULL
+#' @param ivm age breaks for average maternal severe immunity; default = NULL
+#' @param id age breaks for average immunity to detectability; default = NULL
+#' @param ib age breaks for average blood immunity; default = NULL
+#' @export
+#'
+set_epi_outputs <- function(parameters,
+ age_group = NULL,
+ incidence = NULL,
+ clinical_incidence = NULL,
+ severe_incidence = NULL,
+ prevalence = NULL,
+ ica = NULL,
+ icm = NULL,
+ iva = NULL,
+ ivm = NULL,
+ id = NULL,
+ ib = NULL
+){
+
+ input <- list(
+ age_group = age_group,
+ incidence = incidence,
+ clinical_incidence = clinical_incidence,
+ severe_incidence = severe_incidence,
+ prevalence = prevalence,
+ ica = ica,
+ icm = icm,
+ iva = iva,
+ ivm = ivm,
+ id = id,
+ ib = ib
+ )
+ input <- input[!sapply(input, is.null)]
+
+ for(i in seq_along(input)){
+ name <- names(input)[i]
+ ages <- input[[i]]
+ min_ages <- ages[-length(ages)]
+ max_ages <- ages[-1] - 1
+ parameters[[paste0(name, "_rendering_min_ages")]] <- min_ages
+ parameters[[paste0(name, "_rendering_max_ages")]] <- max_ages
+ }
+
+ return(parameters)
+}
diff --git a/R/parameters.R b/R/parameters.R
index 8a96989a..6da0be95 100644
--- a/R/parameters.R
+++ b/R/parameters.R
@@ -8,17 +8,39 @@
#' @param overrides a named list of parameter values to use instead of defaults
#' The parameters are defined below.
#'
-#' fixed state transitions:
+#' initial state proportions:
+#'
+#' * s_proportion - the proportion of `human_population` that begin as susceptible; default = 0.420433246
+#' * d_proportion - the proportion of `human_population` that begin with
+#' clinical disease; default = 0.007215064
+#' * a_proportion - the proportion of `human_population` that begin as
+#' asymptomatic; default = 0.439323667
+#' * u_proportion - the proportion of `human_population` that begin as
+#' subpatents; default = 0.133028023
+#' * t_proportion - the proportion of `human_population` that begin treated; default = 0
+#'
+#' human fixed state transitions:
#'
#' * dd - the delay for humans to move from state D to A; default = 5
-#' * dt - the delay for humans to move from state Tr to Ph; default = 5
+#' * dt - the delay for humans to move from state Tr to S; default = 5
#' * da - the delay for humans to move from state A to U; default = 195
#' * du - the delay for humans to move from state U to S; default = 110
-#' * del - the delay for mosquitoes to move from state E to L; default = 6.64
-#' * dl - the delay for mosquitoes to move from state L to P; default = 3.72
-#' * dpl - the delay mosquitoes to move from state P to Sm; default = 0.643
-#' * mup - the rate at which pupal mosquitoes die; default = 0.249
-#' * mum - the rate at which developed mosquitoes die; default (An. gambiae) = .132
+#'
+#' human demography parameters:
+#'
+#' * human_population - the initial number of humans to model; default = 100
+#' * average_age - the average age of humans (in timesteps), this is only used
+#' if custom_demography is FALSE; default = 7665
+#' * custom_demography - population demography given; default = FALSE
+#'
+#' initial immunity values:
+#'
+#' * init_icm - the immunity from clinical disease at birth; default = 0
+#' * init_ivm - the immunity from severe disease at birth; default = 0
+#' * init_ib - the initial pre-erythrocitic immunity; default = 0
+#' * init_ica - the initial acquired immunity from clinical disease; default = 0
+#' * init_iva - the initial acquired immunity from severe disease; default = 0
+#' * init_id - the initial acquired immunity to detectability; default = 0
#'
#' immunity decay rates:
#'
@@ -29,6 +51,26 @@
#' * rva - decay rate for acquired immunity to severe disease; default = 10950
#' * rid - decay rate for acquired immunity to detectability; default = 3650
#'
+#' immunity boost grace periods:
+#'
+#' * ub - period in which pre-erythrocytic immunity cannot be boosted; default = 7.2
+#' * uc - period in which clinical immunity cannot be boosted; default = 6.06
+#' * uv - period in which severe immunity cannot be boosted; default = 11.4321
+#' * ud - period in which immunity to detectability cannot be boosted; default = 9.44512
+#'
+#' maternal immunity parameters:
+#'
+#' * pcm - new-born clinical immunity relative to mother's; default = 0.774368
+#' * pvm - new-born severe immunity relative to mother's; default = 0.195768
+#'
+#' unique biting rate:
+#'
+#' * a0 - age dependent biting parameter; default = 2920
+#' * rho - age dependent biting parameter; default = 0.85
+#' * sigma_squared - heterogeneity parameter; default = 1.67
+#' * n_heterogeneity_groups - number discretised groups for heterogeneity, used
+#' for sampling mothers; default = 5
+#'
#' probability of pre-erythrocytic infection:
#'
#' * b0 - maximum probability due to no immunity; default = 0.59
@@ -36,6 +78,15 @@
#' * ib0 - scale parameter; default = 43.9
#' * kb - shape parameter; default = 2.16
#'
+#' probability of detection by light-microscopy when asymptomatic:
+#'
+#' * fd0 - time-scale at which immunity changes with age; default = 0.007055
+#' * ad - scale parameter relating age to immunity; default = 7993.5
+#' * gammad - shape parameter relating age to immunity; default = 4.8183
+#' * d1 - minimum probability due to immunity; default = 0.160527
+#' * id0 - scale parameter; default = 1.577533
+#' * kd - shape parameter; default = 0.476614
+#'
#' probability of clinical infection:
#'
#' * phi0 - maximum probability due to no immunity; default = 0.792
@@ -53,22 +104,6 @@
#' * av - age dependent modifier; default = 2493.41
#' * gammav - age dependent modifier; default = 2.91282
#'
-#' immunity reducing probability of detection:
-#'
-#' * fd0 - time-scale at which immunity changes with age; default = 0.007055
-#' * ad - scale parameter relating age to immunity; default = 7993.5
-#' * gammad - shape parameter relating age to immunity; default = 4.8183
-#' * d1 - minimum probability due to immunity; default = 0.160527
-#' * id0 - scale parameter; default = 1.577533
-#' * kd - shape parameter; default = 0.476614
-#'
-#' immunity boost grace periods:
-#'
-#' * ub - period in which pre-erythrocytic immunity cannot be boosted; default = 7.2
-#' * uc - period in which clinical immunity cannot be boosted; default = 6.06
-#' * uv - period in which severe immunity cannot be boosted; default = 11.4321
-#' * ud - period in which immunity to detectability cannot be boosted; default = 9.44512
-#'
#' infectivity towards mosquitoes:
#'
#' * cd - infectivity of clinically diseased humans towards mosquitoes; default = 0.068
@@ -76,62 +111,21 @@
#' * cu - infectivity of sub-patent infection; default = 0.0062
#' * ct - infectivity of treated infection; default = 0.021896
#'
-#' unique biting rate:
-#'
-#' * a0 - age dependent biting parameter; default = 2920
-#' * rho - age dependent biting parameter; default = 0.85
-#' * sigma_squared - heterogeneity parameter; default = 1.67
-#' * n_heterogeneity_groups - number discretised groups for heterogeneity, used
-#' for sampling mothers; default = 5
-#'
-#' mortality parameters:
-#'
-#' * average_age - the average age of humans (in timesteps), this is only used
-#' if custom_demography is FALSE; default = 7663
-#' * pcm - new-born clinical immunity relative to mother's; default = 0.774368
-#' * pvm - new-born severe immunity relative to mother's; default = 0.195768
+#' mosquito fixed state transitions (including mortality):
+#'
+#' * del - the delay for mosquitoes to move from state E to L; default = 6.64
+#' * dl - the delay for mosquitoes to move from state L to P; default = 3.72
+#' * dpl - the delay mosquitoes to move from state P to Sm; default = 0.643
#' * me - early stage larval mortality rate; default = 0.0338
#' * ml - late stage larval mortality rate; default = 0.0348
-#'
-#' carrying capacity parameters:
-#'
-#' * model_seasonality - boolean switch TRUE iff the simulation models seasonal rainfall; default = FALSE
-#' * g0 - rainfall fourier parameter; default = 2
-#' * g - rainfall fourier parameter; default = 0.3, 0.6, 0.9
-#' * h - rainfall fourier parameters; default = 0.1, 0.4, 0.7
-#' * gamma - effect of density dependence on late instars relative to early
-#' instars; default = 13.25
-#' * rainfall_floor - the minimum rainfall value (must be above 0); default 0.001
-#'
-#' initial state proportions:
-#'
-#' * s_proportion - the proportion of `human_population` that begin as susceptible; default = 0.420433246
-#' * d_proportion - the proportion of `human_population` that begin with
-#' clinical disease; default = 0.007215064
-#' * a_proportion - the proportion of `human_population` that begin as
-#' asymptomatic; default = 0.439323667
-#' * u_proportion - the proportion of `human_population` that begin as
-#' subpatents; default = 0.133028023
-#' * t_proportion - the proportion of `human_population` that begin treated; default = 0
-#'
-#' initial immunity values:
-#'
-#' * init_icm - the immunity from clinical disease at birth; default = 0
-#' * init_ivm - the immunity from severe disease at birth; default = 0
-#' * init_ib - the initial pre-erythrocitic immunity; default = 0
-#' * init_ica - the initial acquired immunity from clinical disease; default = 0
-#' * init_iva - the initial acquired immunity from severe disease; default = 0
-#' * init_id - the initial acquired immunity to detectability; default = 0
-#'
-#' incubation periods:
-#'
-#' * de - Duration of the human latent period of infection; default = 12
-#' * delay_gam - Lag from parasites to infectious gametocytes; default = 12.5
-#' * dem - Extrinsic incubation period in mosquito population model; default = 10
+#' * mup - the rate at which pupal mosquitoes die; default = 0.249
+#' * mum - the rate at which developed mosquitoes die; default (An. gambiae) = .132
#'
#' vector biology:
#' species specific values are vectors
-#'
+#' please set species parameters using the convenience function
+#' \code{\link{set_species}}
+#'
#' * beta - the average number of eggs laid per female mosquito per day; default = 21.2
#' * total_M - the initial number of adult mosquitos in the simulation; default = 1000
#' * init_foim - the FOIM used to calculate the equilibrium state for mosquitoes; default = 0
@@ -141,18 +135,30 @@
#' * Q0 - proportion of blood meals taken on humans; default = 0.92
#' * foraging_time - time spent taking blood meals; default = 0.69
#'
-#' feeding cycle:
-#' please set vector control strategies using `set_betnets` and `set_spraying`
+#' seasonality and carrying capacity parameters:
+#' please set flexible carrying capacity using the convenience function
+#' \code{\link{set_carrying_capacity}}
+#'
+#' * model_seasonality - boolean switch TRUE iff the simulation models seasonal rainfall; default = FALSE
+#' * g0 - rainfall fourier parameter; default = 2
+#' * g - rainfall fourier parameter; default = 0.3, 0.6, 0.9
+#' * h - rainfall fourier parameters; default = 0.1, 0.4, 0.7
+#' * gamma - effect of density dependence on late instars relative to early
+#' instars; default = 13.25
+#' * rainfall_floor - the minimum rainfall value (must be above 0); default 0.001
+#' * carrying_capacity; default = FALSE
+#' * carrying_capacity_timesteps; default = NULL
+#' * carrying_capacity_values; default = NULL#'
#'
-#' * bednets - boolean for if bednets are enabled; default = FALSE
-#' * phi_bednets - proportion of bites taken in bed; default = 0.85
-#' * k0 - proportion of females bloodfed with no net; default = 0.699
-#' * spraying - boolean for if indoor spraying is enabled; default = FALSE
-#' * phi_indoors - proportion of bites taken indoors; default = 0.90
+#' parasite incubation periods:
#'
+#' * de - duration of the human latent period of infection; default = 12
+#' * delay_gam - lag from parasites to infectious gametocytes; default = 12.5
+#' * dem - extrinsic incubation period in mosquito population model; default = 10
+#'
#' treatment parameters:
-#' please set treatment parameters with the convenience functions in
-#' `drug_parameters.R`
+#' please set treatment parameters with the convenience functions
+#' \code{\link{set_drugs}} and \code{\link{set_clinical_treatment}}
#'
#' * drug_efficacy - a vector of efficacies for available drugs; default = turned off
#' * drug_rel_c - a vector of relative onward infectiousness values for drugs; default = turned off
@@ -164,21 +170,32 @@
#' clinically diseased (these values refer to the index in drug_* parameters); default = NULL, NULL, NULL
#' * clinical_treatment_coverage - a vector of coverage values for each drug; default = NULL, NULL, NULL
#'
-#' PEV parameters:
-#' please set vaccine strategies with the convenience functions in
-#' `pev_parameters.R:set_pev_epi`
-#' `pev_parameters.R:set_mass_pev`
+#' MDA, SMC and PMC parameters:
+#' please set these parameters with the convenience functions
+#' \code{\link{set_mda}}, \code{\link{set_smc}} and \code{\link{set_pmc}},
+#' with \code{\link{peak_season_offset}}
+#'
+#' bednet, irs and mosquito feeding cycle parameters:
+#' please set vector control strategies using \code{\link{set_bednets}} and \code{\link{set_spraying}}
+#'
+#' * bednets - boolean for if bednets are enabled; default = FALSE
+#' * phi_bednets - proportion of bites taken in bed; default = 0.85
+#' * k0 - proportion of females bloodfed with no net; default = 0.699
+#' * spraying - boolean for if indoor spraying is enabled; default = FALSE
+#' * phi_indoors - proportion of bites taken indoors; default = 0.90
+#'
+#'
+#' PEV parameters:
+#' please set vaccine strategies with the convenience functions
+#' \code{\link{set_pev_epi}} and \code{\link{set_mass_pev}}
#'
#' * pev_doses - the dosing schedule before the vaccine takes effect; default =
#' c(0, 1.5 * 30, 3 * 30)
#' default = 365
#'
-#' MDA, SMC and PMC parameters:
-#' please set these parameters with the convenience functions in `mda_parameters.R`
-#'
#' TBV parameters:
#' please set TBV parameters with the convenience functions in
-#' `vaccine_parameters.R:set_tbv`
+#' \code{\link{set_tbv}}
#'
#' * tbv_mt - effect on treated infectiousness; default = 35
#' * tbv_md - effect on diseased infectiousness; default = 46.7
@@ -192,13 +209,29 @@
#' * tbv_tra_mu - transmission reduction parameter; default = 12.63
#' * tbv_gamma1 - transmission reduction parameter; default = 2.5
#' * tbv_gamma2 - transmission reduction parameter; default = 0.06
+#'
+#' Antimalarial resistance parameters:
+#' please set antimalarial resistance parameters with the convenience functions in
+#' \code{\link{set_antimalarial_resistance}}
+#'
+#' * antimalarial_resistance - boolean for if antimalarial resistance is enabled; default = FALSE
+#' * antimalarial_resistance_drug - vector of drugs for which resistance can be parameterised; default = NULL
+#' * antimalarial_resistance_timesteps - vector of time steps on which resistance updates occur; default = NULL
+#' * artemisinin_resistant_proportion - vector of proportions of infections resistant to the artemisinin component of a given drug; default = NULL
+#' * partner_drug_resistance_proportion - vector of proportions of infections resistant to the parter drug component of a given drug; default = NULL
+#' * slow_parasite_clearance_probability - vector of probabilities of slow parasite clearance for a given drug; default = NULL
+#' * early_treatment_failure_probability - vector of probabilities of early treatment failure for a given drug; default = NULL
+#' * late_clinical_failure_probability - vector of probabilities of late clinical failure for a given drug; default = NULL
+#' * late_parasitological_failure_probability - vector of probabilities of late parasitological failure for a given drug; default = NULL
+#' * reinfection_during_prophylaxis_probability - vector of probabilities of reinfection during prophylaxis for a given drug; default = NULL
+#' * dt_slow_parasite_clearance - the delay for humans experiencing slow parasite clearance to move from state Tr to S; default = NULL
#'
#' rendering:
-#' All values are in timesteps and all ranges are inclusive
-#'
-#' * prevalence_rendering_min_ages - the minimum ages for clinical prevalence
-#' outputs; default = 730
-#' * prevalence_rendering_max_ages - the corresponding max ages; default = 3650
+#' All values are in timesteps and all ranges are inclusive.
+#' Please set rendered age groups using the convenience function
+#'
+#' * age_group_rendering_min_ages - the minimum ages for population size outputs; default = turned off
+#' * age_group_rendering_max_ages - the corresponding max ages; default = turned off
#' * incidence_rendering_min_ages - the minimum ages for incidence
#' outputs (includes asymptomatic microscopy +); default = turned off
#' * incidence_rendering_max_ages - the corresponding max ages; default = turned off
@@ -207,16 +240,25 @@
#' * severe_incidence_rendering_min_ages - the minimum ages for severe incidence
#' outputs; default = turned off
#' * severe_incidence_rendering_max_ages - the corresponding max ages; default = turned off
+#' * prevalence_rendering_min_ages - the minimum ages for clinical prevalence
+#' outputs; default = 730
+#' * prevalence_rendering_max_ages - the corresponding max ages; default = 3650
+#'
+#' mixing:
+#'
+#' * rdt_intercept - the y intercept for the log logit relationship betweeen rdt
+#' and PCR prevalence; default = -0.968
+#' * rdt_coeff - the coefficient for the log logit relationship betweeen rdt
+#' and PCR prevalence; default = 1.186
#'
#' miscellaneous:
#'
-#' * human_population - the initial number of humans to model; default = 100
-#' * human_population_timesteps - the timesteps at which the population should
-#' change; default = 0
#' * mosquito_limit - the maximum number of mosquitoes to allow for in the
#' simulation; default = 1.00E+05
#' * individual_mosquitoes - boolean whether adult mosquitoes are modeled
#' individually or compartmentally; default = TRUE
+#' * human_population_timesteps - the timesteps at which the population should
+#' change; default = 0
#' * r_tol - the relative tolerance for the ode solver; default = 1e-4
#' * a_tol - the absolute tolerance for the ode solver; default = 1e-4
#' * ode_max_steps - the max number of steps for the solver; default = 1e6
@@ -226,17 +268,28 @@
#' @export
get_parameters <- function(overrides = list()) {
parameters <- list(
+ # initial state proportions
+ s_proportion = 0.420433246,
+ d_proportion = 0.007215064,
+ a_proportion = 0.439323667,
+ u_proportion = 0.133028023,
+ t_proportion = 0,
+ # human fixed state transitions
dd = 5,
dt = 5,
da = 195,
du = 110,
- del = 6.64,
- dl = 3.72,
- dpl = .643,
- mup = .249,
- mum = .132,
- sigma_squared = 1.67,
- n_heterogeneity_groups = 5,
+ # human demography parameters
+ human_population = 100,
+ average_age = 7665,
+ custom_demography = FALSE,
+ # initial immunities
+ init_ica = 0,
+ init_iva = 0,
+ init_icm = 0,
+ init_ivm = 0,
+ init_id = 0,
+ init_ib = 0,
# immunity decay rates
rm = 67.6952,
rvm = 76.8365,
@@ -244,24 +297,32 @@ get_parameters <- function(overrides = list()) {
rc = 30 * 365,
rva = 30 * 365,
rid = 10 * 365,
- # blood immunity parameters
- b0 = 0.59,
- b1 = 0.5,
- ib0 = 43.9,
- kb = 2.16,
# immunity boost grace periods
ub = 7.2,
uc = 6.06,
uv = 11.4321,
ud = 9.44512,
- # infectivity towards mosquitos
- cd = 0.068,
- gamma1= 1.82425,
- cu = 0.0062,
- ct = 0.021896,
+ # maternal immunity parameters
+ pcm = .774368,
+ pvm = .195768,
# unique biting rate
a0 = 8 * 365,
rho = .85,
+ sigma_squared = 1.67,
+ n_heterogeneity_groups = 5,
+ enable_heterogeneity = TRUE,
+ # blood immunity parameters
+ b0 = 0.59,
+ b1 = 0.5,
+ ib0 = 43.9,
+ kb = 2.16,
+ # asymptomatic immunity to lm detection parameters
+ fd0 = 0.007055,
+ ad = 21.9 * 365,
+ gammad= 4.8183,
+ d1 = 0.160527,
+ id0 = 1.577533,
+ kd = .476614,
# clinical immunity parameters
phi0 = .792,
phi1 = .00074,
@@ -275,62 +336,44 @@ get_parameters <- function(overrides = list()) {
av = 2493.41,
gammav = 2.91282,
iv0 = 1.09629,
- # delay for infection
- de = 12,
- delay_gam = 12.5,
- dem = 10,
- # asymptomatic immunity parameters
- fd0 = 0.007055,
- ad = 21.9 * 365,
- gammad= 4.8183,
- d1 = 0.160527,
- id0 = 1.577533,
- kd = .476614,
- # mortality parameters
- average_age = 7663,
- pcm = .774368,
- pvm = .195768,
- # carrying capacity parameters
- g0 = 2,
- g = c(.3, .6, .9),
- h = c(.1, .4, .7),
- gamma = 13.25,
- model_seasonality = FALSE,
- rainfall_floor = 0.001,
- # larval mortality rates
+ # infectivity towards mosquitos
+ cd = 0.068,
+ gamma1= 1.82425,
+ cu = 0.0062,
+ ct = 0.021896,
+ # mosquito fixed state transitions (inc. mortality)
+ del = 6.64,
+ dl = 3.72,
+ dpl = .643,
me = .0338,
ml = .0348,
- # initial state proportions
- s_proportion = 0.420433246,
- d_proportion = 0.007215064,
- a_proportion = 0.439323667,
- u_proportion = 0.133028023,
- t_proportion = 0,
- # initial immunities
- init_ica = 0,
- init_iva = 0,
- init_icm = 0,
- init_ivm = 0,
- init_id = 0,
- init_ib = 0,
- # vector biology
- beta = 21.2,
- total_M = 1000,
- init_foim= 0,
+ mup = .249,
+ mum = .132,
# species-specific vector biology (default is An. gambiae s.s)
species = 'gamb',
species_proportions = 1,
blood_meal_rates = 1/3,
Q0 = .92,
foraging_time = .69,
- # bed nets
- bednets = FALSE,
- phi_bednets = .85,
- k0 = .699,
- # indoor spraying
- spraying = FALSE,
- phi_indoors = .90,
- # treatment
+ beta = 21.2,
+ total_M = 1000,
+ init_foim= 0,
+ # carrying capacity parameters
+ g0 = 2,
+ g = c(.3, .6, .9),
+ h = c(.1, .4, .7),
+ gamma = 13.25,
+ model_seasonality = FALSE,
+ rainfall_floor = 0.001,
+ # flexible carrying capacity
+ carrying_capacity = FALSE,
+ carrying_capacity_timesteps = NULL,
+ carrying_capacity_values = NULL,
+ # parasite incubation delays
+ de = 12,
+ delay_gam = 12.5,
+ dem = 10,
+ # treatment parameters
drug_efficacy = numeric(0),
drug_rel_c = numeric(0),
drug_prophylaxis_shape = numeric(0),
@@ -338,9 +381,6 @@ get_parameters <- function(overrides = list()) {
clinical_treatment_drugs = list(),
clinical_treatment_timesteps = list(),
clinical_treatment_coverages = list(),
- # rts,s
- pev = FALSE,
- pev_doses = c(0, 1.5 * 30, 3 * 30),
# MDA
mda = FALSE,
mda_drug = 0,
@@ -360,6 +400,16 @@ get_parameters <- function(overrides = list()) {
pmc_timesteps = NULL,
pmc_coverages = NULL,
pcs_ages = -1,
+ # bed nets
+ bednets = FALSE,
+ phi_bednets = .85,
+ k0 = .699,
+ # indoor spraying
+ spraying = FALSE,
+ phi_indoors = .90,
+ # pev
+ pev = FALSE,
+ pev_doses = c(0, 1.5 * 30, 3 * 30),
# tbv
tbv = FALSE,
tbv_mt = 35,
@@ -377,30 +427,38 @@ get_parameters <- function(overrides = list()) {
tbv_timesteps = NULL,
tbv_coverages = NULL,
tbv_ages = NULL,
- # flexible carrying capacity
- carrying_capacity = FALSE,
- carrying_capacity_timesteps = NULL,
- carrying_capacity_values = NULL,
+ # antimalarial resistance
+ antimalarial_resistance = FALSE,
+ antimalarial_resistance_drug = NULL,
+ antimalarial_resistance_timesteps = NULL,
+ artemisinin_resistance_proportion = NULL,
+ partner_drug_resistance_proportion = NULL,
+ slow_parasite_clearance_probability = NULL,
+ early_treatment_failure_probability = NULL,
+ late_clinical_failure_probability = NULL,
+ late_parasitological_failure_probability = NULL,
+ reinfection_during_prophylaxis_probability = NULL,
+ dt_slow_parasite_clearance = NULL,
# rendering
prevalence_rendering_min_ages = 2 * 365,
prevalence_rendering_max_ages = 10 * 365,
incidence_rendering_min_ages = numeric(0),
incidence_rendering_max_ages = numeric(0),
clinical_incidence_rendering_min_ages = numeric(0),
- clinical_incidence_rendering_max_ages = 5 * 365,
+ clinical_incidence_rendering_max_ages = numeric(0),
severe_prevalence_rendering_min_ages = numeric(0),
severe_prevalence_rendering_max_ages = numeric(0),
severe_incidence_rendering_min_ages = numeric(0),
severe_incidence_rendering_max_ages = numeric(0),
age_group_rendering_min_ages = numeric(0),
age_group_rendering_max_ages = numeric(0),
+ # mixing
+ rdt_intercept = -0.968,
+ rdt_coeff = 1.186,
# misc
- custom_demography = FALSE,
- human_population = 100,
- human_population_timesteps = 0,
mosquito_limit = 100 * 1000,
individual_mosquitoes = FALSE,
- enable_heterogeneity = TRUE,
+ human_population_timesteps = 0,
r_tol = 1e-4,
a_tol = 1e-4,
ode_max_steps = 1e6,
diff --git a/R/pev.R b/R/pev.R
index 4c735552..e460e5c3 100644
--- a/R/pev.R
+++ b/R/pev.R
@@ -29,10 +29,18 @@ 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 {
- not_recently_vaccinated <- variables$pev_timestep$get_index_of(
+ not_recently_vaccinated <- variables$last_pev_timestep$get_index_of(
a = max(timestep - parameters$pev_epi_min_wait, 0),
b = timestep
)$not(TRUE)
@@ -48,6 +56,9 @@ create_epi_pev_process <- function(
)
]
+ # Update the latest vaccination time
+ variables$last_pev_timestep$queue_update(timestep, target)
+
schedule_vaccination(
target,
events,
@@ -81,13 +92,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(
+ not_recently_vaccinated <- variables$last_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)
@@ -99,17 +119,17 @@ create_mass_pev_listener <- function(
correlations
)
]
+
+ # Update the latest vaccination time
+ variables$last_pev_timestep$queue_update(timestep, target)
+
+ # Schedule future doses
schedule_vaccination(
target,
events,
parameters,
events$mass_pev_doses
)
- if (time_index < length(parameters$mass_pev_timesteps)) {
- events$mass_pev$schedule(
- parameters$mass_pev_timesteps[[time_index + 1]] - timestep
- )
- }
}
}
@@ -145,7 +165,7 @@ schedule_vaccination <- function(
create_pev_efficacy_listener <- function(variables, pev_profile_index) {
function(timestep, target) {
if (target$size() > 0) {
- variables$pev_timestep$queue_update(timestep, target)
+ variables$last_eff_pev_timestep$queue_update(timestep, target)
variables$pev_profile$queue_update(pev_profile_index, target)
}
}
@@ -154,6 +174,7 @@ create_pev_efficacy_listener <- function(variables, pev_profile_index) {
create_pev_booster_listener <- function(
variables,
coverage,
+ pev_distribution_timesteps,
booster_number,
pev_profile_index,
next_booster_event,
@@ -167,8 +188,13 @@ create_pev_booster_listener <- function(
force(next_booster_delay)
force(coverage)
function(timestep, target) {
- target <- sample_bitset(target, coverage)
- variables$pev_timestep$queue_update(timestep, target)
+ 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)
renderer$render(render_name, target$size(), timestep)
@@ -210,6 +236,7 @@ create_dosage_renderer <- function(renderer, strategy, dose) {
attach_pev_dose_listeners <- function(
variables,
parameters,
+ pev_distribution_timesteps,
dose_events,
booster_events,
booster_delays,
@@ -223,6 +250,12 @@ attach_pev_dose_listeners <- function(
dose_events[[d]]$add_listener(
create_dosage_renderer(renderer, strategy, d)
)
+ # update last vaccination on every primary dose
+ dose_events[[d]]$add_listener(
+ function(t, target) {
+ variables$last_pev_timestep$queue_update(t, target)
+ }
+ )
if (d == length(dose_events)) {
dose_events[[d]]$add_listener(
create_pev_efficacy_listener(
@@ -270,7 +303,8 @@ attach_pev_dose_listeners <- function(
booster_events[[b]]$add_listener(
create_pev_booster_listener(
variables = variables,
- coverage = booster_coverages[[b]],
+ 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 aeb6bd5b..bc0c4788 100644
--- a/R/pev_parameters.R
+++ b/R/pev_parameters.R
@@ -30,7 +30,7 @@ create_pev_profile <- function(vmax, alpha, beta, cs, rho, ds, dl) {
#' @title RTS,S vaccine profile
#' @description Parameters for a primary dose of RTS,S for use with the
-#' set_mass_pev and set_pev_epi functions
+#' set_mass_pev and set_pev_epi functions (White MT et al. 2015 Lancet ID)
#' @export
rtss_profile <- create_pev_profile(
vmax = 0.93,
@@ -38,13 +38,28 @@ rtss_profile <- create_pev_profile(
beta = 99.4,
cs = c(6.37008, 0.35),
rho = c(2.37832, 1.00813),
- ds = c(3.74502, 0.341185), # (White MT et al. 2015 Lancet ID)
- dl = c(6.30365, 0.396515) # (White MT et al. 2015 Lancet ID)
+ ds = c(3.74502, 0.341185),
+ dl = c(6.30365, 0.396515)
)
+#' @title R21 vaccine profile
+#' @description Parameters for a primary dose of R21 for use with the
+#' set_mass_pev and set_pev_epi functions (Schmit + Topazian et al. 2022 Lancet ID)
+#' @export
+r21_profile <- create_pev_profile(
+ vmax = 0.87,
+ alpha = 0.91,
+ beta = 471,
+ cs = c(9.3199677, 0.8387902),
+ rho = c(0.8071676, 0.6010363),
+ ds = c(3.7996007, 0.1618982),
+ dl = c(6.2820200, 0.4549185)
+)
+
+
#' @title RTS,S booster vaccine profile
#' @description Parameters for a booster dose of RTS,S for use with the
-#' set_mass_pev and set_pev_epi functions
+#' set_mass_pev and set_pev_epi functions (White MT et al. 2015 Lancet ID)
#' @export
rtss_booster_profile <- create_pev_profile(
vmax = 0.93,
@@ -52,8 +67,22 @@ rtss_booster_profile <- create_pev_profile(
beta = 99.4,
cs = c(5.56277, 0.35),
rho = c(1.03431, 1.02735),
- ds = c(3.74502, 0.341185), # (White MT et al. 2015 Lancet ID)
- dl = c(6.30365, 0.396515) # (White MT et al. 2015 Lancet ID)
+ ds = c(3.74502, 0.341185),
+ dl = c(6.30365, 0.396515)
+)
+
+#' @title R21 booster vaccine profile
+#' @description Parameters for a booster dose of R21 for use with the
+#' set_mass_pev and set_pev_epi functions (Schmit + Topazian et al. 2022 Lancet ID)
+#' @export
+r21_booster_profile <- create_pev_profile(
+ vmax = 0.87,
+ alpha = 0.91,
+ beta = 471,
+ cs = c(9.2372858, 0.7188541),
+ rho = c(0.07140337, 0.54175154),
+ ds = c(3.7996007, 0.1618982),
+ dl = c(6.2820200, 0.4549185)
)
#' @title Parameterise a pre-erythrocytic vaccine with an EPI strategy
@@ -62,9 +91,9 @@ 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 timesteps a vector of timesteps for each change in coverage
#' @param age the age when an individual will receive the first dose of the
#' vaccine (in timesteps)
#' @param min_wait the minimum acceptable time since the last vaccination (in
@@ -72,12 +101,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_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,
@@ -86,33 +114,47 @@ set_pev_epi <- function(
timesteps,
age,
min_wait,
- booster_timestep,
+ booster_spacing,
booster_coverage,
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)){
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)
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')
+ }
+ # 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
@@ -125,7 +167,7 @@ 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_profile_indices <- profile_indices
@@ -139,7 +181,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);
@@ -147,10 +189,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_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,
@@ -160,7 +201,7 @@ set_mass_pev <- function(
min_ages,
max_ages,
min_wait,
- booster_timestep,
+ booster_spacing,
booster_coverage,
booster_profile
) {
@@ -168,13 +209,28 @@ set_mass_pev <- function(
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')
+
+ # 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')
+ }
+ # 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
@@ -189,29 +245,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_profile_indices <- profile_indices
parameters
}
-
-#' @title Parameterise an TBV strategy
-#' @param parameters a list of parameters to modify
-#' @param timesteps a vector of timesteps for each round of vaccinations
-#' @param coverages the coverage for each round of vaccinations
-#' @param ages for each round (in years)
-#' vaccine
-#' @export
-set_tbv <- function(
- parameters,
- timesteps,
- coverages,
- ages
- ) {
- stopifnot(all(coverages >= 0) && all(coverages <= 1))
- parameters$tbv <- TRUE
- parameters$tbv_timesteps <- timesteps
- parameters$tbv_coverages <- coverages
- parameters$tbv_ages <- ages
- parameters
-}
diff --git a/R/pmc.R b/R/pmc.R
index 429bf7d2..6397c681 100644
--- a/R/pmc.R
+++ b/R/pmc.R
@@ -23,54 +23,46 @@ create_pmc_process <- function(
drug
){
renderer$set_default('n_pmc_treated', 0)
+ renderer$set_default(paste0('n_pmc_drug_efficacy_failures'), 0)
+ renderer$set_default(paste0('n_pmc_successfully_treated'), 0)
+
+ if(parameters$antimalarial_resistance){
+ renderer$set_default(paste0('n_pmc_early_treatment_failure'), 0)
+ renderer$set_default(paste0('n_pmc_slow_parasite_clearance'), 0)
+ }
+
function(timestep) {
- timestep_index <- match_timestep(ts = timesteps, t = timestep)
- if(timestep_index == 0){
+ time_index <- match_timestep(ts = timesteps, t = timestep)
+ if(time_index == 0){
return()
}
- coverage <- coverages[timestep_index]
+ coverage <- coverages[time_index]
if(coverage == 0){
return()
}
-
- age <- get_age(variables$birth$get_values(), timestep)
-
- in_age <- which(age %in% parameters$pmc_ages)
+ in_age <- variables$birth$get_index_of(
+ timesteps[time_index] - parameters$pmc_ages
+ )$to_vector()
target <- in_age[sample_intervention(in_age, 'pmc', coverage, correlations)]
renderer$render('n_pmc_treated', length(target), timestep)
+ treated <- individual::Bitset$new(parameters$human_population)$insert(target)
- successful_treatments <- bernoulli(
- length(target),
- parameters$drug_efficacy[[drug]]
+ to_move <- calculate_successful_treatments(
+ parameters,
+ treated,
+ rep(drug, treated$size()),
+ timestep,
+ renderer,
+ "pmc_")
+
+ update_mass_drug_admin(
+ to_move,
+ variables,
+ parameters,
+ timestep,
+ drug
)
- to_move <- individual::Bitset$new(parameters$human_population)
- to_move$insert(target[successful_treatments])
- if (to_move$size() > 0) {
- # Move Diseased
- diseased <- variables$state$get_index_of(c('D', 'A'))$and(to_move)
- if (diseased$size() > 0) {
- variables$state$queue_update('Tr', diseased)
- }
-
- # Move everyone else
- other <- to_move$copy()$and(diseased$not(TRUE))
- if (other$size() > 0) {
- variables$state$queue_update('S', other)
- }
-
- # Update infectivity
- variables$infectivity$queue_update(
- variables$infectivity$get_values(
- to_move
- ) * parameters$drug_rel_c[[drug]],
- to_move
- )
-
- # Update drug
- variables$drug$queue_update(drug, to_move)
- variables$drug_time$queue_update(timestep, to_move)
- }
}
}
\ No newline at end of file
diff --git a/R/processes.R b/R/processes.R
index 6109490f..12ee3528 100644
--- a/R/processes.R
+++ b/R/processes.R
@@ -14,8 +14,10 @@
#' population and species in the simulation
#' @param lagged_infectivity a list of LaggedValue objects for FOIM for each population
#' in the simulation
+#' @param timesteps Number of timesteps
#' @param mixing a vector of mixing coefficients for the lagged transmission
#' values (default: 1)
+#' @param mixing_fn function to retrieve mixed EIR and infectivity values
#' @param mixing_index an index for this population's position in the
#' lagged transmission lists (default: 1)
#' @noRd
@@ -29,28 +31,36 @@ create_processes <- function(
correlations,
lagged_eir,
lagged_infectivity,
- mixing = 1,
+ timesteps,
+ mixing_fn = NULL,
mixing_index = 1
) {
+
# ========
# Immunity
# ========
processes <- list(
# Maternal immunity
- create_exponential_decay_process(variables$icm, parameters$rm),
- create_exponential_decay_process(variables$ivm, parameters$rvm),
+ immunity_process = create_exponential_decay_process(variables$icm,
+ parameters$rm),
+ immunity_process = create_exponential_decay_process(variables$ivm,
+ parameters$rvm),
# Blood immunity
- create_exponential_decay_process(variables$ib, parameters$rb),
+ immunity_process = create_exponential_decay_process(variables$ib,
+ parameters$rb),
# Acquired immunity
- create_exponential_decay_process(variables$ica, parameters$rc),
- create_exponential_decay_process(variables$iva, parameters$rva),
- create_exponential_decay_process(variables$id, parameters$rid)
+ immunity_process = create_exponential_decay_process(variables$ica,
+ parameters$rc),
+ immunity_process = create_exponential_decay_process(variables$iva,
+ parameters$rva),
+ immunity_process = create_exponential_decay_process(variables$id,
+ parameters$rid)
)
-
+
if (parameters$individual_mosquitoes) {
processes <- c(
processes,
- create_mosquito_emergence_process(
+ mosquito_emergence_process = create_mosquito_emergence_process(
solvers,
variables$mosquito_state,
variables$species,
@@ -60,15 +70,35 @@ create_processes <- function(
)
}
+ # =====================================================
+ # Competing Hazard Outcomes (infections and disease progression)
+ # =====================================================
+
+ infection_outcome <- CompetingOutcome$new(
+ targeted_process = function(timestep, target){
+ infection_outcome_process(timestep, target,
+ variables, renderer, parameters,
+ prob = rate_to_prob(infection_outcome$rates))
+ },
+ size = parameters$human_population
+ )
+
+ progression_outcome <- CompetingOutcome$new(
+ targeted_process = function(timestep, target){
+ progression_outcome_process(timestep, target, variables, parameters, renderer)
+ },
+ size = parameters$human_population
+ )
+
# ==============================
# Biting and mortality processes
# ==============================
- # schedule infections for humans and set last_boosted_*
+ # simulate bites, calculates infection rates for bitten humans and set last_boosted_*
# move mosquitoes into incubating state
# kill mosquitoes caught in vector control
processes <- c(
processes,
- create_biting_process(
+ biting_process = create_biting_process(
renderer,
solvers,
models,
@@ -77,40 +107,28 @@ create_processes <- function(
parameters,
lagged_infectivity,
lagged_eir,
- mixing,
- mixing_index
- ),
- create_mortality_process(variables, events, renderer, parameters),
- create_asymptomatic_progression_process(
- variables$state,
- parameters$dd,
+ mixing_fn,
+ mixing_index,
+ infection_outcome
+ )
+ )
+
+ # ===================
+ # Disease Progression
+ # ===================
+
+ processes <- c(
+ processes,
+ progression_process = create_progression_rates_process(
variables,
- parameters
+ progression_outcome
),
- create_progression_process(
- variables$state,
- 'A',
- 'U',
- parameters$da,
- variables$infectivity,
- parameters$cu
- ),
- create_progression_process(
- variables$state,
- 'U',
- 'S',
- parameters$du,
- variables$infectivity,
- 0
- ),
- create_progression_process(
- variables$state,
- 'Tr',
- 'S',
- parameters$dt,
- variables$infectivity,
- 0
- )
+
+ # Resolve competing hazards of infection with disease progression
+ hazard_resolution_process = CompetingHazard$new(
+ outcomes = list(infection_outcome, progression_outcome),
+ size = parameters$human_population
+ )$resolve
)
# ===============
@@ -118,16 +136,16 @@ create_processes <- function(
# ===============
processes <- c(
processes,
- create_solver_stepping_process(solvers, parameters)
+ solver_process = create_solver_stepping_process(solvers, parameters)
)
-
+
# =========
- # RTS,S EPI
+ # PEV EPI
# =========
if (!is.null(parameters$pev_epi_coverage)) {
processes <- c(
processes,
- create_epi_pev_process(
+ epi_pev_process = create_epi_pev_process(
variables,
events,
parameters,
@@ -137,14 +155,14 @@ create_processes <- function(
)
)
}
-
+
# =========
# PMC
# =========
if(!is.null(parameters$pmc_coverages)){
processes <- c(
processes,
- create_pmc_process(
+ pmc_process = create_pmc_process(
variables,
events,
parameters,
@@ -156,41 +174,55 @@ create_processes <- function(
)
)
}
-
+
# =========
# Rendering
# =========
+
+ imm_var_names <- c('ica', 'icm', 'id', 'ib', 'iva', 'ivm')
+
processes <- c(
processes,
- individual::categorical_count_renderer_process(
- renderer,
- variables$state,
- c('S', 'A', 'D', 'U', 'Tr')
- ),
- create_variable_mean_renderer_process(
+ categorical_renderer = individual::categorical_count_renderer_process(
+ renderer,
+ variables$state,
+ c('S', 'A', 'D', 'U', 'Tr')
+ ),
+ immunity_renderer = create_variable_mean_renderer_process(
renderer,
- c('ica', 'icm', 'ib', 'id', 'iva', 'ivm'),
- variables[c('ica', 'icm', 'ib', 'id', 'iva', 'ivm')]
+ imm_var_names,
+ variables[imm_var_names]
),
- create_prevelance_renderer(
+ prevalence_renderer = create_prevalence_renderer(
variables$state,
variables$birth,
variables$id,
parameters,
renderer
),
- create_age_group_renderer(
+ age_group_renderer = create_age_group_renderer(
+ variables$birth,
+ parameters,
+ renderer
+ ),
+ age_aggregated_immunity_renderer = create_age_variable_mean_renderer_process(
+ imm_var_names[paste0(imm_var_names,"_rendering_min_ages") %in% names(parameters)],
+ variables[imm_var_names[paste0(imm_var_names,"_rendering_min_ages") %in% names(parameters)]],
variables$birth,
parameters,
renderer
),
- create_compartmental_rendering_process(renderer, solvers, parameters)
+ mosquito_state_renderer = create_compartmental_rendering_process(
+ renderer,
+ solvers,
+ parameters
+ )
)
-
+
if (parameters$individual_mosquitoes) {
processes <- c(
processes,
- create_vector_count_renderer_individual(
+ vector_count_renderer = create_vector_count_renderer_individual(
variables$mosquito_state,
variables$species,
variables$mosquito_state,
@@ -201,48 +233,68 @@ create_processes <- function(
} else {
processes <- c(
processes,
- create_total_M_renderer_compartmental(
+ vector_count_renderer = create_total_M_renderer_compartmental(
renderer,
solvers,
parameters
)
)
}
-
+
# ======================
# Intervention processes
# ======================
-
+
if (parameters$bednets) {
processes <- c(
processes,
- distribute_nets(
+ distribute_nets_process = distribute_nets(
variables,
events$throw_away_net,
parameters,
correlations
),
- net_usage_renderer(variables$net_time, renderer)
+ net_usage_renderer = net_usage_renderer(variables$net_time, renderer)
)
}
-
+
if (parameters$spraying) {
processes <- c(
processes,
- indoor_spraying(variables$spray_time, parameters, correlations)
+ indoor_spraying_process = indoor_spraying(
+ variables$spray_time,
+ renderer,
+ parameters,
+ correlations
+ )
)
}
-
+
# ======================
# Progress bar process
# ======================
if (parameters$progress_bar){
processes <- c(
processes,
- create_progress_process(timesteps)
+ progress_bar_process = create_progress_process(timesteps)
)
}
+
+ # ======================
+ # Mortality step
+ # ======================
+ # Mortality is not resolved as a competing hazard
+ processes <- c(
+ processes,
+ mortality_process = create_mortality_process(
+ variables,
+ events,
+ renderer,
+ parameters
+ )
+ )
+
processes
}
@@ -259,14 +311,15 @@ create_processes <- function(
#' @param rate the exponential rate
#' @noRd
create_exponential_decay_process <- function(variable, rate) {
+ stopifnot(inherits(variable, "DoubleVariable"))
decay_rate <- exp(-1/rate)
- function(timestep) variable$queue_update(variable$get_values() * decay_rate)
+ exponential_process_cpp(variable$.variable, decay_rate)
}
#' @title Create and initialise lagged_infectivity object
#'
#' @param variables model variables for initialisation
-#' @param parameters model parameters
+#' @param parameters model parameters
#' @noRd
create_lagged_infectivity <- function(variables, parameters) {
age <- get_age(variables$birth$get_values(), 0)
@@ -283,7 +336,7 @@ create_lagged_infectivity <- function(variables, parameters) {
#'
#' @param variables model variables for initialisation
#' @param solvers model differential equation solvers
-#' @param parameters model parameters
+#' @param parameters model parameters
#' @noRd
create_lagged_eir <- function(variables, solvers, parameters) {
lapply(
diff --git a/R/render.R b/R/render.R
index 3fcf4882..5ba9d79d 100644
--- a/R/render.R
+++ b/R/render.R
@@ -4,8 +4,11 @@ in_age_range <- function(birth, timestep, lower, upper) {
#' @title Render prevalence statistics
#'
-#' @description renders prevalence numerators and denominators for indivduals
-#' detected by microscopy and with severe malaria
+#' @description renders prevalence numerators and denominators for individuals
+#' detected by light microscopy and pcr, where those infected asymptomatically by
+#' P. falciparum have reduced probability of infection due to detectability
+#' immunity (reported as an integer sample: n_detect_lm, and summing over
+#' detection probabilities: p_detect_lm)
#'
#' @param state human infection state
#' @param birth variable for birth of the individual
@@ -14,13 +17,13 @@ in_age_range <- function(birth, timestep, lower, upper) {
#' @param renderer model renderer
#'
#' @noRd
-create_prevelance_renderer <- function(
- state,
- birth,
- immunity,
- parameters,
- renderer
- ) {
+create_prevalence_renderer <- function(
+ state,
+ birth,
+ immunity,
+ parameters,
+ renderer
+) {
function(timestep) {
asymptomatic <- state$get_index_of('A')
prob <- probability_of_detection(
@@ -32,41 +35,40 @@ create_prevelance_renderer <- function(
clinically_detected <- state$get_index_of(c('Tr', 'D'))
detected <- clinically_detected$copy()$or(asymptomatic_detected)
-
+ pcr_detected <- state$get_index_of(c('Tr', 'D', 'A', 'U'))
+
for (i in seq_along(parameters$prevalence_rendering_min_ages)) {
lower <- parameters$prevalence_rendering_min_ages[[i]]
upper <- parameters$prevalence_rendering_max_ages[[i]]
in_age <- in_age_range(birth, timestep, lower, upper)
renderer$render(
- paste0('n_', lower, '_', upper),
- in_age$size(),
- timestep
- )
- renderer$render(
- paste0('n_detect_', lower, '_', upper),
+ paste0('n_detect_lm_', lower, '_', upper),
in_age$copy()$and(detected)$size(),
timestep
)
renderer$render(
- paste0('p_detect_', lower, '_', upper),
+ paste0('p_detect_lm_', lower, '_', upper),
in_age$copy()$and(clinically_detected)$size() + sum(
prob[bitset_index(asymptomatic, in_age)]
),
timestep
)
+ renderer$render(
+ paste0('n_detect_pcr_', lower, '_', upper),
+ pcr_detected$copy()$and(in_age)$size(),
+ timestep
+ )
}
}
}
#' @title Render incidence statistics
#'
-#' @description renders incidence (new for this timestep) for indivduals
+#' @description renders incidence (new for this timestep) for individuals
#'
#' @param birth variable for birth of the individual
#' @param renderer object for model outputs
#' @param target incidence population
-#' @param source_pop the population which is sampled for infection
-#' @param prob probability of infection
#' @param prefix for model outputs
#' @param lowers age bounds
#' @param uppers age bounds
@@ -74,27 +76,54 @@ create_prevelance_renderer <- function(
#'
#' @noRd
incidence_renderer <- function(
- birth,
- renderer,
- target,
- source_pop,
- prob,
- prefix,
- lowers,
- uppers,
- timestep
- ) {
+ birth,
+ renderer,
+ target,
+ prefix,
+ lowers,
+ uppers,
+ timestep
+) {
for (i in seq_along(lowers)) {
lower <- lowers[[i]]
upper <- uppers[[i]]
in_age <- in_age_range(birth, timestep, lower, upper)
- renderer$render(paste0('n_', lower, '_', upper), in_age$size(), timestep)
renderer$render(
paste0('n_', prefix, lower, '_', upper),
in_age$copy()$and(target)$size(),
timestep
)
+ }
+}
+#' @title Render probability of incidence statistics
+#'
+#' @description renders probability of incidence (new for this timestep) for individuals
+#'
+#' @param birth variable for birth of the individual
+#' @param renderer object for model outputs
+#' @param source_pop the population which is sampled for infection (bitten SAU for incidence, infecte for clinical/severe)
+#' @param prob probability of infection
+#' @param prefix for model outputs
+#' @param lowers age bounds
+#' @param uppers age bounds
+#' @param timestep current target
+#'
+#' @noRd
+incidence_probability_renderer <- function(
+ birth,
+ renderer,
+ source_pop,
+ prob,
+ prefix,
+ lowers,
+ uppers,
+ timestep
+) {
+ for (i in seq_along(lowers)) {
+ lower <- lowers[[i]]
+ upper <- uppers[[i]]
+ in_age <- in_age_range(birth, timestep, lower, upper)
renderer$render(
paste0('p_', prefix, lower, '_', upper),
sum(prob[bitset_index(source_pop, in_age)]),
@@ -104,9 +133,9 @@ incidence_renderer <- function(
}
create_variable_mean_renderer_process <- function(
- renderer,
- names,
- variables
+ renderer,
+ names,
+ variables
) {
function(timestep) {
for (i in seq_along(variables)) {
@@ -119,13 +148,37 @@ create_variable_mean_renderer_process <- function(
}
}
+create_age_variable_mean_renderer_process <- function(
+ names,
+ variables,
+ birth,
+ parameters,
+ renderer
+) {
+ function(timestep) {
+ for (i in seq_along(variables)) {
+ for (j in seq_along(parameters[[paste0(names[[i]],"_rendering_min_ages")]])) {
+ lower <- parameters[[paste0(names[[i]],"_rendering_min_ages")]][[j]]
+ upper <- parameters[[paste0(names[[i]],"_rendering_max_ages")]][[j]]
+ in_age <- in_age_range(birth, timestep, lower, upper)
+ renderer$render(paste0('n_', lower, '_', upper), in_age$size(), timestep)
+ renderer$render(
+ paste0(names[[i]], '_mean_', lower, '_', upper),
+ mean(variables[[i]]$get_values(index = in_age)),
+ timestep
+ )
+ }
+ }
+ }
+}
+
create_vector_count_renderer_individual <- function(
- mosquito_state,
- species,
- state,
- renderer,
- parameters
- ) {
+ mosquito_state,
+ species,
+ state,
+ renderer,
+ parameters
+) {
function(timestep) {
adult <- mosquito_state$get_index_of('NonExistent')$not(TRUE)
for (i in seq_along(parameters$species)) {
@@ -146,7 +199,7 @@ create_total_M_renderer_compartmental <- function(renderer, solvers, parameters)
function(timestep) {
total_M <- 0
for (i in seq_along(solvers)) {
- row <- solver_get_states(solvers[[i]])
+ row <- solvers[[i]]$get_states()
species_M <- sum(row[ADULT_ODE_INDICES])
total_M <- total_M + species_M
renderer$render(paste0('total_M_', parameters$species[[i]]), species_M, timestep)
@@ -159,10 +212,23 @@ create_age_group_renderer <- function(
parameters,
renderer
) {
+
+ age_ranges <- rbind(
+ cbind(parameters$prevalence_rendering_min_ages, parameters$prevalence_rendering_max_ages),
+ cbind(parameters$incidence_rendering_min_ages, parameters$incidence_rendering_max_ages),
+ cbind(parameters$clinical_incidence_rendering_min_ages, parameters$clinical_incidence_rendering_max_ages),
+ cbind(parameters$severe_incidence_rendering_min_ages, parameters$severe_incidence_rendering_max_ages),
+ cbind(parameters$age_group_rendering_min_ages, parameters$age_group_rendering_max_ages)
+ )
+
+ unique_age_combinations <- as.data.frame(unique(age_ranges))
+ ordered_unique_age_combinations <- unique_age_combinations[order(unique_age_combinations$V1, unique_age_combinations$V2), ]
+
function(timestep) {
- for (i in seq_along(parameters$age_group_rendering_min_ages)) {
- lower <- parameters$age_group_rendering_min_ages[[i]]
- upper <- parameters$age_group_rendering_max_ages[[i]]
+
+ for (i in seq_along(ordered_unique_age_combinations$V1)) {
+ lower <- ordered_unique_age_combinations$V1[[i]]
+ upper <- ordered_unique_age_combinations$V2[[i]]
in_age <- in_age_range(birth, timestep, lower, upper)
renderer$render(
paste0('n_age_', lower, '_', upper),
@@ -172,3 +238,60 @@ create_age_group_renderer <- function(
}
}
}
+
+
+populate_incidence_rendering_columns <- function(renderer, parameters){
+
+ # infections must render in all simulations
+ renderer$set_default('n_infections', 0)
+
+ # treatment associated only renders when drugs are used
+ if(sum(unlist(parameters$clinical_treatment_coverages))>0){
+ renderer$set_default('ft', 0)
+ renderer$set_default('n_treated', 0)
+ renderer$set_default('n_drug_efficacy_failures', 0)
+ renderer$set_default('n_successfully_treated', 0)
+ }
+
+ # ETC, SPC only render when antimalarial resistance is on
+ if(parameters$antimalarial_resistance){
+ renderer$set_default('n_early_treatment_failure', 0)
+ renderer$set_default('n_slow_parasite_clearance', 0)
+ }
+
+ if(length(parameters$incidence_rendering_min_ages)>0){
+ render_initial_incidence(renderer,
+ parameters$incidence_rendering_min_ages,
+ parameters$incidence_rendering_max_ages,
+ "inc")
+ }
+
+ if(length(parameters$clinical_incidence_rendering_min_ages)>0){
+ render_initial_incidence(renderer,
+ parameters$clinical_incidence_rendering_min_ages,
+ parameters$clinical_incidence_rendering_max_ages,
+ "inc_clinical")
+ }
+
+ if(length(parameters$severe_incidence_rendering_min_ages)>0){
+ render_initial_incidence(renderer,
+ parameters$severe_incidence_rendering_min_ages,
+ parameters$severe_incidence_rendering_max_ages,
+ "inc_severe")
+ }
+
+}
+
+render_initial_incidence <- function(renderer, lower_vals, upper_vals, inc_name){
+ for (i in seq_along(lower_vals)){
+ renderer$set_default(paste0('n_', inc_name, "_", lower_vals[i], '_', upper_vals[i]), 0)
+ renderer$set_default(paste0('p_', inc_name, "_", lower_vals[i], '_', upper_vals[i]), 0)
+ }
+}
+
+
+populate_metapopulation_incidence_rendering_columns <- function(renderer, parameters){
+ for(i in length(parameters)){
+ populate_incidence_rendering_columns(renderer[[i]], parameters[[i]])
+ }
+}
diff --git a/R/tbv.R b/R/tbv.R
index 27c29dfb..d0f75de1 100644
--- a/R/tbv.R
+++ b/R/tbv.R
@@ -75,11 +75,6 @@ create_tbv_listener <- function(variables, events, parameters, correlations, ren
to_vaccinate
)
}
- if (time_index < length(parameters$tbv_timesteps)) {
- events$tbv_vaccination$schedule(
- parameters$tbv_timesteps[[time_index + 1]] - timestep
- )
- }
}
}
diff --git a/R/tbv_parameters.R b/R/tbv_parameters.R
new file mode 100644
index 00000000..089455a2
--- /dev/null
+++ b/R/tbv_parameters.R
@@ -0,0 +1,23 @@
+#' @title Parameterise an TBV strategy
+#' @param parameters a list of parameters to modify
+#' @param timesteps a vector of timesteps for each round of vaccinations
+#' @param coverages the coverage for each round of vaccinations
+#' @param ages a vector of ages of the target population (in years)
+#' @export
+set_tbv <- function(
+ parameters,
+ timesteps,
+ coverages,
+ ages
+ ) {
+ stopifnot(all(coverages >= 0) && all(coverages <= 1))
+ if(length(coverages) != length(timesteps)){
+ stop("coverages and timesteps do no align")
+ }
+
+ parameters$tbv <- TRUE
+ parameters$tbv_timesteps <- timesteps
+ parameters$tbv_coverages <- coverages
+ parameters$tbv_ages <- ages
+ parameters
+}
diff --git a/R/utils.R b/R/utils.R
index f25244bd..0c98b099 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -64,3 +64,57 @@ rtexp <- function(n, m, t) { itexp(runif(n), m, t) }
match_timestep <- function(ts, t) {
min(sum(ts <= t), length(ts))
}
+
+#'@title Time cache a function
+#'@description caches function outputs based on the timestep argument
+#'@param fn function to cache
+#'@noRd
+time_cached <- function(fn) {
+ cache <- new.env()
+ cache$timestep <- -1
+ function(..., timestep) {
+ if (cache$timestep != timestep) {
+ cache$value <- fn(..., timestep)
+ cache$timestep <- timestep
+ }
+ cache$value
+ }
+}
+
+#' @title a placeholder class to save the random number generator class.
+#' @description the class integrates with the simulation loop to save and
+#' restore the random number generator class when appropriate.
+#' @noRd
+RandomState <- R6::R6Class(
+ 'RandomState',
+ private = list(
+ restore_random_state = NULL
+ ),
+ public = list(
+ initialize = function(restore_random_state) {
+ private$restore_random_state <- restore_random_state
+ },
+ save_state = function() {
+ random_save_state()
+ },
+ restore_state = function(t, state) {
+ if (private$restore_random_state) {
+ random_restore_state(state)
+ }
+ }
+ )
+)
+
+#'@title Convert probability to a rate
+#'@param prob probability
+#'@noRd
+prob_to_rate <- function(prob){
+ -log(1 - prob)
+}
+
+#'@title Convert rate to a probability
+#'@param rate rate
+#'@noRd
+rate_to_prob <- function(rate){
+ 1 - exp(-rate)
+}
diff --git a/R/variables.R b/R/variables.R
index 0931b3f7..66f0ce4f 100644
--- a/R/variables.R
+++ b/R/variables.R
@@ -1,4 +1,4 @@
-#' @title Define model variables
+#' @title Define model variables
#' @description
#' create_variables creates the human and mosquito variables for
#' the model. Variables are used to track real data for each individual over
@@ -18,10 +18,13 @@
#' * ID - Acquired immunity to detectability
#' * zeta - Heterogeneity of human individuals
#' * zeta_group - Discretised heterogeneity of human individuals
-#' * pev_timestep - The timestep of the last pev vaccination (-1 if there
-#' haven't been any)
-#' * pev_profile - The index of the profile of the last administered pev vaccine
-#' (-1 if there haven't been any)
+#' * last_pev_timestep - The timestep of the last pev vaccination (-1 if there
+#' * last_eff_pev_timestep - The timestep of the last efficacious pev
+#' vaccination, including final primary dose and booster doses (-1 if there have not been any)
+#' * pev_profile - The index of the efficacy profile of any pev vaccinations.
+#' Not set until the final primary dose.
+#' This is only set on the final primary dose and subsequent booster doses
+#' (-1 otherwise)
#' * tbv_vaccinated - The timstep of the last tbv vaccination (-1 if there
#' haven't been any
#' * net_time - The timestep when a net was last put up (-1 if never)
@@ -30,6 +33,9 @@
#' * drug - The last prescribed drug
#' * drug_time - The timestep of the last drug
#'
+#' Antimalarial resistance variables are:
+#' * dt - the delay for humans to move from state Tr to state S
+#'
#' Mosquito variables are:
#' * mosquito_state - the state of the mosquito, a category Sm|Pm|Im|NonExistent
#' * species - the species of mosquito, this is a category gamb|fun|arab
@@ -172,6 +178,7 @@ create_variables <- function(parameters) {
diseased <- state$get_index_of('D')$to_vector()
asymptomatic <- state$get_index_of('A')$to_vector()
subpatent <- state$get_index_of('U')$to_vector()
+ treated <- state$get_index_of('Tr')$to_vector()
# Set the initial infectivity values for each individual
infectivity_values[diseased] <- parameters$cd
@@ -185,10 +192,21 @@ create_variables <- function(parameters) {
# Initialise the infectivity variable
infectivity <- individual::DoubleVariable$new(infectivity_values)
+ # Set disease progression rates for each individual
+ progression_rate_values <- rep(0, get_human_population(parameters, 0))
+ progression_rate_values[diseased] <- 1/parameters$dd
+ progression_rate_values[asymptomatic] <- 1/parameters$da
+ progression_rate_values[subpatent] <- 1/parameters$du
+ progression_rate_values[treated] <- 1/parameters$dt
+
+ # Initialise the disease progression rate variable
+ progression_rates <- individual::DoubleVariable$new(progression_rate_values)
+
drug <- individual::IntegerVariable$new(rep(0, size))
drug_time <- individual::IntegerVariable$new(rep(-1, size))
- pev_timestep <- individual::IntegerVariable$new(rep(-1, size))
+ last_pev_timestep <- individual::IntegerVariable$new(rep(-1, size))
+ last_eff_pev_timestep <- individual::IntegerVariable$new(rep(-1, size))
pev_profile <- individual::IntegerVariable$new(rep(-1, size))
tbv_vaccinated <- individual::DoubleVariable$new(rep(-1, size))
@@ -213,14 +231,17 @@ create_variables <- function(parameters) {
zeta = zeta,
zeta_group = zeta_group,
infectivity = infectivity,
+ progression_rates = progression_rates,
drug = drug,
drug_time = drug_time,
- pev_timestep = pev_timestep,
+ last_pev_timestep = last_pev_timestep,
+ last_eff_pev_timestep = last_eff_pev_timestep,
pev_profile = pev_profile,
tbv_vaccinated = tbv_vaccinated,
net_time = net_time,
spray_time = spray_time
)
+
# Add variables for individual mosquitoes
if (parameters$individual_mosquitoes) {
@@ -378,9 +399,10 @@ calculate_initial_ages <- function(parameters) {
n_pop <- get_human_population(parameters, 0)
# check if we've set up a custom demography
if (!parameters$custom_demography) {
- return(round(rexp(
+ return(round(rtexp(
n_pop,
- rate = 1 / parameters$average_age
+ 1 / parameters$average_age,
+ max(EQUILIBRIUM_AGES)*365
)))
}
diff --git a/R/vector_control.R b/R/vector_control.R
index 29c92d35..74ea0edb 100644
--- a/R/vector_control.R
+++ b/R/vector_control.R
@@ -102,10 +102,12 @@ prob_bitten <- function(
#' `get_correlation_parameters`
#'
#' @param spray_time the variable for the time of spraying
+#' @param renderer model rendering object
#' @param parameters the model parameters
#' @param correlations correlation parameters
#' @noRd
-indoor_spraying <- function(spray_time, parameters, correlations) {
+indoor_spraying <- function(spray_time, renderer, parameters, correlations) {
+ renderer$set_default('n_spray', 0)
function(timestep) {
matches <- timestep == parameters$spraying_timesteps
if (any(matches)) {
@@ -116,6 +118,7 @@ indoor_spraying <- function(spray_time, parameters, correlations) {
correlations
))
spray_time$queue_update(timestep, target)
+ renderer$render('n_spray', length(target), timestep)
}
}
}
diff --git a/R/vector_control_parameters.R b/R/vector_control_parameters.R
index 97c3ce56..43c7c854 100644
--- a/R/vector_control_parameters.R
+++ b/R/vector_control_parameters.R
@@ -143,23 +143,24 @@ set_spraying <- function(
#'
#' @param parameters the model parameters
#' @param timesteps vector of timesteps for each rescale change
-#' @param carrying_capacity matrix of baseline carrying_capacity for each species
-#' With nrows = length(timesteps), ncols = length(species)
+#' @param carrying_capacity_scalers matrix of scaling factors to scale the baseline
+#' carrying capacity for each species with nrows = length(timesteps),
+#' ncols = length(species)
#'
#' @export
set_carrying_capacity <- function(
parameters,
timesteps,
- carrying_capacity
+ carrying_capacity_scalers
){
- stopifnot(nrow(carrying_capacity) == length(timesteps))
- stopifnot(ncol(carrying_capacity) == length(parameters$species))
+ stopifnot(nrow(carrying_capacity_scalers) == length(timesteps))
+ stopifnot(ncol(carrying_capacity_scalers) == length(parameters$species))
stopifnot(min(timesteps) > 0)
- stopifnot(min(carrying_capacity) >= 0)
+ stopifnot(min(carrying_capacity_scalers) >= 0)
parameters$carrying_capacity <- TRUE
parameters$carrying_capacity_timesteps <- timesteps
- parameters$carrying_capacity_values <- carrying_capacity
+ parameters$carrying_capacity_scalers <- carrying_capacity_scalers
parameters
}
diff --git a/README.md b/README.md
index b86f6ac3..5afe6092 100644
--- a/README.md
+++ b/README.md
@@ -1,7 +1,7 @@
[](https://github.com/mrc-ide/malariasimulation/actions)
[](https://codecov.io/github/mrc-ide/malariasimulation)
-# malariasimulation
+# malariasimulation 
Imperial College London's next malaria simulation. The main goals are make an
extensible, maintainable and fast simulation to evaluate and report on malaria
@@ -9,6 +9,7 @@ intervention strategies.
The model is defined in this package, whereas the simulation is executed using
the [individual](https://github.com/mrc-ide/individual) package.
+
## Installation
diff --git a/_pkgdown.yml b/_pkgdown.yml
index b0483379..06822611 100644
--- a/_pkgdown.yml
+++ b/_pkgdown.yml
@@ -48,6 +48,7 @@ reference:
- run_simulation
- run_metapop_simulation
- run_simulation_with_repetitions
+ - run_resumable_simulation
- title: "Parameter functions"
contents:
- get_parameters
diff --git a/man/CorrelationParameters.Rd b/man/CorrelationParameters.Rd
index c2e6ada7..0aebf688 100644
--- a/man/CorrelationParameters.Rd
+++ b/man/CorrelationParameters.Rd
@@ -2,14 +2,37 @@
% Please edit documentation in R/correlation.R
\name{CorrelationParameters}
\alias{CorrelationParameters}
-\title{Class: Correlation parameters
-Describes an event in the simulation}
+\title{Class: Correlation parameters}
\description{
Class: Correlation parameters
-Describes an event in the simulation
Class: Correlation parameters
-Describes an event in the simulation
+}
+\details{
+This class implements functionality that allows interventions to be
+correlated, positively or negatively. By default, interventions are applied
+independently and an individual's probability of receiving two interventions
+(either two separate interventions or two rounds of the same one) is the
+product of the probability of receiving each one.
+
+By setting a positive correlation between two interventions, we can make it
+so that the individuals that receive intervention A are more likely to
+receive intervention B. Conversely, a negative correlation will make it such
+that individuals that receive intervention A are less likely to also receive
+intervention B.
+
+Broadly speaking, the implementation works by assigning at startup a weight
+to each individual and intervention pair, reflecting how likely an individual
+is to receive that intervention. Those weights are derived stochastically
+from the configured correlation parameters.
+
+For a detailed breakdown of the calculations, see Protocol S2 of
+Griffin et al. (2010).
+Derive the mvnorm from the configured correlations.
+
+If a \code{restored_mvnorm} is specified, its columns (corresponding to
+restored interventions) will be re-used as is. Missing columns (for new
+interventions) are derived in accordance with the restored data.
}
\section{Methods}{
\subsection{Public methods}{
@@ -19,6 +42,8 @@ Describes an event in the simulation
\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-save_state}{\code{CorrelationParameters$save_state()}}
+\item \href{#method-CorrelationParameters-restore_state}{\code{CorrelationParameters$restore_state()}}
\item \href{#method-CorrelationParameters-clone}{\code{CorrelationParameters$clone()}}
}
}
@@ -28,13 +53,15 @@ Describes an event in the simulation
\subsection{Method \code{new()}}{
initialise correlation parameters
\subsection{Usage}{
-\if{html}{\out{}}\preformatted{CorrelationParameters$new(parameters)}\if{html}{\out{
}}
+\if{html}{\out{}}\preformatted{CorrelationParameters$new(population, interventions)}\if{html}{\out{
}}
}
\subsection{Arguments}{
\if{html}{\out{}}
\describe{
-\item{\code{parameters}}{model parameters}
+\item{\code{population}}{popularion size}
+
+\item{\code{interventions}}{character vector with the name of enabled interventions}
}
\if{html}{\out{
}}
}
@@ -101,6 +128,41 @@ multivariate norm draws for these parameters
\if{html}{\out{}}\preformatted{CorrelationParameters$mvnorm()}\if{html}{\out{
}}
}
+}
+\if{html}{\out{
}}
+\if{html}{\out{}}
+\if{latex}{\out{\hypertarget{method-CorrelationParameters-save_state}{}}}
+\subsection{Method \code{save_state()}}{
+Save the correlation state.
+\subsection{Usage}{
+\if{html}{\out{}}\preformatted{CorrelationParameters$save_state()}\if{html}{\out{
}}
+}
+
+}
+\if{html}{\out{
}}
+\if{html}{\out{}}
+\if{latex}{\out{\hypertarget{method-CorrelationParameters-restore_state}{}}}
+\subsection{Method \code{restore_state()}}{
+Restore the correlation state.
+
+Only the randomly drawn weights are restored. The object needs to be
+initialized with the same rhos.
+\subsection{Usage}{
+\if{html}{\out{}}\preformatted{CorrelationParameters$restore_state(timestep, state)}\if{html}{\out{
}}
+}
+
+\subsection{Arguments}{
+\if{html}{\out{}}
+\describe{
+\item{\code{timestep}}{the timestep at which simulation is resumed. This
+parameter's value is ignored, it only exists to conform to a uniform
+interface.}
+
+\item{\code{state}}{a previously saved correlation state, as returned by the
+save_state method.}
+}
+\if{html}{\out{
}}
+}
}
\if{html}{\out{
}}
\if{html}{\out{}}
diff --git a/man/figures/malariasimulation.png b/man/figures/malariasimulation.png
new file mode 100644
index 00000000..c0af321b
Binary files /dev/null and b/man/figures/malariasimulation.png differ
diff --git a/man/get_antimalarial_resistance_parameters.Rd b/man/get_antimalarial_resistance_parameters.Rd
new file mode 100644
index 00000000..71de6961
--- /dev/null
+++ b/man/get_antimalarial_resistance_parameters.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/antimalarial_resistance.R
+\name{get_antimalarial_resistance_parameters}
+\alias{get_antimalarial_resistance_parameters}
+\title{Retrieve resistance parameters}
+\usage{
+get_antimalarial_resistance_parameters(parameters, drugs, timestep)
+}
+\arguments{
+\item{parameters}{the model parameters}
+
+\item{drugs}{vector of integers representing the drugs administered to each individual receiving treatment}
+
+\item{timestep}{the current time step}
+}
+\description{
+Retrieve the resistance parameters associated with the drug each individual receiving clinical
+treatment has been administered in the current time step.
+}
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/get_parameters.Rd b/man/get_parameters.Rd
index 54188c01..955b6910 100644
--- a/man/get_parameters.Rd
+++ b/man/get_parameters.Rd
@@ -10,17 +10,42 @@ get_parameters(overrides = list())
\item{overrides}{a named list of parameter values to use instead of defaults
The parameters are defined below.
-fixed state transitions:
+initial state proportions:
+\itemize{
+\item s_proportion - the proportion of \code{human_population} that begin as susceptible; default = 0.420433246
+\item d_proportion - the proportion of \code{human_population} that begin with
+clinical disease; default = 0.007215064
+\item a_proportion - the proportion of \code{human_population} that begin as
+asymptomatic; default = 0.439323667
+\item u_proportion - the proportion of \code{human_population} that begin as
+subpatents; default = 0.133028023
+\item t_proportion - the proportion of \code{human_population} that begin treated; default = 0
+}
+
+human fixed state transitions:
\itemize{
\item dd - the delay for humans to move from state D to A; default = 5
-\item dt - the delay for humans to move from state Tr to Ph; default = 5
+\item dt - the delay for humans to move from state Tr to S; default = 5
\item da - the delay for humans to move from state A to U; default = 195
\item du - the delay for humans to move from state U to S; default = 110
-\item del - the delay for mosquitoes to move from state E to L; default = 6.64
-\item dl - the delay for mosquitoes to move from state L to P; default = 3.72
-\item dpl - the delay mosquitoes to move from state P to Sm; default = 0.643
-\item mup - the rate at which pupal mosquitoes die; default = 0.249
-\item mum - the rate at which developed mosquitoes die; default (An. gambiae) = .132
+}
+
+human demography parameters:
+\itemize{
+\item human_population - the initial number of humans to model; default = 100
+\item average_age - the average age of humans (in timesteps), this is only used
+if custom_demography is FALSE; default = 7665
+\item custom_demography - population demography given; default = FALSE
+}
+
+initial immunity values:
+\itemize{
+\item init_icm - the immunity from clinical disease at birth; default = 0
+\item init_ivm - the immunity from severe disease at birth; default = 0
+\item init_ib - the initial pre-erythrocitic immunity; default = 0
+\item init_ica - the initial acquired immunity from clinical disease; default = 0
+\item init_iva - the initial acquired immunity from severe disease; default = 0
+\item init_id - the initial acquired immunity to detectability; default = 0
}
immunity decay rates:
@@ -33,6 +58,29 @@ immunity decay rates:
\item rid - decay rate for acquired immunity to detectability; default = 3650
}
+immunity boost grace periods:
+\itemize{
+\item ub - period in which pre-erythrocytic immunity cannot be boosted; default = 7.2
+\item uc - period in which clinical immunity cannot be boosted; default = 6.06
+\item uv - period in which severe immunity cannot be boosted; default = 11.4321
+\item ud - period in which immunity to detectability cannot be boosted; default = 9.44512
+}
+
+maternal immunity parameters:
+\itemize{
+\item pcm - new-born clinical immunity relative to mother's; default = 0.774368
+\item pvm - new-born severe immunity relative to mother's; default = 0.195768
+}
+
+unique biting rate:
+\itemize{
+\item a0 - age dependent biting parameter; default = 2920
+\item rho - age dependent biting parameter; default = 0.85
+\item sigma_squared - heterogeneity parameter; default = 1.67
+\item n_heterogeneity_groups - number discretised groups for heterogeneity, used
+for sampling mothers; default = 5
+}
+
probability of pre-erythrocytic infection:
\itemize{
\item b0 - maximum probability due to no immunity; default = 0.59
@@ -41,6 +89,16 @@ probability of pre-erythrocytic infection:
\item kb - shape parameter; default = 2.16
}
+probability of detection by light-microscopy when asymptomatic:
+\itemize{
+\item fd0 - time-scale at which immunity changes with age; default = 0.007055
+\item ad - scale parameter relating age to immunity; default = 7993.5
+\item gammad - shape parameter relating age to immunity; default = 4.8183
+\item d1 - minimum probability due to immunity; default = 0.160527
+\item id0 - scale parameter; default = 1.577533
+\item kd - shape parameter; default = 0.476614
+}
+
probability of clinical infection:
\itemize{
\item phi0 - maximum probability due to no immunity; default = 0.792
@@ -60,24 +118,6 @@ probability of severe infection:
\item gammav - age dependent modifier; default = 2.91282
}
-immunity reducing probability of detection:
-\itemize{
-\item fd0 - time-scale at which immunity changes with age; default = 0.007055
-\item ad - scale parameter relating age to immunity; default = 7993.5
-\item gammad - shape parameter relating age to immunity; default = 4.8183
-\item d1 - minimum probability due to immunity; default = 0.160527
-\item id0 - scale parameter; default = 1.577533
-\item kd - shape parameter; default = 0.476614
-}
-
-immunity boost grace periods:
-\itemize{
-\item ub - period in which pre-erythrocytic immunity cannot be boosted; default = 7.2
-\item uc - period in which clinical immunity cannot be boosted; default = 6.06
-\item uv - period in which severe immunity cannot be boosted; default = 11.4321
-\item ud - period in which immunity to detectability cannot be boosted; default = 9.44512
-}
-
infectivity towards mosquitoes:
\itemize{
\item cd - infectivity of clinically diseased humans towards mosquitoes; default = 0.068
@@ -86,67 +126,21 @@ infectivity towards mosquitoes:
\item ct - infectivity of treated infection; default = 0.021896
}
-unique biting rate:
-\itemize{
-\item a0 - age dependent biting parameter; default = 2920
-\item rho - age dependent biting parameter; default = 0.85
-\item sigma_squared - heterogeneity parameter; default = 1.67
-\item n_heterogeneity_groups - number discretised groups for heterogeneity, used
-for sampling mothers; default = 5
-}
-
-mortality parameters:
+mosquito fixed state transitions (including mortality):
\itemize{
-\item average_age - the average age of humans (in timesteps), this is only used
-if custom_demography is FALSE; default = 7663
-\item pcm - new-born clinical immunity relative to mother's; default = 0.774368
-\item pvm - new-born severe immunity relative to mother's; default = 0.195768
+\item del - the delay for mosquitoes to move from state E to L; default = 6.64
+\item dl - the delay for mosquitoes to move from state L to P; default = 3.72
+\item dpl - the delay mosquitoes to move from state P to Sm; default = 0.643
\item me - early stage larval mortality rate; default = 0.0338
\item ml - late stage larval mortality rate; default = 0.0348
-}
-
-carrying capacity parameters:
-\itemize{
-\item model_seasonality - boolean switch TRUE iff the simulation models seasonal rainfall; default = FALSE
-\item g0 - rainfall fourier parameter; default = 2
-\item g - rainfall fourier parameter; default = 0.3, 0.6, 0.9
-\item h - rainfall fourier parameters; default = 0.1, 0.4, 0.7
-\item gamma - effect of density dependence on late instars relative to early
-instars; default = 13.25
-\item rainfall_floor - the minimum rainfall value (must be above 0); default 0.001
-}
-
-initial state proportions:
-\itemize{
-\item s_proportion - the proportion of \code{human_population} that begin as susceptible; default = 0.420433246
-\item d_proportion - the proportion of \code{human_population} that begin with
-clinical disease; default = 0.007215064
-\item a_proportion - the proportion of \code{human_population} that begin as
-asymptomatic; default = 0.439323667
-\item u_proportion - the proportion of \code{human_population} that begin as
-subpatents; default = 0.133028023
-\item t_proportion - the proportion of \code{human_population} that begin treated; default = 0
-}
-
-initial immunity values:
-\itemize{
-\item init_icm - the immunity from clinical disease at birth; default = 0
-\item init_ivm - the immunity from severe disease at birth; default = 0
-\item init_ib - the initial pre-erythrocitic immunity; default = 0
-\item init_ica - the initial acquired immunity from clinical disease; default = 0
-\item init_iva - the initial acquired immunity from severe disease; default = 0
-\item init_id - the initial acquired immunity to detectability; default = 0
-}
-
-incubation periods:
-\itemize{
-\item de - Duration of the human latent period of infection; default = 12
-\item delay_gam - Lag from parasites to infectious gametocytes; default = 12.5
-\item dem - Extrinsic incubation period in mosquito population model; default = 10
+\item mup - the rate at which pupal mosquitoes die; default = 0.249
+\item mum - the rate at which developed mosquitoes die; default (An. gambiae) = .132
}
vector biology:
species specific values are vectors
+please set species parameters using the convenience function
+\code{\link{set_species}}
\itemize{
\item beta - the average number of eggs laid per female mosquito per day; default = 21.2
\item total_M - the initial number of adult mosquitos in the simulation; default = 1000
@@ -158,19 +152,32 @@ species specific values are vectors
\item foraging_time - time spent taking blood meals; default = 0.69
}
-feeding cycle:
-please set vector control strategies using \code{set_betnets} and \code{set_spraying}
+seasonality and carrying capacity parameters:
+please set flexible carrying capacity using the convenience function
+\code{\link{set_carrying_capacity}}
\itemize{
-\item bednets - boolean for if bednets are enabled; default = FALSE
-\item phi_bednets - proportion of bites taken in bed; default = 0.85
-\item k0 - proportion of females bloodfed with no net; default = 0.699
-\item spraying - boolean for if indoor spraying is enabled; default = FALSE
-\item phi_indoors - proportion of bites taken indoors; default = 0.90
+\item model_seasonality - boolean switch TRUE iff the simulation models seasonal rainfall; default = FALSE
+\item g0 - rainfall fourier parameter; default = 2
+\item g - rainfall fourier parameter; default = 0.3, 0.6, 0.9
+\item h - rainfall fourier parameters; default = 0.1, 0.4, 0.7
+\item gamma - effect of density dependence on late instars relative to early
+instars; default = 13.25
+\item rainfall_floor - the minimum rainfall value (must be above 0); default 0.001
+\item carrying_capacity; default = FALSE
+\item carrying_capacity_timesteps; default = NULL
+\item carrying_capacity_values; default = NULL#'
+}
+
+parasite incubation periods:
+\itemize{
+\item de - duration of the human latent period of infection; default = 12
+\item delay_gam - lag from parasites to infectious gametocytes; default = 12.5
+\item dem - extrinsic incubation period in mosquito population model; default = 10
}
treatment parameters:
-please set treatment parameters with the convenience functions in
-\code{drug_parameters.R}
+please set treatment parameters with the convenience functions
+\code{\link{set_drugs}} and \code{\link{set_clinical_treatment}}
\itemize{
\item drug_efficacy - a vector of efficacies for available drugs; default = turned off
\item drug_rel_c - a vector of relative onward infectiousness values for drugs; default = turned off
@@ -183,22 +190,33 @@ clinically diseased (these values refer to the index in drug_* parameters); defa
\item clinical_treatment_coverage - a vector of coverage values for each drug; default = NULL, NULL, NULL
}
+MDA, SMC and PMC parameters:
+please set these parameters with the convenience functions
+\code{\link{set_mda}}, \code{\link{set_smc}} and \code{\link{set_pmc}},
+with \code{\link{peak_season_offset}}
+
+bednet, irs and mosquito feeding cycle parameters:
+please set vector control strategies using \code{\link{set_bednets}} and \code{\link{set_spraying}}
+\itemize{
+\item bednets - boolean for if bednets are enabled; default = FALSE
+\item phi_bednets - proportion of bites taken in bed; default = 0.85
+\item k0 - proportion of females bloodfed with no net; default = 0.699
+\item spraying - boolean for if indoor spraying is enabled; default = FALSE
+\item phi_indoors - proportion of bites taken indoors; default = 0.90
+}
+
PEV parameters:
-please set vaccine strategies with the convenience functions in
-\code{pev_parameters.R:set_pev_epi}
-\code{pev_parameters.R:set_mass_pev}
+please set vaccine strategies with the convenience functions
+\code{\link{set_pev_epi}} and \code{\link{set_mass_pev}}
\itemize{
\item pev_doses - the dosing schedule before the vaccine takes effect; default =
c(0, 1.5 * 30, 3 * 30)
default = 365
}
-MDA, SMC and PMC parameters:
-please set these parameters with the convenience functions in \code{mda_parameters.R}
-
TBV parameters:
please set TBV parameters with the convenience functions in
-\code{vaccine_parameters.R:set_tbv}
+\code{\link{set_tbv}}
\itemize{
\item tbv_mt - effect on treated infectiousness; default = 35
\item tbv_md - effect on diseased infectiousness; default = 46.7
@@ -214,12 +232,29 @@ please set TBV parameters with the convenience functions in
\item tbv_gamma2 - transmission reduction parameter; default = 0.06
}
+Antimalarial resistance parameters:
+please set antimalarial resistance parameters with the convenience functions in
+\code{\link{set_antimalarial_resistance}}
+\itemize{
+\item antimalarial_resistance - boolean for if antimalarial resistance is enabled; default = FALSE
+\item antimalarial_resistance_drug - vector of drugs for which resistance can be parameterised; default = NULL
+\item antimalarial_resistance_timesteps - vector of time steps on which resistance updates occur; default = NULL
+\item artemisinin_resistant_proportion - vector of proportions of infections resistant to the artemisinin component of a given drug; default = NULL
+\item partner_drug_resistance_proportion - vector of proportions of infections resistant to the parter drug component of a given drug; default = NULL
+\item slow_parasite_clearance_probability - vector of probabilities of slow parasite clearance for a given drug; default = NULL
+\item early_treatment_failure_probability - vector of probabilities of early treatment failure for a given drug; default = NULL
+\item late_clinical_failure_probability - vector of probabilities of late clinical failure for a given drug; default = NULL
+\item late_parasitological_failure_probability - vector of probabilities of late parasitological failure for a given drug; default = NULL
+\item reinfection_during_prophylaxis_probability - vector of probabilities of reinfection during prophylaxis for a given drug; default = NULL
+\item dt_slow_parasite_clearance - the delay for humans experiencing slow parasite clearance to move from state Tr to S; default = NULL
+}
+
rendering:
-All values are in timesteps and all ranges are inclusive
+All values are in timesteps and all ranges are inclusive.
+Please set rendered age groups using the convenience function
\itemize{
-\item prevalence_rendering_min_ages - the minimum ages for clinical prevalence
-outputs; default = 730
-\item prevalence_rendering_max_ages - the corresponding max ages; default = 3650
+\item age_group_rendering_min_ages - the minimum ages for population size outputs; default = turned off
+\item age_group_rendering_max_ages - the corresponding max ages; default = turned off
\item incidence_rendering_min_ages - the minimum ages for incidence
outputs (includes asymptomatic microscopy +); default = turned off
\item incidence_rendering_max_ages - the corresponding max ages; default = turned off
@@ -228,17 +263,27 @@ outputs (includes asymptomatic microscopy +); default = turned off
\item severe_incidence_rendering_min_ages - the minimum ages for severe incidence
outputs; default = turned off
\item severe_incidence_rendering_max_ages - the corresponding max ages; default = turned off
+\item prevalence_rendering_min_ages - the minimum ages for clinical prevalence
+outputs; default = 730
+\item prevalence_rendering_max_ages - the corresponding max ages; default = 3650
+}
+
+mixing:
+\itemize{
+\item rdt_intercept - the y intercept for the log logit relationship betweeen rdt
+and PCR prevalence; default = -0.968
+\item rdt_coeff - the coefficient for the log logit relationship betweeen rdt
+and PCR prevalence; default = 1.186
}
miscellaneous:
\itemize{
-\item human_population - the initial number of humans to model; default = 100
-\item human_population_timesteps - the timesteps at which the population should
-change; default = 0
\item mosquito_limit - the maximum number of mosquitoes to allow for in the
simulation; default = 1.00E+05
\item individual_mosquitoes - boolean whether adult mosquitoes are modeled
individually or compartmentally; default = TRUE
+\item human_population_timesteps - the timesteps at which the population should
+change; default = 0
\item r_tol - the relative tolerance for the ode solver; default = 1e-4
\item a_tol - the absolute tolerance for the ode solver; default = 1e-4
\item ode_max_steps - the max number of steps for the solver; default = 1e6
diff --git a/man/r21_booster_profile.Rd b/man/r21_booster_profile.Rd
new file mode 100644
index 00000000..33be187c
--- /dev/null
+++ b/man/r21_booster_profile.Rd
@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/pev_parameters.R
+\docType{data}
+\name{r21_booster_profile}
+\alias{r21_booster_profile}
+\title{R21 booster vaccine profile}
+\format{
+An object of class \code{list} of length 7.
+}
+\usage{
+r21_booster_profile
+}
+\description{
+Parameters for a booster dose of R21 for use with the
+set_mass_pev and set_pev_epi functions (Schmit + Topazian et al. 2022 Lancet ID)
+}
+\keyword{datasets}
diff --git a/man/r21_profile.Rd b/man/r21_profile.Rd
new file mode 100644
index 00000000..836923ee
--- /dev/null
+++ b/man/r21_profile.Rd
@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/pev_parameters.R
+\docType{data}
+\name{r21_profile}
+\alias{r21_profile}
+\title{R21 vaccine profile}
+\format{
+An object of class \code{list} of length 7.
+}
+\usage{
+r21_profile
+}
+\description{
+Parameters for a primary dose of R21 for use with the
+set_mass_pev and set_pev_epi functions (Schmit + Topazian et al. 2022 Lancet ID)
+}
+\keyword{datasets}
diff --git a/man/rtss_booster_profile.Rd b/man/rtss_booster_profile.Rd
index 14f5d40c..939986c9 100644
--- a/man/rtss_booster_profile.Rd
+++ b/man/rtss_booster_profile.Rd
@@ -12,6 +12,6 @@ rtss_booster_profile
}
\description{
Parameters for a booster dose of RTS,S for use with the
-set_mass_pev and set_pev_epi functions
+set_mass_pev and set_pev_epi functions (White MT et al. 2015 Lancet ID)
}
\keyword{datasets}
diff --git a/man/rtss_profile.Rd b/man/rtss_profile.Rd
index 2eef7b56..55d05e7b 100644
--- a/man/rtss_profile.Rd
+++ b/man/rtss_profile.Rd
@@ -12,6 +12,6 @@ rtss_profile
}
\description{
Parameters for a primary dose of RTS,S for use with the
-set_mass_pev and set_pev_epi functions
+set_mass_pev and set_pev_epi functions (White MT et al. 2015 Lancet ID)
}
\keyword{datasets}
diff --git a/man/run_metapop_simulation.Rd b/man/run_metapop_simulation.Rd
index 0a670c34..e067f969 100644
--- a/man/run_metapop_simulation.Rd
+++ b/man/run_metapop_simulation.Rd
@@ -4,7 +4,17 @@
\alias{run_metapop_simulation}
\title{Run a metapopulation model}
\usage{
-run_metapop_simulation(timesteps, parameters, correlations = NULL, mixing)
+run_metapop_simulation(
+ timesteps,
+ parameters,
+ correlations = NULL,
+ mixing_tt,
+ export_mixing,
+ import_mixing,
+ p_captured_tt,
+ p_captured,
+ p_success
+)
}
\arguments{
\item{timesteps}{the number of timesteps to run the simulation for (in days)}
@@ -14,12 +24,27 @@ run_metapop_simulation(timesteps, parameters, correlations = NULL, mixing)
\item{correlations}{a list of correlation parameters for each population
(default: NULL)}
-\item{mixing}{matrix of mixing coefficients for infectivity towards
-mosquitoes. Rows = origin sites, columns = destinations. Each element must
-be between 0 and 1 and all rows must sum to 1.}
+\item{mixing_tt}{a vector of time steps for each mixing matrix}
+
+\item{export_mixing}{a list of matrices of coefficients for exportation of infectivity.
+Rows = origin sites, columns = destinations. Each matrix element
+describes the mixing pattern from destination to origin. Each matrix element must
+be between 0 and 1. Each matrix is activated at the corresponding timestep in mixing_tt}
+
+\item{import_mixing}{a list of matrices of coefficients for importation of
+infectivity.}
+
+\item{p_captured_tt}{a vector of time steps for each p_captured matrix}
+
+\item{p_captured}{a list of matrices representing the probability that
+travel between sites is intervened by a test and treat border check.
+Dimensions are the same as for \code{export_mixing}}
+
+\item{p_success}{the probability that an individual who has tested positive
+(through an RDT) successfully clears their infection through treatment}
}
\value{
-a list of dataframe of results
+a list of dataframe of model outputs as in run_simulation
}
\description{
Run a metapopulation model
diff --git a/man/run_resumable_simulation.Rd b/man/run_resumable_simulation.Rd
new file mode 100644
index 00000000..8991fd1c
--- /dev/null
+++ b/man/run_resumable_simulation.Rd
@@ -0,0 +1,34 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/model.R
+\name{run_resumable_simulation}
+\alias{run_resumable_simulation}
+\title{Run the simulation in a resumable way}
+\usage{
+run_resumable_simulation(
+ timesteps,
+ parameters = NULL,
+ correlations = NULL,
+ initial_state = NULL,
+ restore_random_state = FALSE
+)
+}
+\arguments{
+\item{timesteps}{the timestep at which to stop the simulation}
+
+\item{parameters}{a named list of parameters to use}
+
+\item{correlations}{correlation parameters}
+
+\item{initial_state}{the state from which the simulation is resumed}
+
+\item{restore_random_state}{if TRUE, restore the random number generator's state from the checkpoint.}
+}
+\value{
+a list with two entries, one for the dataframe of results and one for the final
+simulation state.
+}
+\description{
+this function accepts an initial simulation state as an argument, and returns the
+final state after running all of its timesteps. This allows one run to be resumed, possibly
+having changed some of the parameters.
+}
diff --git a/man/run_simulation.Rd b/man/run_simulation.Rd
index 64cac9c4..54ee26ed 100644
--- a/man/run_simulation.Rd
+++ b/man/run_simulation.Rd
@@ -45,16 +45,13 @@ the whole population)
\item n: number of humans between an inclusive age range at this timestep. This
defaults to n_730_3650. Other age ranges can be set with
prevalence_rendering_min_ages and prevalence_rendering_max_ages parameters.
-\item n_detect: number of humans with an infection detectable by microscopy between an inclusive age range at this timestep. This
+\item n_detect_lm (or pcr): number of humans with an infection detectable by microscopy (or pcr) between an inclusive age range at this timestep. This
defaults to n_detect_730_3650. Other age ranges can be set with
prevalence_rendering_min_ages and prevalence_rendering_max_ages parameters.
-\item p_detect: the sum of probabilities of detection by microscopy between an
+\item p_detect_lm (or pcr): the sum of probabilities of detection by microscopy (or pcr) between an
inclusive age range at this timestep. This
defaults to p_detect_730_3650. Other age ranges can be set with
prevalence_rendering_min_ages and prevalence_rendering_max_ages parameters.
-\item n_severe: number of humans with a severe infection between an inclusive
-age range at this timestep. Age ranges can be set with
-severe_prevalence_rendering_min_ages and severe_prevalence_rendering_max_ages parameters.
\item n_inc: number of new infections for humans between an inclusive age range at this timestep.
incidence columns can be set with
incidence_rendering_min_ages and incidence_rendering_max_ages parameters.
@@ -90,5 +87,9 @@ subpatent
susceptible
\item net_usage: the number people protected by a bed net
\item mosquito_deaths: number of adult female mosquitoes who die this timestep
+\item n_drug_efficacy_failures: number of clinically treated individuals whose treatment failed due to drug efficacy
+\item n_early_treatment_failure: number of clinically treated individuals who experienced early treatment failure
+\item n_successfully_treated: number of clinically treated individuals who are treated successfully (includes individuals who experience slow parasite clearance)
+\item n_slow_parasite_clearance: number of clinically treated individuals who experienced slow parasite clearance
}
}
diff --git a/man/set_antimalarial_resistance.Rd b/man/set_antimalarial_resistance.Rd
new file mode 100644
index 00000000..56627125
--- /dev/null
+++ b/man/set_antimalarial_resistance.Rd
@@ -0,0 +1,46 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/antimalarial_resistance.R
+\name{set_antimalarial_resistance}
+\alias{set_antimalarial_resistance}
+\title{Parameterise antimalarial resistance}
+\usage{
+set_antimalarial_resistance(
+ parameters,
+ drug,
+ timesteps,
+ artemisinin_resistance_proportion,
+ partner_drug_resistance_proportion,
+ slow_parasite_clearance_probability,
+ early_treatment_failure_probability,
+ late_clinical_failure_probability,
+ late_parasitological_failure_probability,
+ reinfection_during_prophylaxis_probability,
+ slow_parasite_clearance_time
+)
+}
+\arguments{
+\item{parameters}{the model parameters}
+
+\item{drug}{the index of the drug which resistance is being set, as set by the set_drugs() function, in the parameter list}
+
+\item{timesteps}{vector of time steps for each update to resistance proportion and resistance outcome probability}
+
+\item{artemisinin_resistance_proportion}{vector of updates to the proportions of infections that are artemisinin resistant at time t}
+
+\item{partner_drug_resistance_proportion}{vector of updates to the proportions of infections that are partner-drug resistant at time t}
+
+\item{slow_parasite_clearance_probability}{vector of updates to the proportion of artemisinin-resistant infections that result in early treatment failure}
+
+\item{early_treatment_failure_probability}{vector of updates to the proportion of artemisinin-resistant infections that result in slow parasite clearance}
+
+\item{late_clinical_failure_probability}{vector of updates to the proportion of partner-drug-resistant infections that result in late clinical failure}
+
+\item{late_parasitological_failure_probability}{vector of updates to the proportion of partner-drug-resistant infections that result in late parasitological failure}
+
+\item{reinfection_during_prophylaxis_probability}{vector of updates to the proportion of partner-drug-resistant infections that result in reinfection during prophylaxis}
+
+\item{slow_parasite_clearance_time}{single value representing the mean time individual's experiencing slow parasite clearance reside in the treated state}
+}
+\description{
+Parameterise antimalarial resistance
+}
diff --git a/man/set_carrying_capacity.Rd b/man/set_carrying_capacity.Rd
index eb453800..cf585c6b 100644
--- a/man/set_carrying_capacity.Rd
+++ b/man/set_carrying_capacity.Rd
@@ -4,15 +4,16 @@
\alias{set_carrying_capacity}
\title{Parameterise custom baseline carrying capacity}
\usage{
-set_carrying_capacity(parameters, timesteps, carrying_capacity)
+set_carrying_capacity(parameters, timesteps, carrying_capacity_scalers)
}
\arguments{
\item{parameters}{the model parameters}
\item{timesteps}{vector of timesteps for each rescale change}
-\item{carrying_capacity}{matrix of baseline carrying_capacity for each species
-With nrows = length(timesteps), ncols = length(species)}
+\item{carrying_capacity_scalers}{matrix of scaling factors to scale the baseline
+carrying capacity for each species with nrows = length(timesteps),
+ncols = length(species)}
}
\description{
Allows the user to set a completely flexible and custom
diff --git a/man/set_epi_outputs.Rd b/man/set_epi_outputs.Rd
new file mode 100644
index 00000000..004ed280
--- /dev/null
+++ b/man/set_epi_outputs.Rd
@@ -0,0 +1,54 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/output_parameters.R
+\name{set_epi_outputs}
+\alias{set_epi_outputs}
+\title{Parameterise age grouped output rendering}
+\usage{
+set_epi_outputs(
+ parameters,
+ age_group = NULL,
+ incidence = NULL,
+ clinical_incidence = NULL,
+ severe_incidence = NULL,
+ prevalence = NULL,
+ ica = NULL,
+ icm = NULL,
+ iva = NULL,
+ ivm = NULL,
+ id = NULL,
+ ib = NULL
+)
+}
+\arguments{
+\item{parameters}{the model parameters}
+
+\item{age_group}{age breaks for population size outputs; default = NULL}
+
+\item{incidence}{age breaks for incidence outputs (D+Tr+A); default = NULL}
+
+\item{clinical_incidence}{age breaks for clinical incidence outputs (symptomatic); default = c(0, 1825)}
+
+\item{severe_incidence}{age breaks for severe incidence outputs; default = NULL}
+
+\item{prevalence}{age breaks for clinical prevalence outputs (pcr and lm detectable infections); default = c(730, 3650)}
+
+\item{ica}{age breaks for average acquired clinical immunity; default = NULL}
+
+\item{icm}{age breaks for average maternal clinical immunity; default = NULL}
+
+\item{iva}{age breaks for average acquired severe immunity; default = NULL}
+
+\item{ivm}{age breaks for average maternal severe immunity; default = NULL}
+
+\item{id}{age breaks for average immunity to detectability; default = NULL}
+
+\item{ib}{age breaks for average blood immunity; default = NULL}
+}
+\description{
+Parameterise age grouped output rendering
+}
+\details{
+this function produces contiguous age groups, inclusive of the lower
+age limit and exclusive of the upper age limit: e.g., c(0, 10, 100) will produce
+two age groups: 0-9 and 10-99 in days.
+}
diff --git a/man/set_mass_pev.Rd b/man/set_mass_pev.Rd
index 7c28547f..ef3263e5 100644
--- a/man/set_mass_pev.Rd
+++ b/man/set_mass_pev.Rd
@@ -12,7 +12,7 @@ set_mass_pev(
min_ages,
max_ages,
min_wait,
- booster_timestep,
+ booster_spacing,
booster_coverage,
booster_profile
)
@@ -20,7 +20,7 @@ set_mass_pev(
\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}
@@ -34,12 +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_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_mda.Rd b/man/set_mda.Rd
index 0b6f81c0..5437faeb 100644
--- a/man/set_mda.Rd
+++ b/man/set_mda.Rd
@@ -18,8 +18,7 @@ round}
\item{min_ages}{a vector of minimum ages of the target population for each round exclusive (in timesteps)}
-\item{max_ages}{a vector of maximum ages of the target population for each round exclusive (in timesteps)
-drug}
+\item{max_ages}{a vector of maximum ages of the target population for each round exclusive (in timesteps)}
}
\description{
Parameterise a Mass Drug Administration
diff --git a/man/set_pev_epi.Rd b/man/set_pev_epi.Rd
index 4dea14ed..077811c3 100644
--- a/man/set_pev_epi.Rd
+++ b/man/set_pev_epi.Rd
@@ -11,7 +11,7 @@ set_pev_epi(
timesteps,
age,
min_wait,
- booster_timestep,
+ booster_spacing,
booster_coverage,
booster_profile,
seasonal_boosters = FALSE
@@ -20,11 +20,11 @@ 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}
-\item{timesteps}{a vector of timesteps associated with coverages}
+\item{timesteps}{a vector of timesteps for each change in coverage}
\item{age}{the age when an individual will receive the first dose of the
vaccine (in timesteps)}
@@ -35,15 +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_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/man/set_pmc.Rd b/man/set_pmc.Rd
index 62625c04..2985e29a 100644
--- a/man/set_pmc.Rd
+++ b/man/set_pmc.Rd
@@ -11,10 +11,10 @@ set_pmc(parameters, drug, timesteps, coverages, ages)
\item{drug}{the index of the drug to administer}
-\item{timesteps}{a vector of timesteps for each round of PMC}
+\item{timesteps}{a vector of timesteps for each change in coverage}
-\item{coverages}{a vector of the proportion of the target population who receive each
-round}
+\item{coverages}{a vector of proportions of the target population to receive
+the intervention}
\item{ages}{a vector of ages at which PMC is administered (in timesteps)}
}
diff --git a/man/set_tbv.Rd b/man/set_tbv.Rd
index 34a641aa..23149e6d 100644
--- a/man/set_tbv.Rd
+++ b/man/set_tbv.Rd
@@ -1,5 +1,5 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/pev_parameters.R
+% Please edit documentation in R/tbv_parameters.R
\name{set_tbv}
\alias{set_tbv}
\title{Parameterise an TBV strategy}
@@ -13,8 +13,7 @@ set_tbv(parameters, timesteps, coverages, ages)
\item{coverages}{the coverage for each round of vaccinations}
-\item{ages}{for each round (in years)
-vaccine}
+\item{ages}{a vector of ages of the target population (in years)}
}
\description{
Parameterise an TBV strategy
diff --git a/src/Random.cpp b/src/Random.cpp
index 1e4896f7..a4c55a7a 100644
--- a/src/Random.cpp
+++ b/src/Random.cpp
@@ -129,3 +129,14 @@ void Random::prop_sample_bucket(
++result;
}
}
+
+std::string Random::save_state() {
+ std::ostringstream stream;
+ stream << *rng;
+ return stream.str();
+}
+
+void Random::restore_state(std::string state) {
+ std::istringstream stream(state);
+ stream >> *rng;
+}
diff --git a/src/Random.h b/src/Random.h
index b6e15039..e796fb9a 100644
--- a/src/Random.h
+++ b/src/Random.h
@@ -58,6 +58,9 @@ class Random : public RandomInterface {
Random(Random &&other) = delete;
Random& operator=(const Random &other) = delete;
Random& operator=(Random &&other) = delete;
+
+ std::string save_state();
+ void restore_state(std::string state);
private:
Random() : rng(dqrng::generator(42)) {};
};
diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
index f5c226fd..e2a6b9d6 100644
--- a/src/RcppExports.cpp
+++ b/src/RcppExports.cpp
@@ -40,6 +40,28 @@ BEGIN_RCPP
return R_NilValue;
END_RCPP
}
+// adult_mosquito_model_save_state
+std::vector adult_mosquito_model_save_state(Rcpp::XPtr model);
+RcppExport SEXP _malariasimulation_adult_mosquito_model_save_state(SEXP modelSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::XPtr >::type model(modelSEXP);
+ rcpp_result_gen = Rcpp::wrap(adult_mosquito_model_save_state(model));
+ return rcpp_result_gen;
+END_RCPP
+}
+// adult_mosquito_model_restore_state
+void adult_mosquito_model_restore_state(Rcpp::XPtr model, std::vector state);
+RcppExport SEXP _malariasimulation_adult_mosquito_model_restore_state(SEXP modelSEXP, SEXP stateSEXP) {
+BEGIN_RCPP
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::XPtr >::type model(modelSEXP);
+ Rcpp::traits::input_parameter< std::vector >::type state(stateSEXP);
+ adult_mosquito_model_restore_state(model, state);
+ return R_NilValue;
+END_RCPP
+}
// create_adult_solver
Rcpp::XPtr create_adult_solver(Rcpp::XPtr model, std::vector init, double r_tol, double a_tol, size_t max_steps);
RcppExport SEXP _malariasimulation_create_adult_solver(SEXP modelSEXP, SEXP initSEXP, SEXP r_tolSEXP, SEXP a_tolSEXP, SEXP max_stepsSEXP) {
@@ -157,6 +179,18 @@ BEGIN_RCPP
return rcpp_result_gen;
END_RCPP
}
+// exponential_process_cpp
+Rcpp::XPtr exponential_process_cpp(Rcpp::XPtr variable, const double rate);
+RcppExport SEXP _malariasimulation_exponential_process_cpp(SEXP variableSEXP, SEXP rateSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::XPtr >::type variable(variableSEXP);
+ Rcpp::traits::input_parameter< const double >::type rate(rateSEXP);
+ rcpp_result_gen = Rcpp::wrap(exponential_process_cpp(variable, rate));
+ return rcpp_result_gen;
+END_RCPP
+}
// solver_get_states
std::vector solver_get_states(Rcpp::XPtr solver);
RcppExport SEXP _malariasimulation_solver_get_states(SEXP solverSEXP) {
@@ -168,6 +202,18 @@ BEGIN_RCPP
return rcpp_result_gen;
END_RCPP
}
+// solver_set_states
+void solver_set_states(Rcpp::XPtr solver, double t, std::vector state);
+RcppExport SEXP _malariasimulation_solver_set_states(SEXP solverSEXP, SEXP tSEXP, SEXP stateSEXP) {
+BEGIN_RCPP
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::XPtr >::type solver(solverSEXP);
+ Rcpp::traits::input_parameter< double >::type t(tSEXP);
+ Rcpp::traits::input_parameter< std::vector >::type state(stateSEXP);
+ solver_set_states(solver, t, state);
+ return R_NilValue;
+END_RCPP
+}
// solver_step
void solver_step(Rcpp::XPtr solver);
RcppExport SEXP _malariasimulation_solver_step(SEXP solverSEXP) {
@@ -215,6 +261,28 @@ BEGIN_RCPP
return R_NilValue;
END_RCPP
}
+// timeseries_save_state
+Rcpp::List timeseries_save_state(Rcpp::XPtr timeseries);
+RcppExport SEXP _malariasimulation_timeseries_save_state(SEXP timeseriesSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::XPtr >::type timeseries(timeseriesSEXP);
+ rcpp_result_gen = Rcpp::wrap(timeseries_save_state(timeseries));
+ return rcpp_result_gen;
+END_RCPP
+}
+// timeseries_restore_state
+void timeseries_restore_state(Rcpp::XPtr timeseries, Rcpp::List state);
+RcppExport SEXP _malariasimulation_timeseries_restore_state(SEXP timeseriesSEXP, SEXP stateSEXP) {
+BEGIN_RCPP
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::XPtr >::type timeseries(timeseriesSEXP);
+ Rcpp::traits::input_parameter< Rcpp::List >::type state(stateSEXP);
+ timeseries_restore_state(timeseries, state);
+ return R_NilValue;
+END_RCPP
+}
// random_seed
void random_seed(size_t seed);
RcppExport SEXP _malariasimulation_random_seed(SEXP seedSEXP) {
@@ -225,6 +293,26 @@ BEGIN_RCPP
return R_NilValue;
END_RCPP
}
+// random_save_state
+std::string random_save_state();
+RcppExport SEXP _malariasimulation_random_save_state() {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ rcpp_result_gen = Rcpp::wrap(random_save_state());
+ return rcpp_result_gen;
+END_RCPP
+}
+// random_restore_state
+void random_restore_state(std::string state);
+RcppExport SEXP _malariasimulation_random_restore_state(SEXP stateSEXP) {
+BEGIN_RCPP
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< std::string >::type state(stateSEXP);
+ random_restore_state(state);
+ return R_NilValue;
+END_RCPP
+}
// bernoulli_multi_p_cpp
std::vector bernoulli_multi_p_cpp(const std::vector p);
RcppExport SEXP _malariasimulation_bernoulli_multi_p_cpp(SEXP pSEXP) {
@@ -260,11 +348,13 @@ BEGIN_RCPP
END_RCPP
}
-RcppExport SEXP run_testthat_tests();
+RcppExport SEXP run_testthat_tests(void);
static const R_CallMethodDef CallEntries[] = {
{"_malariasimulation_create_adult_mosquito_model", (DL_FUNC) &_malariasimulation_create_adult_mosquito_model, 5},
{"_malariasimulation_adult_mosquito_model_update", (DL_FUNC) &_malariasimulation_adult_mosquito_model_update, 5},
+ {"_malariasimulation_adult_mosquito_model_save_state", (DL_FUNC) &_malariasimulation_adult_mosquito_model_save_state, 1},
+ {"_malariasimulation_adult_mosquito_model_restore_state", (DL_FUNC) &_malariasimulation_adult_mosquito_model_restore_state, 2},
{"_malariasimulation_create_adult_solver", (DL_FUNC) &_malariasimulation_create_adult_solver, 5},
{"_malariasimulation_create_aquatic_mosquito_model", (DL_FUNC) &_malariasimulation_create_aquatic_mosquito_model, 18},
{"_malariasimulation_aquatic_mosquito_model_update", (DL_FUNC) &_malariasimulation_aquatic_mosquito_model_update, 4},
@@ -272,12 +362,18 @@ static const R_CallMethodDef CallEntries[] = {
{"_malariasimulation_carrying_capacity", (DL_FUNC) &_malariasimulation_carrying_capacity, 8},
{"_malariasimulation_eggs_laid", (DL_FUNC) &_malariasimulation_eggs_laid, 3},
{"_malariasimulation_rainfall", (DL_FUNC) &_malariasimulation_rainfall, 5},
+ {"_malariasimulation_exponential_process_cpp", (DL_FUNC) &_malariasimulation_exponential_process_cpp, 2},
{"_malariasimulation_solver_get_states", (DL_FUNC) &_malariasimulation_solver_get_states, 1},
+ {"_malariasimulation_solver_set_states", (DL_FUNC) &_malariasimulation_solver_set_states, 3},
{"_malariasimulation_solver_step", (DL_FUNC) &_malariasimulation_solver_step, 1},
{"_malariasimulation_create_timeseries", (DL_FUNC) &_malariasimulation_create_timeseries, 2},
{"_malariasimulation_timeseries_at", (DL_FUNC) &_malariasimulation_timeseries_at, 3},
{"_malariasimulation_timeseries_push", (DL_FUNC) &_malariasimulation_timeseries_push, 3},
+ {"_malariasimulation_timeseries_save_state", (DL_FUNC) &_malariasimulation_timeseries_save_state, 1},
+ {"_malariasimulation_timeseries_restore_state", (DL_FUNC) &_malariasimulation_timeseries_restore_state, 2},
{"_malariasimulation_random_seed", (DL_FUNC) &_malariasimulation_random_seed, 1},
+ {"_malariasimulation_random_save_state", (DL_FUNC) &_malariasimulation_random_save_state, 0},
+ {"_malariasimulation_random_restore_state", (DL_FUNC) &_malariasimulation_random_restore_state, 1},
{"_malariasimulation_bernoulli_multi_p_cpp", (DL_FUNC) &_malariasimulation_bernoulli_multi_p_cpp, 1},
{"_malariasimulation_bitset_index_cpp", (DL_FUNC) &_malariasimulation_bitset_index_cpp, 2},
{"_malariasimulation_fast_weighted_sample", (DL_FUNC) &_malariasimulation_fast_weighted_sample, 2},
diff --git a/src/adult_mosquito_eqs.cpp b/src/adult_mosquito_eqs.cpp
index ad5553eb..8126c7d7 100644
--- a/src/adult_mosquito_eqs.cpp
+++ b/src/adult_mosquito_eqs.cpp
@@ -17,7 +17,7 @@ AdultMosquitoModel::AdultMosquitoModel(
) : growth_model(growth_model), mu(mu), tau(tau), foim(foim)
{
for (auto i = 0u; i < tau; ++i) {
- lagged_incubating.push(incubating);
+ lagged_incubating.push_back(incubating);
}
}
@@ -82,12 +82,30 @@ void adult_mosquito_model_update(
model->foim = foim;
model->growth_model.f = f;
model->growth_model.mum = mu;
- model->lagged_incubating.push(susceptible * foim);
+ model->lagged_incubating.push_back(susceptible * foim);
if (model->lagged_incubating.size() > 0) {
- model->lagged_incubating.pop();
+ model->lagged_incubating.pop_front();
}
}
+//[[Rcpp::export]]
+std::vector adult_mosquito_model_save_state(
+ Rcpp::XPtr model
+ ) {
+ // Only the lagged_incubating needs to be saved. The rest of the model
+ // state is reset at each time step by a call to update before it gets
+ // used.
+ return {model->lagged_incubating.begin(), model->lagged_incubating.end()};
+}
+
+//[[Rcpp::export]]
+void adult_mosquito_model_restore_state(
+ Rcpp::XPtr model,
+ std::vector state
+ ) {
+ model->lagged_incubating.assign(state.begin(), state.end());
+}
+
//[[Rcpp::export]]
Rcpp::XPtr create_adult_solver(
Rcpp::XPtr model,
diff --git a/src/adult_mosquito_eqs.h b/src/adult_mosquito_eqs.h
index 6fc30501..c3e0ac8b 100644
--- a/src/adult_mosquito_eqs.h
+++ b/src/adult_mosquito_eqs.h
@@ -28,7 +28,7 @@ enum class AdultState : size_t {S = 3, E = 4, I = 5};
*/
struct AdultMosquitoModel {
AquaticMosquitoModel growth_model;
- std::queue lagged_incubating; //last tau values for incubating mosquitos
+ std::deque lagged_incubating; //last tau values for incubating mosquitos
double mu; //death rate for adult female mosquitoes
const double tau; //extrinsic incubation period
double foim; //force of infection towards mosquitoes
diff --git a/src/processes.cpp b/src/processes.cpp
new file mode 100644
index 00000000..b5db4bad
--- /dev/null
+++ b/src/processes.cpp
@@ -0,0 +1,117 @@
+#include
+#include
+
+/**
+ * An iterator adaptor which yields the same values as the underlying iterator,
+ * but scaled by a pre-determined factor.
+ *
+ * This is used by the exponential_process below to scale an std::vector by a
+ * constant.
+ *
+ * There are two straightforward ways of performing the operation. The first is
+ * to create an empty vector, use `reserve(N)` to pre-allocate the vector and
+ * then call `push_back` with each new value. The second way would be to create
+ * a zero-initialised vector of size N and then use `operator[]` to fill in the
+ * values.
+ *
+ * Unfortunately both approaches have significant overhead. In the former, the
+ * use of `push_back` requires repeated checks as to whether the vector needs
+ * growing, despite the prior reserve call. These calls inhibits optimizations
+ * such as unrolling and auto-vectorization of the loop. The latter approach
+ * requires an initial memset when zero-initializing the vector, even though the
+ * vector then gets overwritten entirely. Sadly gcc fails to optimize out either
+ * of those. Ideally we want a way to create a pre-sized but uninitialised
+ * std::vector we can write to ourselves, but there is no API in the standard
+ * library to do this. All existing workarounds end up with an std::vector with
+ * non-default item type or allocators.
+ *
+ * There is however a way out! std::vector has a constructor which accepts a
+ * pair of iterators and fills the vector with values from the iterators. Using
+ * `std::distance` on the iterator pair it can even pre-allocate the vector to
+ * the right size. No zero-initialisation or no capacity checks, just one
+ * allocation and a straightforward easily optimizable loop. All we need is an
+ * iterator yielding the right values, hence `scale_iterator`. In C++20 we would
+ * probably be able to use the new ranges library as our iterators.
+ *
+ * How much does this matter? On microbenchmarks, for small and medium sized
+ * vector (<= 1M doubles), this version is about 30% faster than the
+ * zero-initialising implementation and 60% faster than the one which uses
+ * push_back. For larger vector sizes the difference is less pronounced,
+ * possibly because caches become saturated. At the time of writing, on a
+ * real-word run of malariasimulation with a population size of 1M the overall
+ * speedup is about 2-3%.
+ *
+ * https://wolchok.org/posts/cxx-trap-1-constant-size-vector/
+ * https://codingnest.com/the-little-things-the-missing-performance-in-std-vector/
+ * https://lemire.me/blog/2012/06/20/do-not-waste-time-with-stl-vectors/
+ */
+template
+struct scale_iterator {
+ using iterator_category = std::forward_iterator_tag;
+ using difference_type = typename std::iterator_traits::difference_type;
+ using value_type = typename std::iterator_traits::value_type;
+ using pointer = typename std::iterator_traits::pointer;
+
+ // We skirt the rules a bit by returning a prvalue from `operator*`, even
+ // though the C++17 (and prior) standard says forward iterators are supposed
+ // to return a reference type (ie. a glvalue). Because the scaling is
+ // applied on the fly, there is no glvalue we could return a reference to.
+ //
+ // An input iterator would be allowed to return a prvalue, but the
+ // std::vector constructor wouldn't be able to figure out the length ahead
+ // of time if we were an input iterator.
+ //
+ // C++20 actually introduces parallel definitions of input and forward
+ // iterators, which relax this requirement, so under that classification our
+ // implementation in correct.
+ //
+ // In practice though, this does not really matter. We only use this
+ // iterator in one specific context, and the vector constructor doesn't do
+ // anything elaborate that we would be upsetting.
+ using reference = value_type;
+
+ scale_iterator(underlying_iterator it, value_type factor) : it(it), factor(factor) {}
+ reference operator*() {
+ return factor * (*it);
+ }
+ bool operator==(const scale_iterator& other) {
+ return it == other.it;
+ }
+ bool operator!=(const scale_iterator& other) {
+ return it != other.it;
+ }
+ scale_iterator& operator++() {
+ it++;
+ return *this;
+ }
+ scale_iterator operator++(int) {
+ return scale_iterator(it++, factor);
+ }
+
+ private:
+ underlying_iterator it;
+ value_type factor;
+};
+
+template
+scale_iterator make_scale_iterator(T&& it, typename std::iterator_traits::value_type scale) {
+ return scale_iterator(std::forward(it), scale);
+}
+
+//[[Rcpp::export]]
+Rcpp::XPtr exponential_process_cpp(
+ Rcpp::XPtr variable,
+ const double rate
+){
+ return Rcpp::XPtr(
+ new process_t([=](size_t t){
+ const std::vector& values = variable->get_values();
+ std::vector new_values(
+ make_scale_iterator(values.cbegin(), rate),
+ make_scale_iterator(values.cend(), rate));
+
+ variable->queue_update(std::move(new_values), std::vector());
+ }),
+ true
+ );
+}
diff --git a/src/solver.cpp b/src/solver.cpp
index 7cb8b9f4..4c3f182f 100644
--- a/src/solver.cpp
+++ b/src/solver.cpp
@@ -47,6 +47,12 @@ std::vector solver_get_states(Rcpp::XPtr solver) {
return solver->state;
}
+//[[Rcpp::export]]
+void solver_set_states(Rcpp::XPtr solver, double t, std::vector state) {
+ solver->t = t;
+ solver->state = state;
+}
+
//[[Rcpp::export]]
void solver_step(Rcpp::XPtr solver) {
solver->step();
diff --git a/src/timeseries.cpp b/src/timeseries.cpp
index 2383ac73..51a494de 100644
--- a/src/timeseries.cpp
+++ b/src/timeseries.cpp
@@ -15,18 +15,18 @@ Timeseries::Timeseries(size_t max_size, double default_value)
: max_size(max_size), has_default(true), default_value(default_value) {}
void Timeseries::push(double value, double time) {
- values.insert({time, value});
+ _values.insert({time, value});
if (max_size != -1) {
- while(values.size() > max_size) {
- values.erase(values.begin());
+ while(_values.size() > max_size) {
+ _values.erase(_values.begin());
}
}
}
double Timeseries::at(double time, bool linear) const {
- auto it = values.lower_bound(time);
- if (it == values.end()) {
- if (values.size() > 0 && !linear) {
+ auto it = _values.lower_bound(time);
+ if (it == _values.end()) {
+ if (_values.size() > 0 && !linear) {
it--;
return it->second;
}
@@ -45,7 +45,7 @@ double Timeseries::at(double time, bool linear) const {
auto after_element = *it;
while(it->first > time) {
// Check if we're at the start of the timeseries
- if (it == values.begin()) {
+ if (it == _values.begin()) {
if (has_default) {
return default_value;
}
@@ -64,6 +64,14 @@ double Timeseries::at(double time, bool linear) const {
return it->second;
}
+const std::map& Timeseries::values() {
+ return _values;
+}
+
+void Timeseries::set_values(std::map values) {
+ _values = std::move(values);
+}
+
//[[Rcpp::export]]
Rcpp::XPtr create_timeseries(size_t size, double default_value) {
return Rcpp::XPtr(new Timeseries(size, default_value), true);
@@ -78,3 +86,32 @@ double timeseries_at(Rcpp::XPtr timeseries, double timestep, bool li
void timeseries_push(Rcpp::XPtr timeseries, double value, double timestep) {
return timeseries->push(value, timestep);
}
+
+//[[Rcpp::export]]
+Rcpp::List timeseries_save_state(Rcpp::XPtr timeseries) {
+ std::vector timesteps;
+ std::vector values;
+ for (const auto& entry: timeseries->values()) {
+ timesteps.push_back(entry.first);
+ values.push_back(entry.second);
+ }
+ return Rcpp::DataFrame::create(
+ Rcpp::Named("timestep") = timesteps,
+ Rcpp::Named("value") = values
+ );
+}
+
+//[[Rcpp::export]]
+void timeseries_restore_state(Rcpp::XPtr timeseries, Rcpp::List state) {
+ std::vector timesteps = state["timestep"];
+ std::vector values = state["value"];
+ if (timesteps.size() != values.size()) {
+ Rcpp::stop("Bad size");
+ }
+
+ std::map values_map;
+ for (size_t i = 0; i < timesteps.size(); i++) {
+ values_map.insert({timesteps[i], values[i]});
+ }
+ timeseries->set_values(std::move(values_map));
+}
diff --git a/src/timeseries.h b/src/timeseries.h
index c9e7c32f..78f3780b 100644
--- a/src/timeseries.h
+++ b/src/timeseries.h
@@ -12,7 +12,7 @@
class Timeseries {
private:
- std::map values;
+ std::map _values;
size_t max_size;
void clean();
bool has_default;
@@ -23,6 +23,9 @@ class Timeseries {
Timeseries(size_t, double);
void push(double, double);
double at(double, bool = true) const;
+
+ const std::map& values();
+ void set_values(std::map state);
};
#endif /* SRC_TIMESERIES_ */
diff --git a/src/utils.cpp b/src/utils.cpp
index 838a9530..bc5162b4 100644
--- a/src/utils.cpp
+++ b/src/utils.cpp
@@ -8,6 +8,16 @@ void random_seed(size_t seed) {
Random::get_instance().seed(seed);
}
+//[[Rcpp::export]]
+std::string random_save_state() {
+ return Random::get_instance().save_state();
+}
+
+//[[Rcpp::export]]
+void random_restore_state(std::string state) {
+ return Random::get_instance().restore_state(state);
+}
+
//[[Rcpp::export]]
std::vector bernoulli_multi_p_cpp(const std::vector p) {
auto values = Random::get_instance().bernoulli_multi_p(p);
@@ -22,6 +32,11 @@ std::vector bitset_index_cpp(
Rcpp::XPtr a,
Rcpp::XPtr b
) {
+ if (a->max_size() != b->max_size()) {
+ Rcpp::stop("Incompatible bitmap sizes, %d vs %d",
+ a->max_size(), b->max_size());
+ }
+
auto values = std::vector();
auto i = 1u;
for (const auto& v : *a) {
diff --git a/tests/testthat/helper-integration.R b/tests/testthat/helper-integration.R
index b69b7dcb..22c7dd63 100644
--- a/tests/testthat/helper-integration.R
+++ b/tests/testthat/helper-integration.R
@@ -88,6 +88,13 @@ mock_event <- function(event) {
)
}
+mock_solver <- function(states) {
+ list(
+ get_states = mockery::mock(states),
+ step = mockery::mock()
+ )
+}
+
expect_bitset_update <- function(mock, value, index, call = 1) {
expect_equal(mockery::mock_args(mock)[[call]][[1]], value)
expect_equal(mockery::mock_args(mock)[[call]][[2]]$to_vector(), index)
diff --git a/tests/testthat/test-antimalarial-resistance.R b/tests/testthat/test-antimalarial-resistance.R
new file mode 100644
index 00000000..ae45a20e
--- /dev/null
+++ b/tests/testthat/test-antimalarial-resistance.R
@@ -0,0 +1,323 @@
+test_that('set_antimalarial_resistance() toggles resistance on', {
+ parameters <- get_parameters()
+ parameters <- set_drugs(parameters = parameters, drugs = list(SP_AQ_params))
+ parameters <- set_clinical_treatment(parameters = parameters,
+ drug = 1,
+ timesteps = 1,
+ coverages = 1)
+ set_antimalarial_resistance(parameters = parameters,
+ drug = 1,
+ timesteps = 1,
+ artemisinin_resistance_proportion = 0.5,
+ partner_drug_resistance_proportion = 0,
+ slow_parasite_clearance_probability = 0.5,
+ early_treatment_failure_probability = 0.6,
+ late_clinical_failure_probability = 0,
+ late_parasitological_failure_probability = 0,
+ reinfection_during_prophylaxis_probability = 0,
+ slow_parasite_clearance_time = 10) -> parameters
+ expect_identical(object = parameters$antimalarial_resistance, expected = TRUE)
+})
+
+test_that('set_antimalarial_resistance() errors if parameter inputs of different length to timesteps', {
+ parameters <- get_parameters()
+ parameters <- set_drugs(parameters = parameters, drugs = list(SP_AQ_params))
+ parameters <- set_clinical_treatment(parameters = parameters,
+ drug = 1,
+ timesteps = 1,
+ coverages = 1)
+ expect_error(object = set_antimalarial_resistance(parameters = parameters,
+ drug = 1,
+ timesteps = c(1, 10),
+ artemisinin_resistance_proportion = 0.5,
+ partner_drug_resistance_proportion = 0,
+ slow_parasite_clearance_probability = 0.5,
+ early_treatment_failure_probability = 0.6,
+ late_clinical_failure_probability = 0,
+ late_parasitological_failure_probability = 0,
+ reinfection_during_prophylaxis_probability = 0,
+ slow_parasite_clearance_time = 10))
+})
+
+test_that('set_antimalarial_resistance() errors if resistance proportions outside of range 0-1', {
+ parameters <- get_parameters()
+ parameters <- set_drugs(parameters = parameters, drugs = list(SP_AQ_params))
+ parameters <- set_clinical_treatment(parameters = parameters,
+ drug = 1,
+ timesteps = 1,
+ coverages = 1)
+ expect_error(object = set_antimalarial_resistance(parameters = parameters,
+ drug = 1,
+ timesteps = 1,
+ artemisinin_resistance_proportion = 1.01,
+ partner_drug_resistance_proportion = 0,
+ slow_parasite_clearance_probability = 0.5,
+ early_treatment_failure_probability = 0.6,
+ late_clinical_failure_probability = 0,
+ late_parasitological_failure_probability = 0,
+ reinfection_during_prophylaxis_probability = 0,
+ slow_parasite_clearance_time = 10),
+ regexp = "Artemisinin and partner-drug resistance proportions must fall between 0 and 1")
+})
+
+test_that('set_antimalarial_resistance() errors if resistance phenotype probabilities outside bound of 0-1', {
+ parameters <- get_parameters()
+ parameters <- set_drugs(parameters = parameters, drugs = list(SP_AQ_params))
+ parameters <- set_clinical_treatment(parameters = parameters,
+ drug = 1,
+ timesteps = 1,
+ coverages = 1)
+ expect_error(object = set_antimalarial_resistance(parameters = parameters,
+ drug = 1,
+ timesteps = 1,
+ artemisinin_resistance_proportion = 0.4,
+ partner_drug_resistance_proportion = 0,
+ slow_parasite_clearance_probability = -0.5,
+ early_treatment_failure_probability = 0.6,
+ late_clinical_failure_probability = 0.2,
+ late_parasitological_failure_probability = 0.3,
+ reinfection_during_prophylaxis_probability = 0.4,
+ slow_parasite_clearance_time = 5))
+})
+
+test_that('set_antimalarial_resistance() errors if drug index > than number of drugs assigned using set_drugs()', {
+ parameters <- get_parameters()
+ parameters <- set_drugs(parameters = parameters, drugs = list(SP_AQ_params))
+ parameters <- set_clinical_treatment(parameters = parameters,
+ drug = 1,
+ timesteps = 1,
+ coverages = 1)
+ expect_error(object = set_antimalarial_resistance(parameters = parameters,
+ drug = 2,
+ timesteps = 1,
+ artemisinin_resistance_proportion = 0.4,
+ partner_drug_resistance_proportion = 0.3,
+ slow_parasite_clearance_probability = 0.5,
+ early_treatment_failure_probability = 0.6,
+ late_clinical_failure_probability = 0,
+ late_parasitological_failure_probability = 0,
+ reinfection_during_prophylaxis_probability = 0.4,
+ slow_parasite_clearance_time = 10))
+})
+
+test_that('set_antimalarial_resistance() assigns parameters correctly despite order in which resistance parameters are specified', {
+
+ parameters <- get_parameters()
+ parameters <- set_drugs(parameters = parameters, drugs = list(AL_params, SP_AQ_params, DHA_PQP_params))
+ parameters <- set_clinical_treatment(parameters = parameters, drug = 2, timesteps = 1, coverages = 0.2)
+ parameters <- set_clinical_treatment(parameters = parameters, drug = 1, timesteps = 1, coverages = 0.1)
+ parameters <- set_clinical_treatment(parameters = parameters, drug = 3, timesteps = 1, coverages = 0.4)
+ parameters <- set_antimalarial_resistance(parameters = parameters,
+ drug = 2,
+ timesteps = 1,
+ artemisinin_resistance_proportion = 0.5,
+ partner_drug_resistance_proportion = 0,
+ slow_parasite_clearance_probability = 0.41,
+ early_treatment_failure_probability = 0.2,
+ late_clinical_failure_probability = 0,
+ late_parasitological_failure_probability = 0,
+ reinfection_during_prophylaxis_probability = 0,
+ slow_parasite_clearance_time = 5)
+ parameters <- set_antimalarial_resistance(parameters = parameters,
+ drug = 3,
+ timesteps = 1,
+ artemisinin_resistance_proportion = 0,
+ partner_drug_resistance_proportion = 0,
+ slow_parasite_clearance_probability = 0,
+ early_treatment_failure_probability = 0,
+ late_clinical_failure_probability = 0,
+ late_parasitological_failure_probability = 0,
+ reinfection_during_prophylaxis_probability = 0,
+ slow_parasite_clearance_time = 10)
+ parameters <- set_antimalarial_resistance(parameters = parameters,
+ drug = 1,
+ timesteps = 1,
+ artemisinin_resistance_proportion = 0.27,
+ partner_drug_resistance_proportion = 0,
+ slow_parasite_clearance_probability = 0.23,
+ early_treatment_failure_probability = 0.9,
+ late_clinical_failure_probability = 0,
+ late_parasitological_failure_probability = 0,
+ reinfection_during_prophylaxis_probability = 0,
+ slow_parasite_clearance_time = 20)
+
+ expect_identical(parameters$antimalarial_resistance, TRUE)
+ expect_identical(unlist(parameters$antimalarial_resistance_drug), c(2, 3, 1))
+ expect_identical(unlist(parameters$antimalarial_resistance_timesteps), rep(1, 3))
+ expect_identical(unlist(parameters$artemisinin_resistance_proportion), c(0.5, 0, 0.27))
+ expect_identical(unlist(parameters$partner_drug_resistance_proportion), c(0, 0, 0))
+ expect_identical(unlist(parameters$slow_parasite_clearance_probability), c(0.41, 0, 0.23))
+ expect_identical(unlist(parameters$early_treatment_failure_probability), c(0.2, 0, 0.9))
+ expect_identical(unlist(parameters$late_clinical_failure_probability), c(0, 0, 0))
+ expect_identical(unlist(parameters$late_parasitological_failure_probability), c(0, 0, 0))
+ expect_identical(unlist(parameters$reinfection_during_prophylaxis_probability), c(0, 0, 0))
+ expect_identical(unlist(parameters$dt_slow_parasite_clearance), c(5, 10, 20))
+
+})
+
+test_that("set_antimalarial_resistance errors if length slow_parasite_clearance_time > 1", {
+
+ parameters <- get_parameters()
+ parameters <- set_drugs(parameters = parameters, drugs = list(SP_AQ_params))
+ parameters <- set_clinical_treatment(parameters = parameters,
+ drug = 1,
+ timesteps = c(0, 10),
+ coverages = c(0.1, 0.2))
+
+ expect_error(
+ parameters <- set_antimalarial_resistance(parameters = parameters,
+ drug = 1,
+ timesteps = c(0, 10),
+ artemisinin_resistance_proportion = c(0.4, 0.8),
+ partner_drug_resistance_proportion = c(0, 0),
+ slow_parasite_clearance_probability = c(0.2, 0.4),
+ early_treatment_failure_probability = c(0, 0.45),
+ late_clinical_failure_probability = c(0, 0),
+ late_parasitological_failure_probability = c(0, 0),
+ reinfection_during_prophylaxis_probability = c(0, 0),
+ slow_parasite_clearance_time = c(10 ,11)),
+ "Error: length of slow_parasite_clearance_time not equal to 1")
+})
+
+test_that("set_antimalarial_resistance errors if slow_parasite_clearance_time not positive", {
+
+ parameters <- get_parameters()
+ parameters <- set_drugs(parameters = parameters, drugs = list(SP_AQ_params))
+ parameters <- set_clinical_treatment(parameters = parameters,
+ drug = 1,
+ timesteps = c(0, 10),
+ coverages = c(0.1, 0.2))
+
+ expect_error(
+ parameters <- set_antimalarial_resistance(parameters = parameters,
+ drug = 1,
+ timesteps = c(0, 10),
+ artemisinin_resistance_proportion = c(0.4, 0.8),
+ partner_drug_resistance_proportion = c(0, 0),
+ slow_parasite_clearance_probability = c(0.2, 0.4),
+ early_treatment_failure_probability = c(0, 0.45),
+ late_clinical_failure_probability = c(0, 0),
+ late_parasitological_failure_probability = c(0, 0),
+ reinfection_during_prophylaxis_probability = c(0, 0),
+ slow_parasite_clearance_time = c(0)),
+ "Error: slow_parasite_clearance_time is non-positive")
+})
+
+test_that('get_antimalarial_resistance_parameters() correctly retrieves parameters when multiple drugs assigned', {
+
+ get_parameters(overrides = list(human_population = 10000)) |>
+ set_drugs(drugs = list(AL_params, SP_AQ_params, DHA_PQP_params)) |>
+ set_clinical_treatment(drug = 1, timesteps = 1, coverages = 0.4) |>
+ set_clinical_treatment(drug = 2, timesteps = 1, coverages = 0.3) |>
+ set_clinical_treatment(drug = 3, timesteps = 1, coverages = 0.2) |>
+ set_equilibrium(init_EIR = 20) |>
+ set_antimalarial_resistance(drug = 2,
+ timesteps = c(0, 20),
+ artemisinin_resistance_proportion = c(0.02, 0.2),
+ partner_drug_resistance_proportion = c(0, 0),
+ slow_parasite_clearance_probability = c(0.02, 0.2),
+ early_treatment_failure_probability = c(0.02, 0.2),
+ late_clinical_failure_probability = c(0, 0),
+ late_parasitological_failure_probability = c(0, 0),
+ reinfection_during_prophylaxis_probability = c(0, 0),
+ slow_parasite_clearance_time = 20) |>
+ set_antimalarial_resistance(drug = 1,
+ timesteps = c(0, 10),
+ artemisinin_resistance_proportion = c(0.01, 0.1),
+ partner_drug_resistance_proportion = c(0, 0),
+ slow_parasite_clearance_probability = c(0.01, 0.1),
+ early_treatment_failure_probability = c(0.01, 0.1),
+ late_clinical_failure_probability = c(0, 0),
+ late_parasitological_failure_probability = c(0, 0),
+ reinfection_during_prophylaxis_probability = c(0, 0),
+ slow_parasite_clearance_time = 10) |>
+ set_antimalarial_resistance(drug = 3,
+ timesteps = c(0, 30),
+ artemisinin_resistance_proportion = c(0.03, 0.3),
+ partner_drug_resistance_proportion = c(0, 0),
+ slow_parasite_clearance_probability = c(0.03, 0.3),
+ early_treatment_failure_probability = c(0.03, 0.3),
+ late_clinical_failure_probability = c(0, 0),
+ late_parasitological_failure_probability = c(0, 0),
+ reinfection_during_prophylaxis_probability = c(0, 0),
+ slow_parasite_clearance_time = 30) -> parameters
+
+ drugs <- c(1, 3, 2, 1, 2, 3, 3, 3, 2, 1, 3, 1, 2, 3, 2)
+ timestep <- 25
+
+ resistance_parameters <- get_antimalarial_resistance_parameters(parameters = parameters,
+ drugs = drugs,
+ timestep = timestep)
+
+ expected_resistance_parameters <- list()
+ expected_resistance_parameters$artemisinin_resistance_proportion <- c(0.1, 0.03, 0.2, 0.1, 0.2, 0.03, 0.03, 0.03, 0.2, 0.1, 0.03, 0.1, 0.2, 0.03, 0.2)
+ expected_resistance_parameters$partner_drug_resistance_proportion <- rep(0, 15)
+ expected_resistance_parameters$slow_parasite_clearance_probability <- c(0.1, 0.03, 0.2, 0.1, 0.2, 0.03, 0.03, 0.03, 0.2, 0.1, 0.03, 0.1, 0.2, 0.03, 0.2)
+ expected_resistance_parameters$early_treatment_failure_probability <- c(0.1, 0.03, 0.2, 0.1, 0.2, 0.03, 0.03, 0.03, 0.2, 0.1, 0.03, 0.1, 0.2, 0.03, 0.2)
+ expected_resistance_parameters$late_clinical_failure_probability <- rep(0, 15)
+ expected_resistance_parameters$late_parasitological_failure_probability <- rep(0, 15)
+ expected_resistance_parameters$reinfection_during_prophylaxis_probability <- rep(0, 15)
+ expected_resistance_parameters$dt_slow_parasite_clearance <- c(10, 30, 20, 10, 20, 30, 30, 30, 20, 10, 30, 10, 20, 30, 20)
+
+ expect_identical(resistance_parameters, expected = expected_resistance_parameters)
+
+})
+
+test_that('get_antimalarial_resistance_parameters() correctly retrieves parameters when not all drugs assigned resistance', {
+
+ get_parameters(overrides = list(human_population = 10000)) %>%
+ set_drugs(drugs = list(AL_params, SP_AQ_params, DHA_PQP_params)) %>%
+ set_clinical_treatment(drug = 1, timesteps = 1, coverages = 0.4) %>%
+ set_clinical_treatment(drug = 2, timesteps = 1, coverages = 0.3) %>%
+ set_clinical_treatment(drug = 3, timesteps = 1, coverages = 0.2) %>%
+ set_equilibrium(init_EIR = 20) %>%
+ set_antimalarial_resistance(drug = 2,
+ timesteps = c(0, 20),
+ artemisinin_resistance_proportion = c(0.02, 0.2),
+ partner_drug_resistance_proportion = c(0, 0),
+ slow_parasite_clearance_probability = c(0.02, 0.2),
+ early_treatment_failure_probability = c(0.02, 0.2),
+ late_clinical_failure_probability = c(0, 0),
+ late_parasitological_failure_probability = c(0, 0),
+ reinfection_during_prophylaxis_probability = c(0, 0),
+ slow_parasite_clearance_time = 20) -> parameters
+
+ drugs <- c(1, 3, 2, 1, 2, 3, 3, 3, 2, 1, 3, 1, 2, 3, 2)
+ timestep <- 25
+
+ resistance_parameters <- get_antimalarial_resistance_parameters(parameters = parameters,
+ drugs = drugs,
+ timestep = timestep)
+
+ expected_resistance_parameters <- list()
+ expected_resistance_parameters$artemisinin_resistance_proportion <- c(0, 0, 0.2, 0, 0.2, 0, 0, 0, 0.2, 0, 0, 0, 0.2, 0, 0.2)
+ expected_resistance_parameters$partner_drug_resistance_proportion <- rep(0, 15)
+ expected_resistance_parameters$slow_parasite_clearance_probability <- c(0, 0, 0.2, 0, 0.2, 0, 0, 0, 0.2, 0, 0, 0, 0.2, 0, 0.2)
+ expected_resistance_parameters$early_treatment_failure_probability <- c(0, 0, 0.2, 0, 0.2, 0, 0, 0, 0.2, 0, 0, 0, 0.2, 0, 0.2)
+ expected_resistance_parameters$late_clinical_failure_probability <- rep(0, 15)
+ expected_resistance_parameters$late_parasitological_failure_probability <- rep(0, 15)
+ expected_resistance_parameters$reinfection_during_prophylaxis_probability <- rep(0, 15)
+ expected_resistance_parameters$dt_slow_parasite_clearance <- c(5, 5, 20, 5, 20, 5, 5, 5, 20, 5, 5, 5, 20, 5, 20)
+
+ expect_identical(resistance_parameters, expected = expected_resistance_parameters)
+
+})
+
+test_that('get_antimalarial_resistance_parameters() returns an error when antimalarial resistance has not been parameterised', {
+
+ get_parameters(overrides = list(human_population = 10000)) %>%
+ set_drugs(drugs = list(AL_params, SP_AQ_params, DHA_PQP_params)) %>%
+ set_clinical_treatment(drug = 1, timesteps = 1, coverages = 0.4) %>%
+ set_clinical_treatment(drug = 2, timesteps = 1, coverages = 0.3) %>%
+ set_clinical_treatment(drug = 3, timesteps = 1, coverages = 0.2) %>%
+ set_equilibrium(init_EIR = 20) -> parameters
+
+ drugs <- c(1, 3, 2, 1, 2, 3, 3, 3, 2, 1, 3, 1, 2, 3, 2)
+ timestep <- 25
+
+
+ expect_error(get_antimalarial_resistance_parameters(parameters = parameters,
+ drugs = drugs,
+ timestep = timestep),
+ "Error: Antimalarial resistance has not been parameterised; antimalarial_resistance = FALSE")
+})
diff --git a/tests/testthat/test-biology.R b/tests/testthat/test-biology.R
index 5895d45b..78c98d58 100644
--- a/tests/testthat/test-biology.R
+++ b/tests/testthat/test-biology.R
@@ -16,10 +16,7 @@ test_that('total_M and EIR functions are consistent with equilibrium EIR', {
vector_models <- parameterise_mosquito_models(parameters, 1)
solvers <- parameterise_solvers(vector_models, parameters)
estimated_eir <- calculate_eir(1, solvers, variables, parameters, 0)
- age <- get_age(variables$birth$get_values(), 0)
- psi <- unique_biting_rate(age, parameters)
- omega <- mean(psi)
- mean(estimated_eir) / omega / population * 365
+ mean(estimated_eir) / population * 365
})
expect_equal(
@@ -44,10 +41,7 @@ test_that('total_M and EIR functions are consistent with equilibrium EIR (with h
vector_models <- parameterise_mosquito_models(parameters, 1)
solvers <- parameterise_solvers(vector_models, parameters)
estimated_eir <- calculate_eir(1, solvers, variables, parameters, 0)
- age <- get_age(variables$birth$get_values(), 0)
- psi <- unique_biting_rate(age, parameters)
- omega <- mean(psi)
- mean(estimated_eir) / omega / population * 365
+ mean(estimated_eir) / population * 365
})
expect_equal(
@@ -98,7 +92,7 @@ test_that('FOIM is consistent with equilibrium', {
expect_equal(
expected_foim,
actual_foim,
- tolerance = 1e-4
+ tolerance = 1e-3
)
})
diff --git a/tests/testthat/test-biting-integration.R b/tests/testthat/test-biting-integration.R
index 66bf5b72..fbfd1fd4 100644
--- a/tests/testthat/test-biting-integration.R
+++ b/tests/testthat/test-biting-integration.R
@@ -14,6 +14,13 @@ test_that('biting_process integrates mosquito effects and human infection', {
models <- parameterise_mosquito_models(parameters, timestep)
solvers <- parameterise_solvers(models, parameters)
+ infection_outcome <- CompetingOutcome$new(
+ targeted_process = function(timestep, target){
+ infection_process_resolved_hazard(timestep, target, variables, renderer, parameters)
+ },
+ size = parameters$human_population
+ )
+
biting_process <- create_biting_process(
renderer,
solvers,
@@ -22,9 +29,10 @@ test_that('biting_process integrates mosquito effects and human infection', {
events,
parameters,
lagged_foim,
- lagged_eir
+ lagged_eir,
+ infection_outcome=infection_outcome
)
-
+
bitten <- individual::Bitset$new(parameters$human_population)
bites_mock <- mockery::mock(bitten)
infection_mock <- mockery::mock()
@@ -32,7 +40,7 @@ test_that('biting_process integrates mosquito effects and human infection', {
mockery::stub(biting_process, 'simulate_bites', bites_mock)
mockery::stub(biting_process, 'simulate_infection', infection_mock)
biting_process(timestep)
-
+
mockery::expect_args(
bites_mock,
1,
@@ -46,7 +54,7 @@ test_that('biting_process integrates mosquito effects and human infection', {
timestep,
lagged_foim,
lagged_eir,
- 1,
+ NULL,
1
)
@@ -59,7 +67,8 @@ test_that('biting_process integrates mosquito effects and human infection', {
age,
parameters,
timestep,
- renderer
+ renderer,
+ infection_outcome
)
})
@@ -101,8 +110,8 @@ test_that('simulate_bites integrates eir calculation and mosquito side effects',
mockery::stub(simulate_bites, 'aquatic_mosquito_model_update', eqs_update)
models <- parameterise_mosquito_models(parameters, timestep)
solvers <- parameterise_solvers(models, parameters)
- lagged_foim <- list(LaggedValue$new(12.5, .001))
- lagged_eir <- list(list(LaggedValue$new(12, 10)))
+ lagged_foim <- LaggedValue$new(12.5, .001)
+ lagged_eir <- list(LaggedValue$new(12, 10))
bitten <- simulate_bites(
renderer,
solvers,
@@ -131,7 +140,7 @@ test_that('simulate_bites integrates eir calculation and mosquito side effects',
expect_equal(effects_args[[1]][[8]], parameters)
expect_equal(effects_args[[1]][[9]], timestep)
- mockery::expect_args(eqs_update, 1, models[[1]], 25, f, parameters$mum)
+ mockery::expect_args(eqs_update, 1, models[[1]]$.model, 25, f, parameters$mum)
mockery::expect_args(
pois_mock,
1,
@@ -145,42 +154,3 @@ test_that('simulate_bites integrates eir calculation and mosquito side effects',
c(.5, .5, .5, .5)
)
})
-
-
-test_that('simulate_bites works with mixed populations', {
- population <- 4
- timestep <- 5
- renderer <- individual::Render$new(5)
- parameters <- get_parameters(
- list(human_population = population)
- )
- events <- create_events(parameters)
- variables <- create_variables(parameters)
-
- mock_foim <- mockery::mock(1)
- mock_a <- mockery::mock(.3)
-
- mockery::stub(simulate_bites, 'calculate_foim', mock_foim)
- mockery::stub(simulate_bites, '.human_blood_meal_rate', mock_a)
- models <- parameterise_mosquito_models(parameters, timestep)
- solvers <- parameterise_solvers(models, parameters)
- lagged_foim <- list(LaggedValue$new(12.5, .001), LaggedValue$new(12.5, .01))
- lagged_eir <- list(list(LaggedValue$new(12, 10)), list(LaggedValue$new(12, 10)))
- age <- c(20, 24, 5, 39) * 365
- bitten <- simulate_bites(
- renderer,
- solvers,
- models,
- variables,
- events,
- age,
- parameters,
- timestep,
- lagged_foim,
- lagged_eir,
- c(0.2, 0.8),
- 2
- )
-
- mockery::expect_args(mock_foim, 1, .3, c(.001, .01), c(.2, .8))
-})
diff --git a/tests/testthat/test-biting.R b/tests/testthat/test-biting.R
index 91a60be4..e6c19fb9 100644
--- a/tests/testthat/test-biting.R
+++ b/tests/testthat/test-biting.R
@@ -10,14 +10,3 @@ test_that('gonotrophic_cycle cannot be negative', {
vparams$blood_meal_rates <- 5
expect_error(set_species(params, list(vparams), 1))
})
-
-test_that('calculate_foim mixes correctly', {
- expect_equal( # check 1 case
- calculate_foim(a=0.5, infectivity=6, mixing=1),
- 3
- )
- expect_equal( # check 2 cases
- calculate_foim(a=0.5, infectivity=c(6, 4), mixing=c(.5, .5)),
- 2.5
- )
-})
diff --git a/tests/testthat/test-compartmental.R b/tests/testthat/test-compartmental.R
index a4fb3b6a..9958c7a5 100644
--- a/tests/testthat/test-compartmental.R
+++ b/tests/testthat/test-compartmental.R
@@ -11,9 +11,14 @@ test_that('ODE stays at equilibrium with a constant total_M', {
counts <- c()
for (t in seq(timesteps)) {
- counts <- rbind(counts, c(t, solver_get_states(solvers[[1]])))
- aquatic_mosquito_model_update(models[[1]], total_M, f, parameters$mum)
- solver_step(solvers[[1]])
+ counts <- rbind(counts, c(t, solvers[[1]]$get_states()))
+ aquatic_mosquito_model_update(
+ models[[1]]$.model,
+ total_M,
+ f,
+ parameters$mum
+ )
+ solvers[[1]]$step()
}
expected <- c()
@@ -41,16 +46,16 @@ test_that('Adult ODE stays at equilibrium with a constant foim and mu', {
counts <- c()
for (t in seq(timesteps)) {
- states <- solver_get_states(solvers[[1]])
+ states <- solvers[[1]]$get_states()
counts <- rbind(counts, c(t, states))
adult_mosquito_model_update(
- models[[1]],
+ models[[1]]$.model,
parameters$mum,
parameters$init_foim,
states[ADULT_ODE_INDICES['Sm']],
f
)
- solver_step(solvers[[1]])
+ solvers[[1]]$step()
}
expected <- c()
@@ -82,9 +87,14 @@ test_that('ODE stays at equilibrium with low total_M', {
counts <- c()
for (t in seq(timesteps)) {
- counts <- rbind(counts, c(t, solver_get_states(solvers[[1]])))
- aquatic_mosquito_model_update(models[[1]], total_M, f, parameters$mum)
- solver_step(solvers[[1]])
+ counts <- rbind(counts, c(t, solvers[[1]]$get_states()))
+ aquatic_mosquito_model_update(
+ models[[1]]$.model,
+ total_M,
+ f,
+ parameters$mum
+ )
+ solvers[[1]]$step()
}
expected <- c()
@@ -121,14 +131,19 @@ test_that('Changing total_M stabilises', {
counts <- c()
for (t in seq(timesteps)) {
- counts <- rbind(counts, c(t, solver_get_states(solvers[[1]])))
+ counts <- rbind(counts, c(t, solvers[[1]]$get_states()))
if (t < change) {
total_M <- total_M_0
} else {
total_M <- total_M_1
}
- aquatic_mosquito_model_update(models[[1]], total_M, f, parameters$mum)
- solver_step(solvers[[1]])
+ aquatic_mosquito_model_update(
+ models[[1]]$.model,
+ total_M,
+ f,
+ parameters$mum
+ )
+ solvers[[1]]$step()
}
initial_eq <- initial_mosquito_counts(
diff --git a/tests/testthat/test-competing-hazards.R b/tests/testthat/test-competing-hazards.R
new file mode 100644
index 00000000..f7ada3fc
--- /dev/null
+++ b/tests/testthat/test-competing-hazards.R
@@ -0,0 +1,176 @@
+# ==============================
+# Test the CompetingHazard class
+# ==============================
+
+
+test_that("hazard resolves two disjoint outcomes", {
+ size <- 4
+ population <- individual::Bitset$new(size)$not()
+
+ outcome_1_process <- mockery::mock()
+ outcome_1 <- CompetingOutcome$new(
+ targeted_process = outcome_1_process,
+ size = size
+ )
+ outcome_2_process <- mockery::mock()
+ outcome_2 <- CompetingOutcome$new(
+ targeted_process = outcome_2_process,
+ size = size
+ )
+
+ hazard <- CompetingHazard$new(
+ size = size,
+ outcomes = list(outcome_1, outcome_2),
+ rng = mockery::mock(c(.05, .3, .2, .5))
+ )
+
+ outcome_1$set_rates(population, c(10, 0, 10, 0))
+ outcome_2$set_rates(population, c(0, 10, 0, 10))
+
+ hazard$resolve(0)
+
+ mockery::expect_args(outcome_1_process, 1, 0,
+ individual::Bitset$new(size)$insert(c(1, 3)))
+ mockery::expect_args(outcome_2_process, 1, 0,
+ individual::Bitset$new(size)$insert(c(2, 4)))
+})
+
+test_that("hazard resolves two competing outcomes", {
+ size <- 4
+ population <- individual::Bitset$new(size)$not()
+
+ outcome_1_process <- mockery::mock()
+ outcome_1 <- CompetingOutcome$new(
+ targeted_process = outcome_1_process,
+ size = size
+ )
+ outcome_2_process <- mockery::mock()
+ outcome_2 <- CompetingOutcome$new(
+ targeted_process = outcome_2_process,
+ size = size
+ )
+
+ hazard <- CompetingHazard$new(
+ size = size,
+ outcomes = list(outcome_1, outcome_2),
+ rng = mockery::mock(c(.7, .3, .2, .6))
+ )
+
+ outcome_1$set_rates(population, c(5, 5, 5, 5))
+ outcome_2$set_rates(population, c(5, 5, 5, 5))
+
+ hazard$resolve(0)
+
+ mockery::expect_args(outcome_1_process, 1, 0,
+ individual::Bitset$new(size)$insert(c(2, 3)))
+ mockery::expect_args(outcome_2_process, 1, 0,
+ individual::Bitset$new(size)$insert(c(1, 4)))
+})
+
+test_that("hazard may resolve to neither outcome", {
+ size <- 4
+ population <- individual::Bitset$new(size)$not()
+
+ outcome_1_process <- mockery::mock()
+ outcome_1 <- CompetingOutcome$new(
+ targeted_process = outcome_1_process,
+ size = size
+ )
+ outcome_2_process <- mockery::mock()
+ outcome_2 <- CompetingOutcome$new(
+ targeted_process = outcome_2_process,
+ size = size
+ )
+
+ hazard <- CompetingHazard$new(
+ size = size,
+ outcomes = list(outcome_1, outcome_2),
+ rng = mockery::mock(c(.8, .4, .2, .6))
+ )
+
+ outcome_1$set_rates(population, prob_to_rate(rep(0.5, size)))
+ outcome_2$set_rates(population, prob_to_rate(rep(0.5, size)))
+
+ hazard$resolve(0)
+
+ mockery::expect_args(outcome_1_process, 1, 0,
+ individual::Bitset$new(size)$insert(c(3)))
+ mockery::expect_args(outcome_2_process, 1, 0,
+ individual::Bitset$new(size)$insert(c(2, 4)))
+})
+
+test_that("outcomes can define a partial set of rates", {
+ size <- 4
+ population <- individual::Bitset$new(size)$not()
+
+ outcome_1_process <- mockery::mock()
+ outcome_1 <- CompetingOutcome$new(
+ targeted_process = outcome_1_process,
+ size = size
+ )
+ outcome_2_process <- mockery::mock()
+ outcome_2 <- CompetingOutcome$new(
+ targeted_process = outcome_2_process,
+ size = size
+ )
+
+ hazard <- CompetingHazard$new(
+ size = size,
+ outcomes = list(outcome_1, outcome_2),
+
+ # Only individuals 1, 3 and 4 get sampled
+ rng = mockery::mock(c(.2, .3, .6))
+ )
+
+ outcome_1$set_rates(individual::Bitset$new(size)$insert(c(1,3)), c(5, 5))
+ outcome_2$set_rates(individual::Bitset$new(size)$insert(c(1,4)), c(5, 5))
+
+ hazard$resolve(0)
+
+ mockery::expect_args(outcome_1_process, 1, 0,
+ individual::Bitset$new(size)$insert(c(1, 3)))
+ mockery::expect_args(outcome_2_process, 1, 0,
+ individual::Bitset$new(size)$insert(c(4))
+ )
+})
+
+test_that("hazard resolves three competing outcomes", {
+ size <- 4
+ population <- individual::Bitset$new(size)$not()
+
+ outcome_1_process <- mockery::mock()
+ outcome_1 <- CompetingOutcome$new(
+ targeted_process = outcome_1_process,
+ size = size
+ )
+ outcome_2_process <- mockery::mock()
+ outcome_2 <- CompetingOutcome$new(
+ targeted_process = outcome_2_process,
+ size = size
+ )
+ outcome_3_process <- mockery::mock()
+ outcome_3 <- CompetingOutcome$new(
+ targeted_process = outcome_3_process,
+ size = size
+ )
+
+ hazard <- CompetingHazard$new(
+ size = size,
+ outcomes = list(outcome_1, outcome_2, outcome_3),
+ rng = mockery::mock(c(.1, .5, .8, .8))
+ )
+
+ outcome_1$set_rates(population, c(5, 5, 5, 5))
+ outcome_2$set_rates(population, c(5, 5, 5, 5))
+ outcome_3$set_rates(population, c(5, 5, 5, 5))
+
+ hazard$resolve(0)
+
+ mockery::expect_args(outcome_1_process, 1, 0,
+ individual::Bitset$new(size)$insert(c(1)))
+ mockery::expect_args(outcome_2_process, 1, 0,
+ individual::Bitset$new(size)$insert(c(2)))
+ mockery::expect_args(outcome_3_process, 1, 0,
+ individual::Bitset$new(size)$insert(c(3, 4)))
+})
+
diff --git a/tests/testthat/test-correlation.R b/tests/testthat/test-correlation.R
index 880221ba..5653daaa 100644
--- a/tests/testthat/test-correlation.R
+++ b/tests/testthat/test-correlation.R
@@ -1,105 +1,354 @@
test_that('1 correlation between rounds gives sensible samples', {
pop <- 1e6
target <- seq(pop)
- vaccine_coverage <- .2
- parameters <- get_parameters(list(
- human_population = pop,
- pev = TRUE
- ))
- correlations <- get_correlation_parameters(parameters)
+
+ coverage_1 <- .2
+ coverage_2 <- .4
+
+ correlations <- CorrelationParameters$new(pop, c('pev'))
correlations$inter_round_rho('pev', 1)
- round_1 <- sample_intervention(target, 'pev', vaccine_coverage, correlations)
- round_2 <- sample_intervention(target, 'pev', vaccine_coverage, correlations)
- expect_equal(sum(round_1), pop * .2, tolerance=1e2)
- expect_equal(sum(round_2), pop * .2, tolerance=1e2)
- expect_equal(sum(round_1 & round_2), pop * .2, tolerance=1e2)
+
+ round_1 <- sample_intervention(target, 'pev', coverage_1, correlations)
+ round_2 <- sample_intervention(target, 'pev', coverage_2, correlations)
+
+ expect_equal(sum(round_1), pop * coverage_1, tolerance=.1)
+ expect_equal(sum(round_2), pop * coverage_2, tolerance=.1)
+
+ expect_equal(
+ sum(round_1 & round_2),
+ pop * min(coverage_1, coverage_2),
+ tolerance=.1)
+
+ expect_equal(
+ sum(round_1 | round_2),
+ pop * max(coverage_1, coverage_2),
+ tolerance=.1)
})
test_that('0 correlation between rounds gives sensible samples', {
pop <- 1e6
target <- seq(pop)
- vaccine_coverage <- .5
- parameters <- get_parameters(list(
- human_population = pop,
- pev = TRUE
- ))
- correlations <- get_correlation_parameters(parameters)
+
+ coverage_1 <- .2
+ coverage_2 <- .4
+
+ correlations <- CorrelationParameters$new(pop, c('pev'))
correlations$inter_round_rho('pev', 0)
- round_1 <- sample_intervention(target, 'pev', vaccine_coverage, correlations)
- round_2 <- sample_intervention(target, 'pev', vaccine_coverage, correlations)
- expect_equal(
- length(intersect(which(round_1), which(round_2))),
- pop * .5,
- tolerance=1e2
- )
- expect_equal(sum(round_1), sum(round_2), tolerance=1e2)
- expect_equal(sum(round_1), pop * .5, tolerance=1e2)
+
+ round_1 <- sample_intervention(target, 'pev', coverage_1, correlations)
+ round_2 <- sample_intervention(target, 'pev', coverage_2, correlations)
+
+ expect_equal(sum(round_1), pop * coverage_1, tolerance=.1)
+ expect_equal(sum(round_2), pop * coverage_2, tolerance=.1)
+
+ expect_equal(
+ sum(round_1 & round_2),
+ pop * coverage_1 * coverage_2,
+ tolerance=.1)
+
+ expect_equal(
+ sum(round_1 | round_2),
+ pop * (coverage_1 + coverage_2 - (coverage_1 * coverage_2)),
+ tolerance=.1)
})
test_that('1 correlation between interventions gives sensible samples', {
pop <- 1e6
target <- seq(pop)
- vaccine_coverage <- .2
- mda_coverage <- .2
- parameters <- get_parameters(list(
- human_population = pop,
- pev = TRUE,
- mda = TRUE
- ))
- correlations <- get_correlation_parameters(parameters)
+
+ pev_coverage <- .2
+ mda_coverage <- .4
+
+ correlations <- CorrelationParameters$new(pop, c('pev', 'mda'))
correlations$inter_round_rho('pev', 1)
correlations$inter_round_rho('mda', 1)
correlations$inter_intervention_rho('pev', 'mda', 1)
- vaccine_sample <- sample_intervention(target, 'pev', vaccine_coverage, correlations)
+
+ pev_sample <- sample_intervention(target, 'pev', pev_coverage, correlations)
mda_sample <- sample_intervention(target, 'mda', mda_coverage, correlations)
- expect_equal(sum(vaccine_sample), pop * .2, tolerance=1e2)
- expect_equal(sum(mda_sample), pop * .2, tolerance=1e2)
- expect_equal(sum(vaccine_sample & mda_sample), pop * .2, tolerance=1e2)
+ expect_equal(sum(pev_sample), pop * pev_coverage, tolerance=.1)
+ expect_equal(sum(mda_sample), pop * mda_coverage, tolerance=.1)
+
+ expect_equal(
+ sum(pev_sample & mda_sample),
+ pop * min(pev_coverage, mda_coverage),
+ tolerance=.1)
+
+ expect_equal(
+ sum(pev_sample | mda_sample),
+ pop * max(pev_coverage, mda_coverage),
+ tolerance=.1)
})
test_that('0 correlation between interventions gives sensible samples', {
pop <- 1e6
target <- seq(pop)
- vaccine_coverage <- .2
- mda_coverage <- .2
- parameters <- get_parameters(list(
- human_population = pop,
- pev = TRUE,
- mda = TRUE
- ))
- correlations <- get_correlation_parameters(parameters)
+
+ pev_coverage <- .2
+ mda_coverage <- .4
+
+ correlations <- CorrelationParameters$new(pop, c('pev', 'mda'))
correlations$inter_round_rho('pev', 1)
correlations$inter_round_rho('mda', 1)
correlations$inter_intervention_rho('pev', 'mda', 0)
- vaccine_sample <- sample_intervention(target, 'pev', vaccine_coverage, correlations)
+
+ pev_sample <- sample_intervention(target, 'pev', pev_coverage, correlations)
mda_sample <- sample_intervention(target, 'mda', mda_coverage, correlations)
+
+ expect_equal(sum(pev_sample), pop * pev_coverage, tolerance=.1)
+ expect_equal(sum(mda_sample), pop * mda_coverage, tolerance=.1)
+
+ expect_equal(
+ sum(pev_sample & mda_sample),
+ pop * pev_coverage * mda_coverage,
+ tolerance=.1)
+
expect_equal(
- length(intersect(which(vaccine_sample), which(mda_sample))),
- pop * .5,
- tolerance=1e2
- )
- expect_equal(sum(vaccine_sample), sum(mda_sample), tolerance=1e2)
- expect_equal(sum(vaccine_sample), pop * .5, tolerance=1e2)
+ sum(pev_sample | mda_sample),
+ pop * (pev_coverage + mda_coverage - (pev_coverage * mda_coverage)),
+ tolerance=.1)
})
test_that('-1 correlation between interventions gives sensible samples', {
pop <- 1e6
target <- seq(pop)
- vaccine_coverage <- .2
- mda_coverage <- .2
- parameters <- get_parameters(list(
- human_population = pop,
- pev = TRUE,
- mda = TRUE
- ))
- correlations <- get_correlation_parameters(parameters)
+
+ pev_coverage <- .2
+ mda_coverage <- .4
+
+ correlations <- CorrelationParameters$new(pop, c('pev', 'mda'))
correlations$inter_round_rho('pev', 1)
correlations$inter_round_rho('mda', 1)
correlations$inter_intervention_rho('pev', 'mda', -1)
- vaccine_sample <- sample_intervention(target, 'pev', vaccine_coverage, correlations)
+
+ pev_sample <- sample_intervention(target, 'pev', pev_coverage, correlations)
mda_sample <- sample_intervention(target, 'mda', mda_coverage, correlations)
- expect_equal(length(intersect(which(vaccine_sample), which(mda_sample))), 0)
- expect_equal(sum(vaccine_sample), .2 * pop, tolerance=1e2)
- expect_equal(sum(mda_sample), .2 * pop, tolerance=1e2)
+
+ expect_equal(sum(pev_sample), pop * pev_coverage, tolerance=.1)
+ expect_equal(sum(mda_sample), pop * mda_coverage, tolerance=.1)
+
+ expect_equal(sum(pev_sample & mda_sample), 0, tolerance=.1)
+ expect_equal(
+ sum(pev_sample | mda_sample),
+ pop * (pev_coverage + mda_coverage),
+ tolerance=.1)
+})
+
+test_that('correlation between rounds is preserved when adding interventions', {
+ pop <- 1e6
+ target <- seq(pop)
+
+ pev_coverage_1 <- .2
+ pev_coverage_2 <- .4
+
+ initial <- CorrelationParameters$new(pop, c('pev'))
+ initial$inter_round_rho('pev', 1)
+
+ restored <- CorrelationParameters$new(pop, c('pev', 'mda'))
+ restored$inter_round_rho('pev', 1)
+ restored$inter_round_rho('mda', 1)
+ restored$inter_intervention_rho('pev', 'mda', 1)
+ restored$restore_state(0, initial$save_state())
+
+ round_1 <- sample_intervention(target, 'pev', pev_coverage_1, initial)
+ round_2 <- sample_intervention(target, 'pev', pev_coverage_2, restored)
+
+ expect_equal(sum(round_1), pop * pev_coverage_1, tolerance=.1)
+ expect_equal(sum(round_2), pop * pev_coverage_2, tolerance=.1)
+
+ expect_equal(
+ sum(round_1 & round_2),
+ pop * min(pev_coverage_1, pev_coverage_2),
+ tolerance=.1)
+
+ expect_equal(
+ sum(round_1 | round_2),
+ pop * max(pev_coverage_1, pev_coverage_2),
+ tolerance=.1)
+})
+
+test_that('1 correlation between interventions gives sensible samples when restored', {
+ pop <- 1e6
+ target <- seq(pop)
+
+ pev_coverage <- .2
+ mda_coverage <- .2
+
+ initial <- CorrelationParameters$new(pop, c('pev'))
+ initial$inter_round_rho('pev', 1)
+
+ restored <- CorrelationParameters$new(pop, c('pev', 'mda'))
+ restored$inter_round_rho('pev', 1)
+ restored$inter_round_rho('mda', 1)
+ restored$inter_intervention_rho('pev', 'mda', 1)
+ restored$restore_state(0, initial$save_state())
+
+ pev_sample <- sample_intervention(target, 'pev', pev_coverage, initial)
+ mda_sample <- sample_intervention(target, 'mda', mda_coverage, restored)
+
+ expect_equal(sum(pev_sample), pop * pev_coverage, tolerance=.1)
+ expect_equal(sum(mda_sample), pop * mda_coverage, tolerance=.1)
+
+ expect_equal(
+ sum(pev_sample & mda_sample),
+ pop * min(pev_coverage, mda_coverage),
+ tolerance=.1)
+
+ expect_equal(
+ sum(pev_sample | mda_sample),
+ pop * max(pev_coverage, mda_coverage),
+ tolerance=.1)
+})
+
+test_that('0 correlation between interventions gives sensible samples when restored', {
+ pop <- 1e6
+ target <- seq(pop)
+
+ pev_coverage <- .2
+ mda_coverage <- .2
+
+ initial <- CorrelationParameters$new(pop, c('pev'))
+ initial$inter_round_rho('pev', 1)
+
+ restored <- CorrelationParameters$new(pop, c('pev', 'mda'))
+ restored$inter_round_rho('pev', 1)
+ restored$inter_round_rho('mda', 1)
+ restored$inter_intervention_rho('pev', 'mda', 0)
+ restored$restore_state(0, initial$save_state())
+
+ pev_sample <- sample_intervention(target, 'pev', pev_coverage, initial)
+ mda_sample <- sample_intervention(target, 'mda', mda_coverage, restored)
+
+ expect_equal(sum(pev_sample), pop * pev_coverage, tolerance=.1)
+ expect_equal(sum(mda_sample), pop * mda_coverage, tolerance=.1)
+
+ expect_equal(
+ sum(pev_sample & mda_sample),
+ pop * pev_coverage * mda_coverage,
+ tolerance=.1)
+
+ expect_equal(
+ sum(pev_sample | mda_sample),
+ pop * (pev_coverage + mda_coverage - (pev_coverage * mda_coverage)),
+ tolerance=.1)
+})
+
+test_that('-1 correlation between interventions gives sensible samples when restored', {
+ pop <- 1e6
+ target <- seq(pop)
+ pev_coverage <- .2
+ mda_coverage <- .2
+
+ initial <- CorrelationParameters$new(pop, c('pev'))
+ initial$inter_round_rho('pev', 1)
+
+ restored <- CorrelationParameters$new(pop, c('pev', 'mda'))
+ restored$inter_round_rho('pev', 1)
+ restored$inter_round_rho('mda', 1)
+ restored$inter_intervention_rho('pev', 'mda', -1)
+ restored$restore_state(0, initial$save_state())
+
+ pev_sample <- sample_intervention(target, 'pev', pev_coverage, initial)
+ mda_sample <- sample_intervention(target, 'mda', mda_coverage, restored)
+
+ expect_equal(sum(pev_sample), pop * pev_coverage, tolerance=.1)
+ expect_equal(sum(mda_sample), pop * mda_coverage, tolerance=.1)
+
+ expect_equal(sum(pev_sample & mda_sample), 0, tolerance=.1)
+ expect_equal(
+ sum(pev_sample | mda_sample),
+ pop * (pev_coverage + mda_coverage),
+ tolerance=.1)
+})
+
+test_that("rcondmvnorm has correct distribution", {
+ set.seed(123)
+
+ pop <- 1e6
+
+ # These are completely arbitrary values. The statistics from the simulated
+ # sample will get compared back to this.
+ means <- c(-5, 7, 0, 0.3)
+ variance <- c(0.3, 0.6, 0.9, 0.2)
+ correlation <- matrix(0, ncol=4, nrow=4)
+ correlation[1,2] <- correlation[2,1] <- -0.6
+ correlation[1,3] <- correlation[3,1] <- 0.4
+ correlation[1,4] <- correlation[4,1] <- 1
+ correlation[2,3] <- correlation[3,2] <- 0
+ correlation[2,4] <- correlation[4,2] <- 0.1
+ correlation[3,4] <- correlation[4,3] <- 0.5
+
+ covariance <- outer(variance, variance) * correlation
+ diag(covariance) <- variance
+
+ # These are indices of variables that get simulated together.
+ wy.ind <- c(1, 3)
+ xz.ind <- c(2, 4)
+
+ # Simulate from the MVN for a subset of the dimensions. We intentionally pass
+ # in a subset of the mean and covariance matrices, as the rest of the
+ # parameters are not needed and may not be known. `dependent.ind` is relative
+ # to the subsetted mean and covariance, and therefore is set the first two
+ # indices as opposed to `wy.ind`.
+ wy <- rcondmvnorm(pop, means[wy.ind], covariance[wy.ind, wy.ind], given=NULL,
+ dependent.ind=c(1,2), given.ind=NULL)
+ expect_equal(dim(wy), c(pop, 2))
+ expect_equal(apply(wy, 2, mean), means[wy.ind], tolerance=0.001)
+ expect_equal(cov(wy), covariance[wy.ind, wy.ind], tolerance=0.001)
+
+ # Now simulate some more, but conditional on the existing values.
+ # The call to rcondmvnorm needs all the mean and covariance parameters,
+ # including the ones that have already been simulated.
+ xz <- rcondmvnorm(pop, means, covariance, given=wy,
+ dependent.ind=xz.ind, given.ind=wy.ind)
+ expect_equal(dim(xz), c(pop, 2))
+ expect_equal(apply(xz, 2, mean), means[xz.ind], tolerance=0.001)
+ expect_equal(cov(xz), covariance[xz.ind, xz.ind], tolerance=0.001)
+
+ # Stitch the variables back together and make sure the covariance across the
+ # separately simulated values match the expected one.
+ values <- cbind(wy[,1], xz[,1], wy[,2], xz[,2])
+ expect_equal(apply(values, 2, mean), means, tolerance=0.001)
+ expect_equal(cov(values), covariance, tolerance=0.001)
+})
+
+# This would usually be considered an uninteresting edge case, since null
+# variance just yields a constant vector. The way we use the function in the
+# simulation though, a null variance is actually the default and most common
+# case, as it is used where the different rounds of an intervention have no
+# correlation.
+#
+# We need to make sure the other variables are still correctly simulated.
+test_that("rcondmvnorm allows null variance of given variables", {
+ set.seed(123)
+
+ pop <- 1e6
+
+ means <- c(-5, 7, 0)
+ variance <- c(0.3, 0, 0.9)
+ correlation <- matrix(0, ncol=3, nrow=3)
+ correlation[1,3] <- 0.4
+ correlation[3,1] <- 0.4
+
+ covariance <- outer(variance, variance) * correlation
+ diag(covariance) <- variance
+
+ # These are indices of variables that get simulated together.
+ y.ind <- 2
+ xz.ind <- c(1,3)
+
+ # Simulate one dimension. Because its variance was null, the result is a
+ # constant vector.
+ y <- rcondmvnorm(pop, means, covariance, given=NULL,
+ dependent.ind=y.ind, given.ind=NULL)
+ expect_equal(as.vector(y), rep(means[y.ind], pop))
+
+ # Simulate the rest. The original dimension has no influence on the result.
+ xz <- rcondmvnorm(pop, means, covariance, given=y,
+ dependent.ind=xz.ind, given.ind=y.ind)
+
+ xyz <- cbind(xz[,1], y, xz[,2])
+ expect_equal(apply(xyz, 2, mean), means, tolerance=0.001)
+ expect_equal(cov(xyz), covariance, tolerance=0.001)
})
diff --git a/tests/testthat/test-demography.R b/tests/testthat/test-demography.R
index 3b08dd37..ce760567 100644
--- a/tests/testthat/test-demography.R
+++ b/tests/testthat/test-demography.R
@@ -1,13 +1,14 @@
-test_that('calculate_initial_ages defaults to an exponential distribution', {
+test_that('calculate_initial_ages defaults to a truncated exponential distribution', {
parameters <- get_parameters(list(human_population = 4))
mock_exp <- mockery::mock(seq(4))
- mockery::stub(calculate_initial_ages, 'rexp', mock_exp)
+ mockery::stub(calculate_initial_ages, 'rtexp', mock_exp)
ages <- calculate_initial_ages(parameters)
mockery::expect_args(
mock_exp,
1,
parameters$human_population,
- 1 / parameters$average_age
+ 1 / parameters$average_age,
+ max(EQUILIBRIUM_AGES)*365
)
})
@@ -70,4 +71,4 @@ test_that('match_timestep works on the boundaries', {
expect_equal(match_timestep(c(0, 50, 100), 99), 2)
expect_equal(match_timestep(c(0, 50, 100), 100), 3)
expect_equal(match_timestep(c(0, 50, 100), 101), 3)
-})
\ No newline at end of file
+})
diff --git a/tests/testthat/test-emergence-integration.R b/tests/testthat/test-emergence-integration.R
index fa7464be..bf452d2f 100644
--- a/tests/testthat/test-emergence-integration.R
+++ b/tests/testthat/test-emergence-integration.R
@@ -8,22 +8,19 @@ test_that('emergence process fails when there are not enough individuals', {
c('gamb'),
rep('gamb', 2000)
)
+ solvers <- list(
+ mock_solver(c(1000, 500, 100)),
+ mock_solver(c(1000, 500, 100))
+ )
+
emergence_process <- create_mosquito_emergence_process(
- list(),
+ solvers,
state,
species,
c('gamb'),
parameters$dpl
)
- mockery::stub(
- emergence_process,
- 'solver_get_states',
- mockery::mock(
- c(1000, 500, 100),
- c(1000, 500, 100)
- )
- )
- expect_error(emergence_process(0), '*')
+ expect_error(emergence_process(0), 'Not enough mosquitoes')
})
test_that('emergence_process creates the correct number of susceptables', {
@@ -36,23 +33,19 @@ test_that('emergence_process creates the correct number of susceptables', {
c('a', 'b'),
c('a', 'b')
)
+ solvers <- list(
+ mock_solver(c(100000, 50000, 10000)),
+ mock_solver(c(1000, 5000, 1000))
+ )
+
emergence_process <- create_mosquito_emergence_process(
- list(mockery::mock(), mockery::mock()),
+ solvers,
state,
species,
c('a', 'b'),
parameters$dpl
)
- mockery::stub(
- emergence_process,
- 'solver_get_states',
- mockery::mock(
- c(100000, 50000, 10000),
- c(10000, 5000, 1000)
- )
- )
-
emergence_process(0)
expect_bitset_update(
diff --git a/tests/testthat/test-infection-integration.R b/tests/testthat/test-infection-integration.R
index a8e6033e..eb4eabb6 100644
--- a/tests/testthat/test-infection-integration.R
+++ b/tests/testthat/test-infection-integration.R
@@ -6,7 +6,7 @@ test_that('simulate_infection integrates different types of infection and schedu
))
events <- create_events(parameters)
renderer <- mock_render(timestep)
-
+
age <- c(20, 24, 5, 39, 20, 24, 5, 39) * 365
immunity <- c(.2, .3, .5, .9, .2, .3, .5, .9)
asymptomatics <- mockery::mock()
@@ -15,27 +15,22 @@ test_that('simulate_infection integrates different types of infection and schedu
id = individual::DoubleVariable$new(immunity),
state = list(get_index_of = mockery::mock(asymptomatics))
)
-
+
bitten <- individual::Bitset$new(population)$insert(c(1, 3, 5, 7))
boost_immunity_mock <- mockery::mock()
infected <- individual::Bitset$new(population)$insert(c(1, 3, 5))
infection_mock <- mockery::mock(infected)
- clinical <- individual::Bitset$new(population)$insert(c(1, 3))
- clinical_infection_mock <- mockery::mock(clinical)
- severe <- individual::Bitset$new(population)$insert(1)
- severe_infection_mock <- mockery::mock(severe)
- treated <- individual::Bitset$new(population)$insert(3)
- treated_mock <- mockery::mock(treated)
- schedule_mock <- mockery::mock()
-
+
+ infection_outcome <- CompetingOutcome$new(
+ targeted_process = function(timestep, target){
+ infection_outcome_process(timestep, target, variables, renderer, parameters)
+ },
+ size = parameters$human_population
+ )
+
mockery::stub(simulate_infection, 'boost_immunity', boost_immunity_mock)
mockery::stub(simulate_infection, 'calculate_infections', infection_mock)
- mockery::stub(simulate_infection, 'calculate_clinical_infections', clinical_infection_mock)
- mockery::stub(simulate_infection, 'update_severe_disease', severe_infection_mock)
- mockery::stub(simulate_infection, 'calculate_treated', treated_mock)
- mockery::stub(simulate_infection, 'schedule_infections', schedule_mock)
- mockery::stub(simulate_infection, 'incidence_renderer', mockery::mock())
- mockery::stub(simulate_infection, 'clinical_incidence_renderer', mockery::mock())
+
simulate_infection(
variables,
events,
@@ -43,9 +38,10 @@ test_that('simulate_infection integrates different types of infection and schedu
age,
parameters,
timestep,
- renderer
+ renderer,
+ infection_outcome
)
-
+
mockery::expect_args(
boost_immunity_mock,
1,
@@ -55,7 +51,7 @@ test_that('simulate_infection integrates different types of infection and schedu
5,
parameters$ub
)
-
+
mockery::expect_args(
infection_mock,
1,
@@ -63,9 +59,70 @@ test_that('simulate_infection integrates different types of infection and schedu
bitten,
parameters,
renderer,
- timestep
+ timestep,
+ infection_outcome
)
+})
+
+test_that('simulate_infection integrates different types of infection and scheduling', {
+ population <- 8
+ timestep <- 5
+ parameters <- get_parameters(list(
+ human_population = population
+ ))
+ events <- create_events(parameters)
+ renderer <- mock_render(timestep)
+
+ age <- c(20, 24, 5, 39, 20, 24, 5, 39) * 365
+ immunity <- c(.2, .3, .5, .9, .2, .3, .5, .9)
+ # asymptomatics <- mockery::mock()
+ variables <- list(
+ ib = individual::DoubleVariable$new(immunity),
+ id = individual::DoubleVariable$new(immunity),
+ # state = list(get_index_of = mockery::mock(asymptomatics, cycle = T))
+ state = individual::CategoricalVariable$new(categories = c("S","A","U","D","Tr"), initial_values = rep("S", population))#list(get_index_of = mockery::mock(asymptomatics, cycle = T))
+ )
+ prob <- rep(0.5,population)
+
+ source_humans <- individual::Bitset$new(population)$insert(c(1, 2, 3, 5))
+ infected <- individual::Bitset$new(population)$insert(c(1, 3, 5))
+ clinical <- individual::Bitset$new(population)$insert(c(1, 3))
+ clinical_infection_mock <- mockery::mock(clinical)
+ boost_immunity_mock <- mockery::mock()
+ severe <- individual::Bitset$new(population)$insert(1)
+ severe_infection_mock <- mockery::mock(severe)
+ treated <- individual::Bitset$new(population)$insert(3)
+ treated_mock <- mockery::mock(treated)
+ schedule_mock <- mockery::mock()
+
+
+ mockery::stub(infection_outcome_process, 'incidence_renderer', mockery::mock())
+ mockery::stub(infection_outcome_process, 'boost_immunity', boost_immunity_mock)
+ mockery::stub(infection_outcome_process, 'calculate_clinical_infections', clinical_infection_mock)
+ mockery::stub(infection_outcome_process, 'update_severe_disease', severe_infection_mock)
+ mockery::stub(infection_outcome_process, 'calculate_treated', treated_mock)
+ mockery::stub(infection_outcome_process, 'schedule_infections', schedule_mock)
+
+ infection_outcome_process(
+ timestep,
+ infected,
+ variables,
+ renderer,
+ parameters,
+ prob)
+
+
+ mockery::expect_args(
+ boost_immunity_mock,
+ 1,
+ variables$ica,
+ infected,
+ variables$last_boosted_ica,
+ 5,
+ parameters$uc
+ )
+
mockery::expect_args(
clinical_infection_mock,
1,
@@ -75,7 +132,7 @@ test_that('simulate_infection integrates different types of infection and schedu
renderer,
timestep
)
-
+
mockery::expect_args(
severe_infection_mock,
1,
@@ -85,7 +142,7 @@ test_that('simulate_infection integrates different types of infection and schedu
parameters,
renderer
)
-
+
mockery::expect_args(
treated_mock,
1,
@@ -95,7 +152,7 @@ test_that('simulate_infection integrates different types of infection and schedu
timestep,
renderer
)
-
+
mockery::expect_args(
schedule_mock,
1,
@@ -121,11 +178,11 @@ 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)
)
-
+
variables <- list(
state = individual::CategoricalVariable$new(
c('D', 'S', 'A', 'U', 'Tr'),
@@ -133,11 +190,11 @@ test_that('calculate_infections works various combinations of drug and vaccinati
),
drug = individual::DoubleVariable$new(c(1, 2, 0, 0)),
drug_time = individual::DoubleVariable$new(c(20, 30, -1, -1)),
- pev_timestep = individual::DoubleVariable$new(c(-1, 10, 40, -1)),
+ last_eff_pev_timestep = individual::DoubleVariable$new(c(-1, 10, 40, -1)),
pev_profile = individual::IntegerVariable$new(c(-1, 1, 2, -1)),
ib = individual::DoubleVariable$new(c(.2, .3, .5, .9))
)
-
+
immunity_mock <- mockery::mock(c(.2, .3, .4))
weibull_mock <- mockery::mock(.2)
vaccine_antibodies_mock <- mockery::mock(c(2, 3))
@@ -148,7 +205,7 @@ test_that('calculate_infections works various combinations of drug and vaccinati
mockery::stub(calculate_infections, 'calculate_pev_antibodies', vaccine_antibodies_mock)
mockery::stub(calculate_infections, 'calculate_pev_efficacy', vaccine_efficacy_mock)
mockery::stub(calculate_infections, 'bernoulli_multi_p', bernoulli_mock)
-
+
# remove randomness from vaccine parameters
mockery::stub(
calculate_infections,
@@ -158,19 +215,27 @@ test_that('calculate_infections works various combinations of drug and vaccinati
},
depth = 4
)
-
+
bitten_humans <- individual::Bitset$new(4)$insert(c(1, 2, 3, 4))
-
+
+ infection_outcome <- CompetingOutcome$new(
+ targeted_process = function(timestep, target){
+ infection_outcome_process(timestep, target, variables, renderer, parameters)
+ },
+ size = 4
+ )
+
infections <- calculate_infections(
variables,
bitten_humans,
parameters,
mock_render(timestep),
- timestep
+ timestep,
+ infection_outcome
)
-
- expect_equal(infections$to_vector(), 3)
-
+
+ expect_equal(sum(infections!=0), 3)
+
mockery::expect_args(immunity_mock, 1, c(.3, .5, .9), parameters)
mockery::expect_args(
weibull_mock,
@@ -179,7 +244,7 @@ test_that('calculate_infections works various combinations of drug and vaccinati
parameters$drug_prophylaxis_shape[[2]],
parameters$drug_prophylaxis_scale[[2]]
)
-
+
mockery::expect_args(
vaccine_antibodies_mock,
1,
@@ -198,19 +263,12 @@ test_that('calculate_infections works various combinations of drug and vaccinati
c(rtss_profile$beta, rtss_booster_profile$beta),
c(rtss_profile$alpha, rtss_booster_profile$alpha)
)
- mockery::expect_args(
- bernoulli_mock,
- 1,
- c(.2 * .8 * .8, .3 * .7, .4)
- )
-
})
-
test_that('calculate_clinical_infections correctly samples clinically infected', {
timestep <- 5
parameters <- get_parameters()
-
+
variables <- list(
ica = individual::DoubleVariable$new(c(.2, .3, .5, .9)),
icm = individual::DoubleVariable$new(c(.2, .3, .5, .9)),
@@ -218,25 +276,25 @@ test_that('calculate_clinical_infections correctly samples clinically infected',
last_boosted_ica = individual::DoubleVariable$new(c(-1, -1, 1, -1)),
last_boosted_id = individual::DoubleVariable$new(c(-1, -1, 1, -1))
)
-
+
immunity_mock <- mockery::mock(c(.2, .3, .4))
boost_mock <- mockery::mock()
mockery::stub(calculate_clinical_infections, 'boost_immunity', boost_mock)
-
+
mockery::stub(calculate_clinical_infections, 'clinical_immunity', immunity_mock)
bernoulli_mock <- mockery::mock(c(1, 3))
mockery::stub(calculate_clinical_infections, 'bernoulli_multi_p', bernoulli_mock)
-
+
infections <- individual::Bitset$new(4)$insert(c(2, 3, 4))
-
+
clinical_infections <- calculate_clinical_infections(
variables,
infections,
parameters
)
-
+
expect_equal(clinical_infections$to_vector(), c(2, 4))
-
+
mockery::expect_args(
immunity_mock,
1,
@@ -244,7 +302,7 @@ test_that('calculate_clinical_infections correctly samples clinically infected',
c(.3, .5, .9),
parameters
)
-
+
mockery::expect_args(
bernoulli_mock,
1,
@@ -262,13 +320,14 @@ test_that('calculate_treated correctly samples treated and updates the drug stat
variables <- list(
state = list(queue_update = mockery::mock()),
infectivity = list(queue_update = mockery::mock()),
+ progression_rates = list(queue_update = mockery::mock()),
drug = list(queue_update = mockery::mock()),
drug_time = list(queue_update = mockery::mock())
)
-
+
recovery_mock <- mockery::mock()
mockery::stub(calculate_treated, 'recovery$schedule', recovery_mock)
-
+
seek_treatment <- individual::Bitset$new(4)$insert(c(1, 2, 4))
mockery::stub(
calculate_treated,
@@ -277,10 +336,11 @@ test_that('calculate_treated correctly samples treated and updates the drug stat
)
sample_mock <- mockery::mock(c(2, 1, 1, 1))
mockery::stub(calculate_treated, 'sample.int', sample_mock)
+
bernoulli_mock <- mockery::mock(c(1, 3))
- mockery::stub(calculate_treated, 'bernoulli_multi_p', bernoulli_mock)
+ local_mocked_bindings(bernoulli_multi_p = bernoulli_mock)
mockery::stub(calculate_treated, 'log_uniform', mockery::mock(c(3, 4)))
-
+
clinical_infections <- individual::Bitset$new(4)
clinical_infections$insert(c(1, 2, 3, 4))
calculate_treated(
@@ -290,7 +350,7 @@ test_that('calculate_treated correctly samples treated and updates the drug stat
timestep,
mock_render(timestep)
)
-
+
mockery::expect_args(
sample_mock,
1,
@@ -299,13 +359,13 @@ test_that('calculate_treated correctly samples treated and updates the drug stat
c(.25, .25),
TRUE
)
-
+
mockery::expect_args(
bernoulli_mock,
1,
parameters$drug_efficacy[c(2, 1, 1, 1)]
)
-
+
expect_bitset_update(variables$state$queue_update, 'Tr', c(1, 4))
expect_bitset_update(
variables$infectivity$queue_update,
@@ -316,20 +376,280 @@ test_that('calculate_treated correctly samples treated and updates the drug stat
expect_bitset_update(variables$drug_time$queue_update, 5, c(1, 4))
})
+test_that('calculate_treated correctly samples treated and updates the drug state when resistance set', {
+
+ parameters <- get_parameters()
+ parameters <- set_drugs(parameters = parameters, drugs = list(AL_params, SP_AQ_params))
+ parameters <- set_clinical_treatment(parameters = parameters, drug = 1, timesteps = 1, coverages = 0.25)
+ parameters <- set_clinical_treatment(parameters = parameters, drug = 2, timesteps = 1, coverages = 0.25)
+ parameters <- set_antimalarial_resistance(parameters = parameters,
+ drug = 1,
+ timesteps = 1,
+ artemisinin_resistance_proportion = 0.5,
+ partner_drug_resistance_proportion = 0,
+ slow_parasite_clearance_probability = 0,
+ early_treatment_failure_probability = 0.2,
+ late_clinical_failure_probability = 0,
+ late_parasitological_failure_probability = 0,
+ reinfection_during_prophylaxis_probability = 0,
+ slow_parasite_clearance_time = 10)
+ parameters <- set_antimalarial_resistance(parameters = parameters,
+ drug = 2,
+ timesteps = 1,
+ artemisinin_resistance_proportion = 0.3,
+ partner_drug_resistance_proportion = 0,
+ slow_parasite_clearance_probability = 0,
+ early_treatment_failure_probability = 0.9,
+ late_clinical_failure_probability = 0,
+ late_parasitological_failure_probability = 0,
+ reinfection_during_prophylaxis_probability = 0,
+ slow_parasite_clearance_time = 15)
+
+ clinical_infections <- individual::Bitset$new(20)$insert(1:20)
+ timestep <- 5
+ events <- create_events(parameters)
+ variables <- list(
+ state = list(queue_update = mockery::mock()),
+ infectivity = list(queue_update = mockery::mock()),
+ progression_rates = list(queue_update = mockery::mock()),
+ drug = list(queue_update = mockery::mock()),
+ drug_time = list(queue_update = mockery::mock())
+ )
+ renderer <- individual::Render$new(timesteps = timestep)
+
+ # Set up seek_treatment mock and instruct calculate_treated() to return it when sample_bitset() called:
+ seek_treatment <- individual::Bitset$new(20)$insert(c(1:10))
+ seek_treatment_mock <- mockery::mock(seek_treatment)
+ mockery::stub(where = calculate_treated, what = 'sample_bitset', how = seek_treatment_mock)
+
+ # Set up drugs mock and instruct it to return it when sample.int() called:
+ mock_drugs <- mockery::mock(c(2, 1, 1, 1, 2, 2, 2, 1, 2, 1))
+ mockery::stub(calculate_treated, 'sample.int', mock_drugs)
+
+ # Set up bernoulli mock and instruct calculate_treated to return it when bernoulli_multi_p() called:
+ bernoulli_mock <- mockery::mock(c(1, 2, 3, 4, 5, 6, 7, 8, 9),
+ c(1, 2, 3, 4, 5, 6, 7),
+ c(1))
+ local_mocked_bindings(bernoulli_multi_p = bernoulli_mock)
+
+ calculate_treated(
+ variables,
+ clinical_infections,
+ parameters,
+ timestep,
+ renderer
+ )
+
+ mockery::expect_args(
+ mock_drugs,
+ 1,
+ 2,
+ 10,
+ c(.25, .25),
+ TRUE
+ )
+
+ mockery::expect_args(
+ seek_treatment_mock,
+ 1,
+ clinical_infections,
+ 0.5
+ )
+
+ mockery::expect_args(
+ bernoulli_mock,
+ 1,
+ c(0.9, 0.95, 0.95, 0.95, 0.9, 0.9, 0.9, 0.95, 0.9, 0.95)
+ )
+
+ mockery::expect_args(
+ bernoulli_mock,
+ 2,
+ c(0.73, 0.9, 0.9, 0.9, 0.73, 0.73, 0.73, 0.9, 0.73)
+ )
+
+ mockery::expect_args(
+ bernoulli_mock,
+ 2,
+ 1 - (unlist(parameters$artemisinin_resistance_proportion[c(2, 1, 1, 1, 2, 2, 2, 1, 2)]) * unlist(parameters$early_treatment_failure_probability[c(2, 1, 1, 1, 2, 2, 2, 1, 2)]))
+ )
+
+ mockery::expect_args(
+ bernoulli_mock,
+ 3,
+ unlist(parameters$artemisinin_resistance_proportion[c(2, 1, 1, 1, 2, 2, 2)]) * unlist(parameters$slow_parasite_clearance_probability[c(2, 1, 1, 1, 2, 2, 2)])
+ )
+
+ expect_bitset_update(variables$state$queue_update, 'Tr', c(1, 2, 3, 4, 5, 6, 7))
+ expect_bitset_update(
+ variables$infectivity$queue_update,
+ parameters$cd * parameters$drug_rel_c[c(2, 1, 1, 1, 2, 2, 2)],
+ c(1, 2, 3, 4, 5, 6, 7)
+ )
+ expect_bitset_update(variables$drug$queue_update, c(2, 1, 1, 1, 2, 2, 2), c(1, 2, 3, 4, 5, 6, 7))
+ expect_bitset_update(variables$drug_time$queue_update, 5, c(1, 2, 3, 4, 5, 6, 7))
+ expect_bitset_update(variables$progression_rates$queue_update, c(1/15,rep(1/5,6)), c(1, 2, 3, 4, 5, 6, 7), 1)
+})
+
+test_that('calculate_treated correctly samples treated and updates the drug state when resistance not set for all drugs', {
+
+ # Establish the parameters
+ parameters <- get_parameters()
+ parameters <- set_drugs(parameters = parameters, drugs = list(AL_params, SP_AQ_params))
+ parameters <- set_clinical_treatment(parameters = parameters, drug = 1, timesteps = 1, coverages = 0.25)
+ parameters <- set_clinical_treatment(parameters = parameters, drug = 2, timesteps = 1, coverages = 0.25)
+ parameters <- set_antimalarial_resistance(parameters = parameters,
+ drug = 2,
+ timesteps = 1,
+ artemisinin_resistance_proportion = 0.8,
+ partner_drug_resistance_proportion = 0,
+ slow_parasite_clearance_probability = 0.2,
+ early_treatment_failure_probability = 0.3,
+ late_clinical_failure_probability = 0,
+ late_parasitological_failure_probability = 0,
+ reinfection_during_prophylaxis_probability = 0,
+ slow_parasite_clearance_time = 20)
+
+ # Establish Bitset of clinically infected individuals
+ clinical_infections <- individual::Bitset$new(20)$insert(1:20)
+
+ # Set the timestep to 5:
+ timestep <- 5
+
+ # Establish the events:
+ events <- create_events(parameters)
+
+ # Establish list of variables used in calculate_treated() using mocks:
+ variables <- list(
+ state = list(queue_update = mockery::mock()),
+ infectivity = list(queue_update = mockery::mock()),
+ progression_rates = list(queue_update = mockery::mock()),
+ drug = list(queue_update = mockery::mock()),
+ drug_time = list(queue_update = mockery::mock())
+ )
+
+ # Create a Bitset of individuals seeking treatment individuals:
+ seek_treatment <- individual::Bitset$new(20)$insert(c(1:10))
+
+ # Create a mock of seek_treatment:
+ seek_treatment_mock <- mockery::mock(seek_treatment)
+
+ # Specify that, when calculate_treated() calls sample_bitset(), return the seek_treatment_mock:
+ mockery::stub(where = calculate_treated, what = 'sample_bitset', how = seek_treatment_mock)
+
+ # Create a mock_drugs object (5 of each drug):
+ mock_drugs <- mockery::mock(c(2, 1, 1, 1, 2, 2, 2, 1, 2, 1))
+
+ # Specify that when calculate_treated() calls sample.int(), it returns mock_drugs:
+ mockery::stub(calculate_treated, 'sample.int', mock_drugs)
+
+ # Create a bernoulli_mock of i) individuals susceptible, and ii) individuals successfully treated:
+ bernoulli_mock <- mockery::mock(c(1, 2, 3, 4, 5, 6, 7, 8, 9),
+ c(1, 2, 3, 4, 5, 6, 7),
+ c(1))
+
+ # Specify that when calculate_treated() calls bernoulli_multi_p() it returns the bernoulli_mock:
+ local_mocked_bindings(bernoulli_multi_p = bernoulli_mock)
+
+ # Run the calculate_treated() function now the mocks and stubs are established:
+ calculate_treated(
+ variables,
+ clinical_infections,
+ parameters,
+ timestep,
+ mock_render(timestep)
+ )
+
+ # Check that mock_drugs was called only once, and that the arguments used in the function call
+ # mock_drugs() was used in (sample.int()) match those expected:
+ mockery::expect_args(
+ mock_drugs,
+ 1,
+ 2,
+ 10,
+ c(.25, .25),
+ TRUE
+ )
+
+ # Check that seek_treatment_mock was called only once, and that the arguments used in the function
+ # call mock_drugs() was used in (sample_bitset()) match those expected:
+ mockery::expect_args(
+ seek_treatment_mock,
+ 1,
+ clinical_infections,
+ 0.5
+ )
+
+ # Check that the first time bernoulli_mock was called the arguments used in the function
+ # call bernoulli_mock was involved in (bernoulli_multi_p()) match those expected:
+ mockery::expect_args(
+ bernoulli_mock,
+ 1,
+ parameters$drug_efficacy[c(2, 1, 1, 1, 2, 2, 2, 1, 2, 1)]
+ )
+
+ # Check that the secnd time bernoulli_mock was called (bernoulli_multi_p()) the arguments used in
+ # the function it was called in are as expected:
+ mockery::expect_args(
+ bernoulli_mock,
+ 2,
+ c(0.76, 1, 1, 1, 0.76, 0.76, 0.76, 1, 0.76)
+ )
+
+ # Check that update queued that updates the state of successfully treated individuals to "Tr"
+ expect_bitset_update(
+ variables$state$queue_update,
+ 'Tr',
+ c(1, 2, 3, 4, 5, 6, 7)
+ )
+
+ # Check that update queued that updates the infectivity of successfully treated individuals to "Tr"
+ # to their new infectivity (drug concentration x infectivity of "D" compartment)
+ expect_bitset_update(
+ variables$infectivity$queue_update,
+ parameters$cd * parameters$drug_rel_c[c(2, 1, 1, 1, 2, 2, 2)],
+ c(1, 2, 3, 4, 5, 6, 7)
+ )
+
+ # Check that update queued that updates the drug of successfully treated individuals to the drug
+ # they took:
+ expect_bitset_update(
+ variables$drug$queue_update,
+ c(2, 1, 1, 1, 2, 2, 2),
+ c(1, 2, 3, 4, 5, 6, 7)
+ )
+
+ # Check that update queued that updates the drug time of successfully treated individuals to the
+ # simulated/mocked time step (5)
+ expect_bitset_update(
+ variables$drug_time$queue_update,
+ 5,
+ c(1, 2, 3, 4, 5, 6, 7)
+ )
+
+ # Check that update queued for dt for the slow and non-slow parasite clearance individuals is correct:
+ expect_bitset_update(
+ variables$progression_rates$queue_update,
+ c(1/unlist(parameters$dt_slow_parasite_clearance), rep(1/parameters$dt, 6)),
+ c(1, 2, 3, 4, 5, 6, 7),
+ 1)
+
+})
+
test_that('schedule_infections correctly schedules new infections', {
parameters <- get_parameters(list(human_population = 20))
variables <- create_variables(parameters)
-
+
infections <- individual::Bitset$new(20)$insert(1:20)
clinical_infections <- individual::Bitset$new(20)$insert(5:15)
treated <- individual::Bitset$new(20)$insert(7:12)
-
+
infection_mock <- mockery::mock()
asymp_mock <- mockery::mock()
-
+
mockery::stub(schedule_infections, 'update_infection', infection_mock)
mockery::stub(schedule_infections, 'update_to_asymptomatic_infection', asymp_mock)
-
+
schedule_infections(
variables,
clinical_infections,
@@ -339,14 +659,14 @@ test_that('schedule_infections correctly schedules new infections', {
42
)
- actual_infected <- mockery::mock_args(infection_mock)[[1]][[5]]$to_vector()
+ actual_infected <- mockery::mock_args(infection_mock)[[1]][[7]]$to_vector()
actual_asymp_infected <- mockery::mock_args(asymp_mock)[[1]][[4]]$to_vector()
-
+
expect_equal(
actual_infected,
c(5, 6, 13, 14, 15)
)
-
+
expect_equal(
actual_asymp_infected,
c(1, 2, 3, 4, 16, 17, 18, 19, 20)
@@ -358,7 +678,7 @@ test_that('prophylaxis is considered for medicated humans', {
parameters <- set_drugs(parameters, list(AL_params, DHA_PQP_params))
events <- create_events(parameters)
timestep <- 50
-
+
variables = list(
state = individual::CategoricalVariable$new(
c('D', 'S', 'A', 'U', 'Tr'),
@@ -366,25 +686,34 @@ test_that('prophylaxis is considered for medicated humans', {
),
drug = individual::DoubleVariable$new(c(0, 2, 1, 0)),
drug_time = individual::DoubleVariable$new(c(-1, 49, 40, -1)),
- pev_timestep = individual::DoubleVariable$new(c(-1, -1, -1, -1)),
+ last_eff_pev_timestep = individual::DoubleVariable$new(c(-1, -1, -1, -1)),
pev_profile = individual::IntegerVariable$new(c(-1, -1, -1, -1)),
ib = individual::DoubleVariable$new(c(.2, .3, .5, .9))
)
-
+
bitten <- individual::Bitset$new(4)$insert(seq(4))
m <- mockery::mock(seq(3))
mockery::stub(calculate_infections, 'bernoulli_multi_p', m)
-
- calculate_infections(
+
+
+ infection_outcome <- CompetingOutcome$new(
+ targeted_process = function(timestep, target){
+ infection_outcome_process(timestep, target, variables, renderer, parameters)
+ },
+ size = 4
+ )
+
+ infection_rates <- calculate_infections(
variables,
bitten,
parameters,
mock_render(timestep),
- timestep
+ timestep,
+ infection_outcome
)
-
+
expect_equal(
- mockery::mock_args(m)[[1]][[1]],
+ rate_to_prob(infection_rates[infection_rates!=0]),
c(2.491951e-07, 2.384032e-01, 5.899334e-01),
tolerance = 1e-3
)
@@ -394,17 +723,17 @@ test_that('boost_immunity respects the delay period', {
level <- c(2.4, 1.2, 0., 4.)
immunity <- individual::DoubleVariable$new(level)
last_boosted <- individual::DoubleVariable$new(c(11, 5, 1, 13))
-
+
level_mock <- mockery::mock()
mockery::stub(boost_immunity, 'immunity_variable$queue_update', level_mock)
-
+
last_mock <- mockery::mock()
mockery::stub(boost_immunity, 'last_boosted_variable$queue_update', last_mock)
-
+
index <- individual::Bitset$new(4)$insert(seq(4))
timestep <- 15
delay <- 4
-
+
boost_immunity(
immunity,
index,
@@ -412,14 +741,14 @@ test_that('boost_immunity respects the delay period', {
timestep,
delay
)
-
+
mockery::expect_args(
level_mock,
1,
c(3.4, 2.2, 1),
seq(3)
)
-
+
mockery::expect_args(
last_mock,
1,
@@ -432,18 +761,18 @@ test_that('boost_immunity respects the delay period', {
level <- c(2.4, 1.2, 0., 4., 0.)
immunity <- individual::DoubleVariable$new(level)
last_boosted <- individual::DoubleVariable$new(c(11, 5, 1, 13, -1))
-
+
index <- individual::Bitset$new(5)
index$insert(seq(5))
timestep <- 15
delay <- 4
-
+
level_mock <- mockery::mock()
mockery::stub(boost_immunity, 'immunity_variable$queue_update', level_mock)
-
+
last_mock <- mockery::mock()
mockery::stub(boost_immunity, 'last_boosted_variable$queue_update', last_mock)
-
+
boost_immunity(
immunity,
index,
@@ -451,14 +780,14 @@ test_that('boost_immunity respects the delay period', {
timestep,
delay
)
-
+
mockery::expect_args(
level_mock,
1,
c(3.4, 2.2, 1, 1),
c(seq(3), 5)
)
-
+
mockery::expect_args(
last_mock,
1,
@@ -471,18 +800,18 @@ test_that('boost_immunity does not update when there is no-one to update', {
level <- c(2.4, 1.2, 0., 4., 0.)
immunity <- individual::DoubleVariable$new(level)
last_boosted <- individual::DoubleVariable$new(c(11, 5, 1, 13, -1))
-
+
index <- individual::Bitset$new(5)
index$insert(seq(5))
timestep <- 15
delay <- 4
-
+
level_mock <- mockery::mock()
mockery::stub(boost_immunity, 'immunity$queue_update', level_mock)
-
+
last_mock <- mockery::mock()
mockery::stub(boost_immunity, 'last_boosted$queue_update', last_mock)
-
+
boost_immunity(
immunity,
index,
@@ -504,11 +833,12 @@ test_that('update_severe_disease renders with no infections', {
severe_incidence_rendering_max_ages = 5 * 365
))
variables <- create_variables(parameters)
-
+
render_function <- mockery::mock()
mockery::stub(update_severe_disease, 'incidence_renderer', render_function)
+ mockery::stub(update_severe_disease, 'incidence_probability_renderer', render_function)
empty <- individual::Bitset$new(population)
-
+
update_severe_disease(
timestep,
empty,
@@ -523,6 +853,17 @@ test_that('update_severe_disease renders with no infections', {
variables$birth,
renderer,
empty,
+ 'inc_severe_',
+ 0,
+ 5 * 365,
+ timestep
+ )
+
+ mockery::expect_args(
+ render_function,
+ 2,
+ variables$birth,
+ renderer,
empty,
double(0),
'inc_severe_',
@@ -531,3 +872,199 @@ test_that('update_severe_disease renders with no infections', {
timestep
)
})
+
+test_that('calculate_treated returns empty Bitset when there is no clinical treatment coverage', {
+ parameters <- get_parameters()
+ parameters <- set_drugs(parameters = parameters, drugs = list(AL_params))
+ parameters <- set_clinical_treatment(parameters = parameters, drug = 1, timesteps = 1, coverages = 0)
+ parameters <- set_antimalarial_resistance(parameters = parameters,
+ drug = 1,
+ timesteps = 1,
+ artemisinin_resistance_proportion = 0.5,
+ partner_drug_resistance_proportion = 0,
+ slow_parasite_clearance_probability = 0,
+ early_treatment_failure_probability = 0.2,
+ late_clinical_failure_probability = 0,
+ late_parasitological_failure_probability = 0,
+ reinfection_during_prophylaxis_probability = 0,
+ slow_parasite_clearance_time = 10)
+ clinical_infections <- individual::Bitset$new(20)$insert(1:20)
+ timestep <- 5
+ events <- create_events(parameters)
+ variables <- list(
+ state = list(queue_update = mockery::mock()),
+ infectivity = list(queue_update = mockery::mock()),
+ drug = list(queue_update = mockery::mock()),
+ drug_time = list(queue_update = mockery::mock())
+ )
+ renderer <- individual::Render$new(timesteps = 10)
+
+ treated <- calculate_treated(variables = variables,
+ clinical_infections = clinical_infections,
+ parameters = parameters,
+ timestep = timestep,
+ renderer = renderer)
+
+ expect_identical(object = treated$size(), expected = 0, info = "Error: calculate_treated() returning non-zero number of treated individuals
+ in the absence of clinical treatment")
+})
+
+test_that('calculate_treated returns empty Bitset when the clinically_infected input is an empty Bitset', {
+ parameters <- get_parameters()
+ parameters <- set_drugs(parameters = parameters, drugs = list(AL_params))
+ parameters <- set_clinical_treatment(parameters = parameters, drug = 1, timesteps = 1, coverages = 1)
+ parameters <- set_antimalarial_resistance(parameters = parameters,
+ drug = 1,
+ timesteps = 1,
+ artemisinin_resistance_proportion = 0.5,
+ partner_drug_resistance_proportion = 0,
+ slow_parasite_clearance_probability = 0,
+ early_treatment_failure_probability = 0.2,
+ late_clinical_failure_probability = 0,
+ late_parasitological_failure_probability = 0,
+ reinfection_during_prophylaxis_probability = 0,
+ slow_parasite_clearance_time = 10)
+ clinical_infections <- individual::Bitset$new(20)
+ timestep <- 5
+ events <- create_events(parameters)
+ variables <- list(
+ state = list(queue_update = mockery::mock()),
+ infectivity = list(queue_update = mockery::mock()),
+ drug = list(queue_update = mockery::mock()),
+ drug_time = list(queue_update = mockery::mock())
+ )
+ renderer <- individual::Render$new(timesteps = 10)
+
+ treated <- calculate_treated(variables = variables,
+ clinical_infections = clinical_infections,
+ parameters = parameters,
+ timestep = timestep,
+ renderer = renderer)
+
+ expect_identical(object = treated$size(), expected = 0, info = "Error: calculate_treated() returning non-zero number of treated individuals
+ in the absence of clinically infected individuals")
+})
+
+test_that('calculate_treated() returns an empty Bitset when the parameter list contains no clinical
+ treatment or resistance parameters', {
+ parameters <- get_parameters()
+ clinical_infections <- individual::Bitset$new(20)$insert(1:20)
+ timestep <- 5
+ events <- create_events(parameters)
+ variables <- list(
+ state = list(queue_update = mockery::mock()),
+ infectivity = list(queue_update = mockery::mock()),
+ drug = list(queue_update = mockery::mock()),
+ drug_time = list(queue_update = mockery::mock())
+ )
+ renderer <- individual::Render$new(timesteps = 10)
+
+ treated <- calculate_treated(variables = variables,
+ clinical_infections = clinical_infections,
+ parameters = parameters,
+ timestep = timestep,
+ renderer = renderer)
+
+ expect_identical(object = treated$size(), expected = 0, info = "Error: calculate_treated() returning non-zero number of treated individuals
+ in the absence of clinical treatment or resistance parameters")
+})
+
+test_that('Number of treatment failures matches number of individuals treated when artemisinin resistance
+ proportion and early treatment failure probability both set to 1', {
+ parameters <- get_parameters()
+ parameters <- set_drugs(parameters = parameters, drugs = list(AL_params, SP_AQ_params))
+ parameters <- set_clinical_treatment(parameters = parameters,
+ drug = 1,
+ timesteps = 1,
+ coverages = round(runif(1, 0, 1/2),
+ digits = 2))
+ parameters <- set_clinical_treatment(parameters = parameters,
+ drug = 2,
+ timesteps = 1,
+ coverages = round(runif(1, 0, 1/2),
+ digits = 2))
+ parameters <- set_antimalarial_resistance(parameters = parameters,
+ drug = 1,
+ timesteps = 1,
+ artemisinin_resistance_proportion = 1,
+ partner_drug_resistance_proportion = 0,
+ slow_parasite_clearance_probability = 0,
+ early_treatment_failure_probability = 1,
+ late_clinical_failure_probability = 0,
+ late_parasitological_failure_probability = 0,
+ reinfection_during_prophylaxis_probability = 0,
+ slow_parasite_clearance_time = 10)
+ parameters <- set_antimalarial_resistance(parameters = parameters,
+ drug = 2,
+ timesteps = 1,
+ artemisinin_resistance_proportion = 1,
+ partner_drug_resistance_proportion = 0,
+ slow_parasite_clearance_probability = 0,
+ early_treatment_failure_probability = 1,
+ late_clinical_failure_probability = 0,
+ late_parasitological_failure_probability = 0,
+ reinfection_during_prophylaxis_probability = 0,
+ slow_parasite_clearance_time = 20)
+
+ clinical_infections <- individual::Bitset$new(100)
+ clinical_infections$insert(sample.int(n = 100, size = round(runif(n = 1, min = 10, max = 100)), replace = FALSE))
+ timestep <- 5
+ events <- create_events(parameters)
+ variables <- create_variables(parameters = parameters)
+ renderer <- individual::Render$new(timesteps = 10)
+
+ treated <- calculate_treated(variables = variables,
+ clinical_infections = clinical_infections,
+ parameters = parameters,
+ timestep = timestep,
+ renderer = renderer)
+
+ expect_identical(renderer$to_dataframe()[timestep,'n_early_treatment_failure'], renderer$to_dataframe()[timestep,'n_treated'] - renderer$to_dataframe()[timestep,'n_drug_efficacy_failures'], info = "Error: Number of
+ early treatment failures does not match number of treated individuals (minus drug efficacy failures) when artemisinin resistance proportion and
+ and early treatment failure probability both equal 1")
+})
+
+test_that('calculate_treated() successfully adds additional resistance columns to the renderer', {
+ parameters <- get_parameters()
+ parameters <- set_drugs(parameters = parameters, drugs = list(AL_params))
+ parameters <- set_clinical_treatment(parameters = parameters, drug = 1, timesteps = 1, coverages = 1)
+ parameters <- set_antimalarial_resistance(parameters = parameters,
+ drug = 1,
+ timesteps = 1,
+ artemisinin_resistance_proportion = 0.5,
+ partner_drug_resistance_proportion = 0,
+ slow_parasite_clearance_probability = 0,
+ early_treatment_failure_probability = 0.5,
+ late_clinical_failure_probability = 0,
+ late_parasitological_failure_probability = 0,
+ reinfection_during_prophylaxis_probability = 0,
+ slow_parasite_clearance_time = 10)
+
+ clinical_infections <- individual::Bitset$new(20)$insert(1:20)
+ timestep <- 5
+ events <- create_events(parameters)
+ variables <- list(
+ state = list(queue_update = mockery::mock()),
+ infectivity = list(queue_update = mockery::mock()),
+ progression_rates = list(queue_update = mockery::mock()),
+ drug = list(queue_update = mockery::mock()),
+ drug_time = list(queue_update = mockery::mock())
+ )
+ renderer <- individual::Render$new(timesteps = 10)
+
+ treated <- calculate_treated(variables = variables,
+ clinical_infections = clinical_infections,
+ parameters = parameters,
+ timestep = timestep,
+ renderer = renderer)
+
+ calculate_treated_column_names <- c("ft",
+ "n_treated",
+ "n_drug_efficacy_failures",
+ "n_early_treatment_failure",
+ "n_slow_parasite_clearance",
+ "n_successfully_treated")
+ expect_identical(sum(calculate_treated_column_names %in% colnames(renderer$to_dataframe())), length(calculate_treated_column_names),
+ "calculate_treated() not renderering all resistance columns when resistance is present, clinical treatment coverage
+ is non-zero, and the Bitset of clinically_infected individuals input is of non-zero length.")
+})
diff --git a/tests/testthat/test-mda.R b/tests/testthat/test-mda.R
index bf92ae3a..e2db7f67 100644
--- a/tests/testthat/test-mda.R
+++ b/tests/testthat/test-mda.R
@@ -76,16 +76,14 @@ test_that('MDA moves the diseased and non-diseased population correctly', {
),
birth = mock_double(-365 * c(2, 20, 5, 7)),
infectivity = mock_double(c(.1, .2, .3, .4)),
+ progression_rates = mock_double(c(.1, .2, .3, .4)),
id = mock_double(c(.1, .2, .3, .4)),
drug_time = mock_double(c(1, 2, 3, 4)),
drug = mock_double(c(1, 2, 1, 2))
)
- events$mda_administer <- mock_event(events$mda_administer)
-
listener <- create_mda_listeners(
variables,
- events$mda_administer,
parameters$mda_drug,
parameters$mda_timesteps,
parameters$mda_coverages,
@@ -97,15 +95,12 @@ test_that('MDA moves the diseased and non-diseased population correctly', {
renderer
)
- mockery::stub(listener, 'bernoulli', mockery::mock(c(TRUE, TRUE)))
mock_correlation <- mockery::mock(c(TRUE, TRUE))
mockery::stub(listener, 'sample_intervention', mock_correlation)
+ local_mocked_bindings(bernoulli_multi_p = mockery::mock(1:2))
+ local_mocked_bindings(calculate_asymptomatic_detectable = mockery::mock(individual::Bitset$new(4)$insert(3)))
+
listener(timestep)
- mockery::stub(
- listener,
- 'calculate_asymptomatic_detectable',
- mockery::mock(individual::Bitset$new(4)$insert(3))
- )
expect_equal(
mockery::mock_args(mock_correlation)[[1]][[1]],
@@ -126,8 +121,14 @@ test_that('MDA moves the diseased and non-diseased population correctly', {
expect_bitset_update(
variables$infectivity$queue_update_mock(),
- c(.3, .4) * SP_AQ_params[[2]],
- c(3, 4)
+ c(.3) * SP_AQ_params[[2]],
+ c(3)
+ )
+
+ expect_bitset_update(
+ variables$progression_rates$queue_update_mock(),
+ 1/parameters$dt,
+ c(3)
)
expect_bitset_update(
@@ -141,12 +142,6 @@ test_that('MDA moves the diseased and non-diseased population correctly', {
50,
c(3, 4)
)
-
- mockery::expect_args(
- events$mda_administer$schedule,
- 1,
- 100
- )
})
test_that('MDA moves the diseased and non-diseased population correctly - second round, varying age range', {
@@ -171,16 +166,14 @@ test_that('MDA moves the diseased and non-diseased population correctly - second
),
birth = mock_double(-365 * c(2, 20, 5, 7)),
infectivity = mock_double(c(.1, .2, .3, .4)),
+ progression_rates = mock_double(c(.1, .2, .3, .4)),
id = mock_double(c(.1, .2, .3, .4)),
drug_time = mock_double(c(1, 2, 3, 4)),
drug = mock_double(c(1, 2, 1, 2))
)
- events$mda_administer <- mock_event(events$mda_administer)
-
listener <- create_mda_listeners(
variables,
- events$mda_administer,
parameters$mda_drug,
parameters$mda_timesteps,
parameters$mda_coverages,
@@ -192,14 +185,11 @@ test_that('MDA moves the diseased and non-diseased population correctly - second
renderer
)
- mockery::stub(listener, 'bernoulli', mockery::mock(c(TRUE, TRUE, TRUE, TRUE)))
mock_correlation <- mockery::mock(c(TRUE, TRUE, TRUE, TRUE))
mockery::stub(listener, 'sample_intervention', mock_correlation)
- mockery::stub(
- listener,
- 'calculate_asymptomatic_detectable',
- mockery::mock(individual::Bitset$new(4)$insert(3))
- )
+ local_mocked_bindings(bernoulli_multi_p = mockery::mock(1:4))
+ local_mocked_bindings(calculate_asymptomatic_detectable = mockery::mock(individual::Bitset$new(4)$insert(3)))
+
listener(timestep)
expect_equal(
@@ -221,8 +211,28 @@ test_that('MDA moves the diseased and non-diseased population correctly - second
expect_bitset_update(
variables$infectivity$queue_update_mock(),
- c(.1, .2, .3, .4) * SP_AQ_params[[2]],
- c(1, 2, 3, 4)
+ c(.1, .3) * SP_AQ_params[[2]],
+ c(1, 3)
+ )
+
+ expect_bitset_update(
+ variables$infectivity$queue_update_mock(),
+ 0,
+ c(2, 4),
+ call = 2
+ )
+
+ expect_bitset_update(
+ variables$progression_rates$queue_update_mock(),
+ 1/parameters$dt,
+ c(1, 3)
+ )
+
+ expect_bitset_update(
+ variables$progression_rates$queue_update_mock(),
+ 0,
+ c(2, 4),
+ call = 2
)
expect_bitset_update(
@@ -260,16 +270,14 @@ test_that('MDA ignores non-detectable asymptomatics', {
),
birth = mock_double(-365 * c(2, 20, 5, 7)),
infectivity = mock_double(c(.1, .2, .3, .4)),
+ progression_rates = mock_double(c(.1, .2, .3, .4)),
id = mock_double(c(.1, .2, .3, .4)),
drug_time = mock_double(c(1, 2, 3, 4)),
drug = mock_double(c(1, 2, 1, 2))
)
- events$mda_administer <- mock_event(events$mda_administer)
-
listener <- create_mda_listeners(
variables,
- events$mda_administer,
parameters$mda_drug,
parameters$mda_timesteps,
parameters$mda_coverages,
@@ -281,14 +289,10 @@ test_that('MDA ignores non-detectable asymptomatics', {
renderer
)
- mockery::stub(listener, 'bernoulli', mockery::mock(c(TRUE, TRUE, TRUE, TRUE)))
mock_correlation <- mockery::mock(c(TRUE, TRUE, TRUE, TRUE))
mockery::stub(listener, 'sample_intervention', mock_correlation)
- mockery::stub(
- listener,
- 'calculate_asymptomatic_detectable',
- mockery::mock(individual::Bitset$new(4))
- )
+ local_mocked_bindings(calculate_asymptomatic_detectable = mockery::mock(individual::Bitset$new(4)))
+
listener(timestep)
expect_bitset_update(
@@ -306,8 +310,28 @@ test_that('MDA ignores non-detectable asymptomatics', {
expect_bitset_update(
variables$infectivity$queue_update_mock(),
- c(.1, .2, .3, .4) * SP_AQ_params[[2]],
- c(1, 2, 3, 4)
+ c(.1) * SP_AQ_params[[2]],
+ c(1)
+ )
+
+ expect_bitset_update(
+ variables$infectivity$queue_update_mock(),
+ 0,
+ c(2, 3, 4),
+ call = 2
+ )
+
+ expect_bitset_update(
+ variables$progression_rates$queue_update_mock(),
+ 1/parameters$dt,
+ c(1)
+ )
+
+ expect_bitset_update(
+ variables$progression_rates$queue_update_mock(),
+ 0,
+ c(2, 3, 4),
+ call = 2
)
expect_bitset_update(
diff --git a/tests/testthat/test-mixing-integration.R b/tests/testthat/test-mixing-integration.R
new file mode 100644
index 00000000..2710e710
--- /dev/null
+++ b/tests/testthat/test-mixing-integration.R
@@ -0,0 +1,234 @@
+test_that('simulate_bites works with mixed populations', {
+ population <- 4
+ timestep <- 5
+ renderer <- individual::Render$new(5)
+ parameters <- get_parameters(
+ list(human_population = population)
+ )
+ events <- create_events(parameters)
+ variables <- create_variables(parameters)
+
+ mock_foim <- mockery::mock(1)
+ mock_a <- mockery::mock(1/3)
+ mixed_transmission <- list(
+ eir = matrix(c(.2, .8), nrow=1, ncol=2),
+ inf = c(.2, .8)
+ )
+ mock_mixing <- mockery::mock(mixed_transmission, cycle=TRUE)
+
+ mockery::stub(simulate_bites, '.human_blood_meal_rate', mock_a)
+ mockery::stub(simulate_bites, 'calculate_foim', mock_foim)
+ models <- parameterise_mosquito_models(parameters)
+ solvers <- parameterise_solvers(models, parameters)
+ lagged_foim <- LaggedValue$new(12.5, .001)
+ lagged_eir <- list(LaggedValue$new(12, 10))
+ age <- c(20, 24, 5, 39) * 365
+ bitten <- simulate_bites(
+ renderer,
+ solvers,
+ models,
+ variables,
+ events,
+ age,
+ parameters,
+ timestep,
+ lagged_foim,
+ lagged_eir,
+ mock_mixing,
+ 1
+ )
+
+ mockery::expect_args(mock_mixing, 1, timestep)
+ mockery::expect_args(mock_foim, 1, 1/3, .2)
+})
+
+test_that('mixing_fn can return isolated transmission for multiple species', {
+ population <- 4
+ timestep <- 5
+ renderer <- individual::Render$new(5)
+ parameters <- get_parameters(
+ list(human_population = population)
+ )
+ parameters <- set_species(
+ parameters,
+ list(arab_params, fun_params, gamb_params),
+ rep(1/3, 3)
+ )
+ events <- create_events(parameters)
+ variables <- create_variables(parameters)
+ lagged_infectivity <- list(LaggedValue$new(12.5, .1), LaggedValue$new(12.5, .2))
+ lagged_eir <- list(
+ list(LaggedValue$new(12, 10), LaggedValue$new(12, 10), LaggedValue$new(12, 10)),
+ list(LaggedValue$new(12, 20), LaggedValue$new(12, 20), LaggedValue$new(12, 20))
+ )
+
+ mock_rdt <- mockery::mock(.5, cycle = TRUE) # 50%
+
+ mixing_fn <- create_transmission_mixer(
+ list(variables, variables),
+ list(parameters, parameters),
+ lagged_eir,
+ lagged_infectivity,
+ mixing_tt = 1,
+ export_mixing = list(diag(nrow=2)),
+ import_mixing = list(diag(nrow=2)),
+ p_captured_tt = 1,
+ p_captured = list(1 - diag(nrow=2)), # full coverage
+ p_success = 1
+ )
+
+ mockery::stub(mixing_fn, 'rdt_detectable', mock_rdt)
+
+ transmission <- mixing_fn(timestep)
+ expect_equal(
+ transmission,
+ list(
+ eir = t(matrix(c(rep(10, 3), rep(20, 3)), nrow=3, ncol=2)),
+ inf = c(.1, .2)
+ )
+ )
+})
+
+test_that('mixing_fn can return asymmetric transmission', {
+ population <- 4
+ timestep <- 5
+ renderer <- individual::Render$new(5)
+ parameters <- get_parameters(
+ list(human_population = population)
+ )
+ events <- create_events(parameters)
+ variables <- create_variables(parameters)
+ lagged_infectivity <- list(
+ LaggedValue$new(12.5, .1), # location 1
+ LaggedValue$new(12.5, .2) # location 2
+ )
+
+ lagged_eir <- list(
+ list(LaggedValue$new(12, 10)), # location 1
+ list(LaggedValue$new(12, 20)) # location 2
+ )
+
+ mock_rdt <- mockery::mock(.5, cycle = TRUE) # 50%
+
+ mixing_fn <- create_transmission_mixer(
+ list(variables, variables),
+ list(parameters, parameters),
+ lagged_eir,
+ lagged_infectivity,
+ mixing_tt = 1,
+ export_mixing = list(diag(nrow=2)),
+ import_mixing = list(matrix(.5, nrow=2, ncol=2)),
+ p_captured_tt = 1,
+ p_captured = list(matrix(0, nrow=2, ncol=2)), # no coverage
+ p_success = 1
+ )
+
+ mockery::stub(mixing_fn, 'rdt_detectable', mock_rdt)
+
+ transmission <- mixing_fn(timestep)
+ expect_equal(
+ transmission,
+ list(
+ eir = matrix(c(15, 15), nrow=2, ncol=1),
+ inf = c(.1, .2)
+ )
+ )
+})
+
+
+
+
+test_that('mixing_fn can halve the mixed transmission for 50% rdt detection', {
+ population <- 4
+ timestep <- 5
+ renderer <- individual::Render$new(5)
+ parameters <- get_parameters(
+ list(human_population = population)
+ )
+ events <- create_events(parameters)
+ variables <- create_variables(parameters)
+ lagged_infectivity <- list(LaggedValue$new(12.5, .1), LaggedValue$new(12.5, .2))
+ lagged_eir <- list(list(LaggedValue$new(12, 10)), list(LaggedValue$new(12, 20)))
+
+ mock_rdt <- mockery::mock(.5, cycle = TRUE) # 50%
+
+
+ mixing_fn <- create_transmission_mixer(
+ list(variables, variables),
+ list(parameters, parameters),
+ lagged_eir,
+ lagged_infectivity,
+ mixing_tt = 1,
+ export_mixing = list(matrix(rep(.5, 4), nrow=2, ncol=2)),
+ import_mixing = list(matrix(rep(.5, 4), nrow=2, ncol=2)),
+ p_captured_tt = 1,
+ p_captured = list(1 - diag(nrow=2)), # full coverage
+ p_success = 1
+ )
+
+ mockery::stub(mixing_fn, 'rdt_detectable', mock_rdt)
+
+ transmission <- mixing_fn(timestep)
+ expect_equal(
+ transmission,
+ list(
+ eir = matrix(c(10, 12.5), nrow=2, ncol=1),
+ inf = c(.075, .150)
+ )
+ )
+})
+
+test_that('rdt_detectable adjusts correctly with identity parameters', {
+ population <- 4
+ parameters <- get_parameters(
+ list(human_population = population, rdt_intercept = 0, rdt_coeff = 1)
+ )
+ variables <- list(state = individual::CategoricalVariable$new(
+ c('S', 'Tr', 'D', 'A', 'U'),
+ c('S', 'Tr', 'A', 'U')
+ ))
+
+ rdt_prev <- rdt_detectable(variables, parameters, 1)
+
+ expect_equal(rdt_prev, 0.5)
+})
+
+test_that('mixing_fn can completely remove mixed transmission', {
+ population <- 4
+ timestep <- 5
+ renderer <- individual::Render$new(5)
+ parameters <- get_parameters(
+ list(human_population = population, rdt_intercept = 0, rdt_coeff = 1)
+ )
+ events <- create_events(parameters)
+ variables <- create_variables(parameters)
+ lagged_infectivity <- list(LaggedValue$new(12.5, .1), LaggedValue$new(12.5, .2))
+ lagged_eir <- list(list(LaggedValue$new(12, 10)), list(LaggedValue$new(12, 20)))
+
+ mock_rdt <- mockery::mock(1., cycle = TRUE)
+
+ mixing_fn <- create_transmission_mixer(
+ list(variables, variables),
+ list(parameters, parameters),
+ lagged_eir,
+ lagged_infectivity,
+ mixing_tt = 1,
+ export_mixing = list(matrix(rep(.5, 4), nrow=2, ncol=2)),
+ import_mixing = list(matrix(rep(.5, 4), nrow=2, ncol=2)),
+ p_captured_tt = 1,
+ p_captured = list(1 - diag(nrow=2)), # full coverage
+ p_success = 1
+ )
+
+ mockery::stub(mixing_fn, 'rdt_detectable', mock_rdt)
+
+ transmission <- mixing_fn(timestep)
+ expect_equal(
+ transmission,
+ list(
+ eir = matrix(c(5, 10), nrow=2, ncol=1),
+ inf = c(.05, .1)
+ )
+ )
+})
+
diff --git a/tests/testthat/test-output.R b/tests/testthat/test-output.R
new file mode 100644
index 00000000..5cef37b9
--- /dev/null
+++ b/tests/testthat/test-output.R
@@ -0,0 +1,33 @@
+test_that('Test age parameter function works', {
+ parameters <- get_parameters()
+ age_limits <- c(0,1,2,3)*365
+ parameters <- set_epi_outputs(parameters,
+ age_group = age_limits,
+ incidence = age_limits+1,
+ clinical_incidence = age_limits+2,
+ severe_incidence = age_limits+3,
+ prevalence = age_limits+4,
+ ica = age_limits+5,
+ icm = age_limits+6,
+ id = age_limits+7,
+ ib = age_limits+8,
+ iva = age_limits+9,
+ ivm = age_limits+10
+ )
+
+ sim <- run_simulation(timesteps = 1, parameters)
+
+ prefixes <- c("n_age",
+ "n_inc", "p_inc",
+ "n_inc_clinical","p_inc_clinical",
+ "n_inc_severe","p_inc_severe",
+ "n_detect_lm","p_detect_lm","n_detect_pcr",
+ "ica_mean", "icm_mean","id_mean","ib_mean","iva_mean","ivm_mean")
+ offsets <- c(0, rep(1, 2), rep(2, 2), rep(3, 2), rep(4, 3), 5:10)
+ expect_equal(length(prefixes), length(offsets))
+
+ expected <- paste0(rep(prefixes, each = 3),
+ "_", age_limits[-4]+rep(offsets, each = 3),
+ "_", age_limits[-1]-1+rep(offsets, each = 3))
+ expect_in(expected, names(sim))
+})
diff --git a/tests/testthat/test-pev-epi.R b/tests/testthat/test-pev-epi.R
index 4eea8445..6555700c 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,30 +43,53 @@ 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('pev epi fails pre-emptively with unaligned booster parameters', {
+test_that('set_pev_epi checks booster coverage matrix shape', {
parameters <- get_parameters()
expect_error(
- set_pev_epi(
+ 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(18, 36) * 30,
+ booster_coverage = matrix(c(.9, .8), nrow=2, ncol=1),
+ booster_profile = list(rtss_booster_profile, rtss_booster_profile)
+ ),
+ 'booster_spacing, booster_coverage and booster_profile do not align',
+ fixed = TRUE
+ )
+})
+
+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_timestep = c(18, 36) * 30,
- booster_coverage = .9,
+ 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))
@@ -77,8 +100,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)
@@ -86,51 +109,120 @@ test_that('pev epi targets correct age and respects min_wait', {
variables$birth <- individual::IntegerVariable$new(
-c(18, 18, 2.9, 18, 18) * 365 + timestep
)
- variables$pev_timestep <- mock_integer(
+ variables$last_pev_timestep <- mock_integer(
c(50, -1, -1, 4*365, -1)
)
+ variables$pev_profile <- mock_integer(
+ c(1, -1, -1, 1, -1)
+ )
- events$pev_epi_doses <- lapply(events$pev_epi_doses, mock_event)
-
+ correlations <- get_correlation_parameters(parameters)
process <- create_epi_pev_process(
variables,
events,
parameters,
- get_correlation_parameters(parameters),
+ correlations,
parameters$pev_epi_coverages,
parameters$pev_epi_timesteps
)
+ sample_mock <- mockery::mock(c(TRUE, TRUE, FALSE))
mockery::stub(
process,
'sample_intervention',
- mockery::mock(c(TRUE, TRUE, FALSE))
+ sample_mock
)
process(timestep)
mockery::expect_args(
- events$pev_epi_doses[[1]]$schedule,
+ sample_mock,
1,
- c(1, 2),
- parameters$pev_doses[[1]]
+ c(1, 2, 5),
+ 'pev',
+ .8,
+ correlations
)
mockery::expect_args(
- events$pev_epi_doses[[2]]$schedule,
+ variables$last_pev_timestep$queue_update_mock(),
1,
- c(1, 2),
- parameters$pev_doses[[2]]
+ timestep,
+ c(1, 2)
)
+})
+
+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_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(
+ parameters,
+ profile = rtss_profile,
+ timesteps = 10,
+ coverages = 0.8,
+ min_wait = 0,
+ age = 18 * 365,
+ 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)
+ 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(
- events$pev_epi_doses[[3]]$schedule,
+ sample_mock,
1,
- c(1, 2),
- parameters$pev_doses[[3]]
+ 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))
@@ -141,8 +233,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
)
@@ -177,8 +269,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 5cb09c5d..f3c3d793 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,14 +46,54 @@ 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('set_mass_pev checks booster coverage matrix shape', {
+ 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(18, 36) * 30,
+ booster_coverage = matrix(c(.9, .8), nrow=2, ncol=1),
+ booster_profile = list(rtss_booster_profile, rtss_booster_profile)
+ ),
+ 'booster_spacing, booster_coverage and booster_profile do not align',
+ fixed = TRUE
+ )
+})
+
+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(
@@ -65,8 +105,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)
)
)
@@ -83,8 +123,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)
@@ -97,7 +137,7 @@ test_that('Infection considers pev efficacy', {
variables$birth <- individual::IntegerVariable$new(
-c(8, 2.9, 3.2, 18.4) * 365 - 100
)
- variables$pev_timestep <- individual::IntegerVariable$new(
+ variables$last_eff_pev_timestep <- individual::IntegerVariable$new(
c(-1, -1, 50, 50 + 30)
)
variables$pev_profile <- individual::IntegerVariable$new(
@@ -110,6 +150,13 @@ test_that('Infection considers pev efficacy', {
rep(.2, 4)
)
+ infection_outcome <- CompetingOutcome$new(
+ targeted_process = function(timestep, target){
+ infection_process_resolved_hazard(timestep, target, variables, renderer, parameters)
+ },
+ size = 4
+ )
+
# remove randomness from infection sampling
bernoulli_mock <- mockery::mock(c(1, 2))
mockery::stub(calculate_infections, 'bernoulli_multi_p', bernoulli_mock)
@@ -124,16 +171,17 @@ test_that('Infection considers pev efficacy', {
depth = 4
)
- calculate_infections(
+ infection_rates <- calculate_infections(
variables = variables,
bitten_humans = individual::Bitset$new(4)$insert(seq(4)),
parameters = parameters,
renderer = mock_render(timestep),
- timestep = timestep
+ timestep = timestep,
+ infection_outcome = infection_outcome
)
expect_equal(
- mockery::mock_args(bernoulli_mock)[[1]][[1]],
+ rate_to_prob(infection_rates[infection_rates!=0]),
c(0.590, 0.590, 0.215, 0.244),
tolerance=1e-3
)
@@ -150,8 +198,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)
@@ -163,7 +211,6 @@ test_that('Mass vaccinations update vaccination time', {
c(-1, -1, -1, 50, 50)
)
- events$mass_pev <- mock_event(events$mass_pev)
events$mass_pev_doses <- lapply(events$mass_pev_doses, mock_event)
listener <- create_mass_pev_listener(
@@ -201,14 +248,76 @@ test_that('Mass vaccinations update vaccination time', {
c(1, 3),
parameters$pev_doses[[3]]
)
+})
+
+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_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(
+ parameters,
+ profile = rtss_profile,
+ timesteps = 10,
+ coverages = 0.8,
+ min_wait = 2*365,
+ age = 18 * 365,
+ 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)
+ 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(
- events$mass_pev$schedule,
+ sample_mock,
1,
- 365
+ c(3, 4, 5),
+ 'pev',
+ .8,
+ correlations
)
})
+
test_that('Mass boosters update profile params and reschedule correctly', {
parameters <- get_parameters()
parameters <- set_mass_pev(
@@ -219,8 +328,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)
@@ -231,7 +340,10 @@ test_that('Mass boosters update profile params and reschedule correctly', {
variables$birth <- individual::IntegerVariable$new(
-c(2.9, 3.2, 18.4) * 365 + 100
)
- variables$pev_timestep <- mock_double(
+ variables$last_pev_timestep <- mock_double(
+ c(50, 50, 50)
+ )
+ variables$last_eff_pev_timestep <- mock_double(
c(50, 50, 50)
)
variables$pev_profile <- mock_integer(
@@ -241,7 +353,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]],
@@ -258,7 +371,13 @@ test_that('Mass boosters update profile params and reschedule correctly', {
listener(timestep, individual::Bitset$new(3)$insert(c(1, 2, 3)))
expect_bitset_update(
- variables$pev_timestep$queue_update_mock(),
+ variables$last_pev_timestep$queue_update_mock(),
+ timestep,
+ c(1, 2, 3)
+ )
+
+ expect_bitset_update(
+ variables$last_eff_pev_timestep$queue_update_mock(),
timestep,
c(1, 2, 3)
)
@@ -286,8 +405,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)
)
@@ -300,7 +419,10 @@ test_that('Mass booster coverages sample subpopulations correctly', {
variables$birth <- individual::IntegerVariable$new(
-c(2.9, 3.2, 18.4) * 365 + 100
)
- variables$pev_timestep <- mock_double(
+ variables$last_pev_timestep <- mock_double(
+ c(50, 50, 50)
+ )
+ variables$last_eff_pev_timestep <- mock_double(
c(50, 50, 50)
)
variables$pev_profile <- mock_integer(
@@ -309,7 +431,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]],
@@ -327,7 +450,13 @@ test_that('Mass booster coverages sample subpopulations correctly', {
mockery::expect_args(sample_mock, 1, target, .9)
expect_bitset_update(
- variables$pev_timestep$queue_update_mock(),
+ variables$last_pev_timestep$queue_update_mock(),
+ timestep,
+ c(2, 3)
+ )
+
+ expect_bitset_update(
+ variables$last_eff_pev_timestep$queue_update_mock(),
timestep,
c(2, 3)
)
@@ -345,6 +474,68 @@ test_that('Mass booster coverages sample subpopulations correctly', {
)
})
+test_that('mass pev targets correct age and respects min_wait', {
+ timestep <- 5*365
+ parameters <- get_parameters(list(human_population = 5))
+ parameters <- set_mass_pev(
+ parameters,
+ profile = rtss_profile,
+ timesteps = c(4, 5) * 365,
+ coverages = c(0.8, 0.8),
+ min_ages = 0,
+ max_ages = 19 * 365,
+ min_wait = 2*365,
+ 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)
+ variables <- create_variables(parameters)
+ variables$birth <- individual::IntegerVariable$new(
+ -c(18, 18, 30, 18, 18) * 365 + timestep
+ )
+ variables$last_pev_timestep <- mock_integer(
+ c(50, -1, -1, 4*365, -1)
+ )
+
+ variables$pev_profile <- mock_integer(
+ c(1, -1, -1, 1, -1)
+ )
+
+ correlations <- get_correlation_parameters(parameters)
+ listener <- create_mass_pev_listener(
+ variables,
+ events,
+ parameters,
+ get_correlation_parameters(parameters)
+ )
+
+ sample_mock <- mockery::mock(c(TRUE, TRUE, FALSE))
+ mockery::stub(
+ listener,
+ 'sample_intervention',
+ sample_mock
+ )
+
+ listener(timestep)
+
+ mockery::expect_args(
+ sample_mock,
+ 1,
+ c(1, 2, 5),
+ 'pev',
+ .8,
+ correlations
+ )
+
+ mockery::expect_args(
+ variables$last_pev_timestep$queue_update_mock(),
+ 1,
+ timestep,
+ c(1, 2)
+ )
+})
+
test_that('Mass efficacy listener works correctly', {
timestep <- 50
parameters <- get_parameters()
@@ -356,13 +547,13 @@ 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)
)
variables <- create_variables(parameters)
- variables$pev_timestep <- mock_integer(c(-1, -1, -1))
+ variables$last_eff_pev_timestep <- mock_integer(c(-1, -1, -1))
variables$pev_profile <- mock_integer(c(-1, -1, -1))
listener <- create_pev_efficacy_listener(variables, 1)
@@ -370,7 +561,7 @@ test_that('Mass efficacy listener works correctly', {
# vaccinated time
expect_bitset_update(
- variables$pev_timestep$queue_update_mock(),
+ variables$last_eff_pev_timestep$queue_update_mock(),
timestep,
c(1, 2, 3)
)
@@ -394,8 +585,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)
)
@@ -405,9 +596,10 @@ 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,
pev_profile_indices = parameters$mass_pev_profile_indices,
strategy = 'mass',
@@ -429,8 +621,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
)
})
@@ -464,4 +656,101 @@ test_that('Efficacies are calculated correctly', {
)
})
+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(
+ parameters,
+ profile = rtss_profile,
+ timesteps = 10,
+ coverages = 0.8,
+ min_wait = 6 * 30,
+ age = 18 * 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)
+ booster_event <- mock_event(events$pev_epi_boosters[[1]])
+
+ listener <- create_pev_booster_listener(
+ variables = create_variables(parameters),
+ 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,
+ 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 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 = c(10, 30),
+ coverages = c(0.8, 0.4),
+ min_wait = 6 * 30,
+ age = 18 * 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)
+
+ booster_event <- mock_event(events$pev_epi_boosters[[1]])
+
+ listener <- create_pev_booster_listener(
+ variables = create_variables(parameters),
+ 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,
+ 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
+ )
+})
diff --git a/tests/testthat/test-pmc.R b/tests/testthat/test-pmc.R
index ff7e8c56..8622f16f 100644
--- a/tests/testthat/test-pmc.R
+++ b/tests/testthat/test-pmc.R
@@ -45,7 +45,6 @@ test_that("pmc parameterisation works", {
expect_equal(p$pmc_drug, 1)
})
-
test_that("pmc gives drugs to correct ages", {
p <- get_parameters(list(human_population = 6))
@@ -74,6 +73,8 @@ test_that("pmc gives drugs to correct ages", {
variables$drug <- mock_integer(rep(0, 6))
variables$drug_time <- mock_integer(rep(-1, 6))
mockery::stub(sample_intervention, 'bernoulli', mockery::mock(c(TRUE, TRUE, TRUE)))
+ local_mocked_bindings(bernoulli_multi_p = mockery::mock(1:3))
+ local_mocked_bindings(calculate_asymptomatic_detectable = mockery::mock(individual::Bitset$new(6)$insert(3)))
process <- create_pmc_process(
variables = variables,
@@ -85,14 +86,15 @@ test_that("pmc gives drugs to correct ages", {
timesteps = p$pmc_timesteps,
drug = p$pmc_drug
)
- # mock the treatment success
- mockery::stub(process, 'bernoulli', mockery::mock(c(TRUE, TRUE, TRUE)))
+
process(timestep)
# Three treatments given
expect_equal(renderer$to_dataframe(),
data.frame(timestep = 1:10,
- n_pmc_treated = c(rep(0, 9), 3)))
+ n_pmc_treated = c(rep(0, 9), 3),
+ n_pmc_drug_efficacy_failures = c(rep(0, 10)),
+ n_pmc_successfully_treated = c(rep(0, 9), 3)))
# Individuals 3 and 5, are correct age and in D or A states
expect_bitset_update(
diff --git a/tests/testthat/test-process-integration.R b/tests/testthat/test-process-integration.R
index f259be5e..1b07f127 100644
--- a/tests/testthat/test-process-integration.R
+++ b/tests/testthat/test-process-integration.R
@@ -19,6 +19,28 @@ test_that('create_processes makes valid process functions', {
}
})
+test_that('create_processes makes valid process functions when progress bar specified', {
+ parameters <- get_parameters()
+ parameters$progress_bar <- TRUE
+ events <- create_events(parameters)
+ variables <- create_variables(parameters)
+ vector_models <- parameterise_mosquito_models(parameters, 1)
+ solvers <- parameterise_solvers(vector_models, parameters)
+ renderer <- individual::Render$new(1)
+ processes <- create_processes(
+ renderer,
+ variables,
+ events,
+ parameters,
+ vector_models,
+ solvers,
+ timesteps = 100
+ )
+ for (process in processes) {
+ expect(is.function(process) || inherits(process, 'externalptr'), 'Process is not a function')
+ }
+})
+
test_that('attach_event_listeners makes valid listeners', {
parameters <- get_parameters()
events <- create_events(parameters)
diff --git a/tests/testthat/test-processes.R b/tests/testthat/test-processes.R
new file mode 100644
index 00000000..d997dcd8
--- /dev/null
+++ b/tests/testthat/test-processes.R
@@ -0,0 +1,23 @@
+test_that("exponential_decay_process works as expected", {
+ # This rate gives a halving at every timestep
+ rate <- -1 / log(0.5)
+
+ v <- individual::DoubleVariable$new(c(0,0.5,1,2,4,10))
+ p <- create_exponential_decay_process(v, rate)
+
+ individual:::execute_process(p, 1)
+ v$.update()
+
+ expect_equal(v$get_values(), c(0, 0.25, 0.5, 1, 2, 5))
+
+ individual:::execute_process(p, 2)
+ v$.update()
+
+ expect_equal(v$get_values(), c(0, 0.125, 0.25, 0.5, 1, 2.5))
+})
+
+test_that("exponential_decay_process fails on IntegerVariable", {
+ rate <- -1 / log(0.5)
+ v <- individual::IntegerVariable$new(c(0,1,2,3))
+ expect_error(create_exponential_decay_process(v, rate))
+})
diff --git a/tests/testthat/test-render.R b/tests/testthat/test-render.R
index 920f09bb..6396d4ca 100644
--- a/tests/testthat/test-render.R
+++ b/tests/testthat/test-render.R
@@ -11,7 +11,7 @@ test_that('that default rendering works', {
immunity <- individual::DoubleVariable$new(rep(1, 4))
renderer <- mock_render(1)
- process <- create_prevelance_renderer(
+ process <- create_prevalence_renderer(
state,
birth,
immunity,
@@ -26,27 +26,27 @@ test_that('that default rendering works', {
mockery::expect_args(
renderer$render_mock(),
1,
- 'n_730_3650',
- 3,
+ 'n_detect_lm_730_3650',
+ 2,
timestep
)
-
+
mockery::expect_args(
renderer$render_mock(),
2,
- 'n_detect_730_3650',
- 2,
+ 'p_detect_lm_730_3650',
+ 1.5,
timestep
)
mockery::expect_args(
renderer$render_mock(),
3,
- 'p_detect_730_3650',
- 1.5,
+ 'n_detect_pcr_730_3650',
+ 3,
timestep
)
-
+
})
test_that('that default rendering works when no one is in the age range', {
@@ -62,7 +62,7 @@ test_that('that default rendering works when no one is in the age range', {
immunity <- individual::DoubleVariable$new(rep(1, 4))
renderer <- mock_render(1)
- process <- create_prevelance_renderer(
+ process <- create_prevalence_renderer(
state,
birth,
immunity,
@@ -75,7 +75,7 @@ test_that('that default rendering works when no one is in the age range', {
mockery::expect_args(
renderer$render_mock(),
1,
- 'n_730_3650',
+ 'n_detect_lm_730_3650',
0,
timestep
)
@@ -93,6 +93,15 @@ test_that('that clinical incidence rendering works', {
birth,
renderer,
individual::Bitset$new(4)$insert(c(1, 2, 4)),
+ 'inc_clinical_',
+ c(0, 2) * year,
+ c(5, 10) * year,
+ timestep
+ )
+
+ incidence_probability_renderer(
+ birth,
+ renderer,
individual::Bitset$new(4)$insert(seq(4)),
c(.1, .2, .3, .4),
'inc_clinical_',
@@ -104,7 +113,7 @@ test_that('that clinical incidence rendering works', {
mockery::expect_args(
renderer$render_mock(),
1,
- 'n_0_1825',
+ 'n_inc_clinical_0_1825',
2,
timestep
)
@@ -112,7 +121,7 @@ test_that('that clinical incidence rendering works', {
mockery::expect_args(
renderer$render_mock(),
2,
- 'n_inc_clinical_0_1825',
+ 'n_inc_clinical_730_3650',
2,
timestep
)
@@ -124,11 +133,68 @@ test_that('that clinical incidence rendering works', {
.3,
timestep
)
+
+ mockery::expect_args(
+ renderer$render_mock(),
+ 4,
+ 'p_inc_clinical_730_3650',
+ .6,
+ timestep
+ )
+})
+
+test_that('that age rendering works', {
+ timestep <- 0
+ year <- 365
+ birth <- individual::IntegerVariable$new(
+ -c(0:101) * year
+ )
+
+ parameters <- get_parameters(overrides = list(prevalence_rendering_min_ages = c(0, 1, 5) * year,
+ prevalence_rendering_max_ages = c(2, 5, 8) * year - 1,
+ incidence_rendering_min_ages = c(3, 5, 10) * year,
+ incidence_rendering_max_ages = c(10, 20, 100) * year - 1,
+ clinical_incidence_rendering_min_ages = c(0, 1, 5) * year,
+ clinical_incidence_rendering_max_ages = c(2, 5, 8) * year - 1))
+
+ renderer <- mock_render(1)
+ process <- create_age_group_renderer(
+ birth,
+ parameters,
+ renderer)
+
+ process(timestep)
+
+
mockery::expect_args(
renderer$render_mock(),
+ 1,
+ 'n_age_0_729',
+ 2,
+ timestep
+ )
+
+ mockery::expect_args(
+ renderer$render_mock(),
+ 2,
+ 'n_age_365_1824',
4,
- 'n_730_3650',
+ timestep
+ )
+
+ mockery::expect_args(
+ renderer$render_mock(),
+ 3,
+ 'n_age_1095_3649',
+ 7,
+ timestep
+ )
+
+ mockery::expect_args(
+ renderer$render_mock(),
+ 4,
+ 'n_age_1825_2919',
3,
timestep
)
@@ -136,16 +202,16 @@ test_that('that clinical incidence rendering works', {
mockery::expect_args(
renderer$render_mock(),
5,
- 'n_inc_clinical_730_3650',
- 2,
+ 'n_age_1825_7299',
+ 15,
timestep
)
mockery::expect_args(
renderer$render_mock(),
6,
- 'p_inc_clinical_730_3650',
- .6,
+ 'n_age_3650_36499',
+ 90,
timestep
)
})
diff --git a/tests/testthat/test-resume.R b/tests/testthat/test-resume.R
new file mode 100644
index 00000000..954fd063
--- /dev/null
+++ b/tests/testthat/test-resume.R
@@ -0,0 +1,303 @@
+#' Test simulation saving and restoring for a given parameter set.
+#'
+#' This function runs the simulation twice. A first, continuous and uninterrupted
+#' run of the simulation is used as a reference. The second run is split into
+#' two phases. Between the two phases, the simulation state is saved and
+#' restored. Optionally, the initial warmup phase can use a different set of
+#' parameters, by specifying a value for warmup_parameters.
+test_resume <- function(
+ parameters,
+ timesteps = 200,
+ warmup_parameters = parameters,
+ warmup_timesteps = 50
+ ) {
+
+ # This function is only used with null correlations. However a null
+ # correlation involves sampling random numbers during initialization, which
+ # disrupts the global RNG and affects the reproducibility if the size of the
+ # matrix is not always the same.
+ #
+ # We use a single correlation object, that we initialize eagerly, such that
+ # the simulation can run undisturbed.
+ correlations <- get_correlation_parameters(parameters)
+ correlations$mvnorm()
+
+ set.seed(123)
+ uninterrupted_run <- run_simulation(
+ timesteps,
+ parameters = parameters,
+ correlations = correlations)
+
+ set.seed(123)
+ first_phase <- run_resumable_simulation(
+ warmup_timesteps,
+ warmup_parameters,
+ correlations = correlations)
+ second_phase <- run_resumable_simulation(
+ timesteps,
+ parameters,
+ initial_state = first_phase$state,
+ restore_random_state = TRUE)
+
+ expect_equal(nrow(first_phase$data), warmup_timesteps)
+ expect_equal(nrow(second_phase$data), timesteps - warmup_timesteps)
+
+ # The order of columns isn't always identical, hence why mapequal needs to be
+ # used.
+ expect_mapequal(
+ second_phase$data,
+ uninterrupted_run[-(1:warmup_timesteps),])
+
+ invisible(second_phase$data)
+}
+
+test_that('Simulation can be resumed', {
+ test_resume(get_parameters(overrides=list(
+ individual_mosquitoes = FALSE,
+ model_seasonality = TRUE
+ )))
+ test_resume(get_parameters(overrides=list(
+ individual_mosquitoes = TRUE,
+ model_seasonality = TRUE
+ )))
+ test_resume(get_parameters(overrides=list(
+ individual_mosquitoes = FALSE,
+ model_seasonality = TRUE
+ )))
+ test_resume(get_parameters(overrides=list(
+ individual_mosquitoes = TRUE,
+ model_seasonality = TRUE
+ )))
+})
+
+test_that('PEV intervention can be added when resuming', {
+ set_default_mass_pev <- function(parameters, timesteps) {
+ n <- length(timesteps)
+ set_mass_pev(
+ parameters,
+ profile = rtss_profile,
+ timesteps = timesteps,
+ coverages = rep(0.5, n),
+ min_wait = 5,
+ min_ages = 365*10,
+ max_ages = 365*60,
+ booster_spacing = NULL,
+ booster_coverage = NULL,
+ booster_profile = NULL)
+ }
+ base <- get_parameters(overrides=list(pev_doses=c(0, 45, 90)))
+
+ data <- test_resume(
+ warmup_parameters = base,
+ parameters = base %>% set_default_mass_pev(100))
+ expect_equal(data[data$n_pev_mass_dose_1 > 0, "timestep"], 100)
+ expect_equal(data[data$n_pev_mass_dose_2 > 0, "timestep"], 145)
+ expect_equal(data[data$n_pev_mass_dose_3 > 0, "timestep"], 190)
+
+ # Add a second mass PEV intervention when resuming the simulation.
+ data <- test_resume(
+ warmup_parameters = base %>% set_default_mass_pev(25),
+ parameters = base %>% set_default_mass_pev(c(25, 100)))
+
+ # The first dose, at time step 25, happens during the warmup and is not
+ # returned by test_resume, hence why we don't see it in the data. Follow-up
+ # doses do show up, even though they we scheduled during warmup.
+ expect_equal(data[data$n_pev_mass_dose_1 > 0, "timestep"], c(100))
+ expect_equal(data[data$n_pev_mass_dose_2 > 0, "timestep"], c(70, 145))
+ expect_equal(data[data$n_pev_mass_dose_3 > 0, "timestep"], c(115, 190))
+})
+
+test_that("TBV intervention can be added when resuming", {
+ set_default_tbv <- function(parameters, timesteps) {
+ set_tbv(
+ parameters,
+ timesteps=timesteps,
+ coverage=rep(1, length(timesteps)),
+ ages=5:60)
+ }
+
+ base <- get_parameters()
+
+ data <- test_resume(
+ warmup_parameters = base,
+ parameters = base %>% set_default_tbv(100))
+ expect_equal(data[!is.na(data$n_vaccinated_tbv), "timestep"], 100)
+
+ data <- test_resume(
+ warmup_parameters = base %>% set_default_tbv(25),
+ parameters = base %>% set_default_tbv(c(25, 100)))
+ expect_equal(data[!is.na(data$n_vaccinated_tbv), "timestep"], 100)
+})
+
+test_that("MDA intervention can be added when resuming", {
+ set_default_mda <- function(parameters, timesteps) {
+ parameters %>% set_drugs(list(SP_AQ_params)) %>% set_mda(
+ drug = 1,
+ timesteps = timesteps,
+ coverages = rep(0.8, length(timesteps)),
+ min_ages = rep(0, length(timesteps)),
+ max_ages = rep(60*365, length(timesteps)))
+ }
+
+ base <- get_parameters()
+
+ data <- test_resume(
+ warmup_parameters = base,
+ parameters = base %>% set_default_mda(100))
+ expect_equal(data[data$n_mda_treated > 0, "timestep"], 100)
+
+ data <- test_resume(
+ warmup_parameters = base %>% set_default_mda(25),
+ parameters = base %>% set_default_mda(c(25, 100)))
+ expect_equal(data[data$n_mda_treated > 0, "timestep"], 100)
+})
+
+test_that("Bednets intervention can be added when resuming", {
+ set_default_bednets <- function(parameters, timesteps) {
+ n <- length(timesteps)
+ set_bednets(
+ parameters,
+ timesteps = timesteps,
+ coverages = rep(0.5, n),
+ retention = 25,
+ dn0 = matrix(rep(0.533, n), ncol=1),
+ rn = matrix(rep(0.56, n), ncol=1),
+ rnm = matrix(rep(0.24, n), ncol=1),
+ gamman = rep(2.64 * 365, n))
+ }
+
+ base <- get_parameters()
+
+ data <- test_resume(
+ warmup_parameters = base,
+ parameters = base %>% set_default_bednets(100))
+ expect_equal(data[diff(data$n_use_net) > 0, "timestep"], 100)
+
+ data <- test_resume(
+ warmup_parameters = base %>% set_default_bednets(25),
+ parameters = base %>% set_default_bednets(c(25, 100)))
+ expect_equal(data[diff(data$n_use_net) > 0, "timestep"], 100)
+})
+
+test_that("Correlations can be set when resuming with new interventions", {
+ set.seed(123)
+
+ # When adding a new intervention with a non-zero correlation, we cannot
+ # ensure that an uninterrupted run matches the stopped-and-resumed simulation
+ # exactly, as the correlation matrix ends up being randomly sampled in a
+ # different order. This stops us from using the `test_resume` used throughout
+ # the rest of this file. Instead we'll only do stopped-and-resumed simulations
+ #' and check its behaviour.
+ #
+ # We first do a warmup phase with only TBV enabled. We then resume that
+ # simulation three times, each time with MDA enabled. Each time we resume the
+ # simulation, we set a different correlation parameter between the TBV and
+ # MDA interventions, with values -1, 0 and 1.
+ #
+ # We look at the output data and confirm that the correlation worked as
+ # expected. For this we need not only how many people got each intervention,
+ # but also how many received both and how many received at least one. This is
+ # not normally exposed, so we add an extra process to render these values.
+ #
+ # For simplicity, for each intervention, we remove any selection process other
+ # than overall coverage, such as age range (set to 0-200years) and drug
+ # efficacy (set to 100%).
+ #
+ # We need a large population to make the statistical assertions succeed. We'll
+ # only simulate 3 timesteps to keep execution time down: one timestep for
+ # warmup during which TBV takes place, one in which MDA takes place and one
+ # final timestep to collect the updated variables.
+ population <- 10000
+ tbv_coverage <- 0.2
+ mda_coverage <- 0.4
+
+ warmup_parameters <- get_parameters(overrides=list(human_population=population)) %>%
+ set_tbv(
+ timesteps=1,
+ coverage=tbv_coverage,
+ ages=0:200)
+
+ drug <- SP_AQ_params
+ drug[1] <- 1. # Override the drug efficacy to 100%
+ parameters <- warmup_parameters %>%
+ set_drugs(list(drug)) %>%
+ set_mda(
+ drug = 1,
+ timesteps = 2,
+ coverages = mda_coverage,
+ min_ages = 0,
+ max_ages = 200*365)
+
+ create_processes_stub <- function(renderer, variables, events, parameters, ...) {
+ p <- function(t) {
+ pop <- parameters$human_population
+ tbv <- variables$tbv_vaccinated$get_index_of(a=-1, b=0)$not()
+ mda <- variables$drug_time$get_index_of(-1)$not()
+
+ renderer$render("total_tbv", tbv$size(), t)
+ renderer$render("total_mda", mda$size(), t)
+ renderer$render("total_tbv_and_mda", tbv$copy()$and(mda)$size(), t)
+ renderer$render("total_tbv_or_mda", tbv$copy()$or(mda)$size(), t)
+ }
+ c(create_processes(renderer, variables, events, parameters, ...), p=p)
+ }
+
+ mockery::stub(run_resumable_simulation, 'create_processes', create_processes_stub)
+
+ warmup_correlations <- get_correlation_parameters(warmup_parameters)
+ warmup_correlations$inter_round_rho('tbv', 1)
+
+ warmup <- run_resumable_simulation(1,
+ parameters=warmup_parameters,
+ correlations=warmup_correlations)
+
+ zero_correlation <- get_correlation_parameters(parameters)
+ zero_correlation$inter_round_rho('tbv', 1)
+ zero_correlation$inter_round_rho('mda', 1)
+
+ positive_correlation <- get_correlation_parameters(parameters)
+ positive_correlation$inter_round_rho('tbv', 1)
+ positive_correlation$inter_round_rho('mda', 1)
+ positive_correlation$inter_intervention_rho('tbv', 'mda', 1)
+
+ negative_correlation <- get_correlation_parameters(parameters)
+ negative_correlation$inter_round_rho('tbv', 1)
+ negative_correlation$inter_round_rho('mda', 1)
+ negative_correlation$inter_intervention_rho('tbv', 'mda', -1)
+
+ data <- run_resumable_simulation(
+ 3,
+ initial_state=warmup$state,
+ parameters=parameters,
+ correlations=zero_correlation)$data %>% tail(1)
+ expect_equal(data$total_tbv, population * tbv_coverage, tolerance = 0.1)
+ expect_equal(data$total_mda, population * mda_coverage, tolerance = 0.1)
+ expect_equal(
+ data$total_tbv_and_mda,
+ population * (tbv_coverage * mda_coverage),
+ tolerance = 0.1)
+ expect_equal(
+ data$total_tbv_or_mda,
+ population * (tbv_coverage + mda_coverage - tbv_coverage * mda_coverage),
+ tolerance = 0.1)
+
+ data <- run_resumable_simulation(
+ 3,
+ initial_state=warmup$state,
+ parameters=parameters,
+ correlations=positive_correlation)$data %>% tail(1)
+ expect_equal(data$total_tbv, population * tbv_coverage, tolerance = 0.1)
+ expect_equal(data$total_mda, population * mda_coverage, tolerance = 0.1)
+ expect_equal(data$total_tbv_and_mda, min(data$total_tbv, data$total_mda))
+ expect_equal(data$total_tbv_or_mda, max(data$total_tbv, data$total_mda))
+
+ data <- run_resumable_simulation(
+ 3,
+ initial_state=warmup$state,
+ parameters=parameters,
+ correlations=negative_correlation)$data %>% tail(1)
+ expect_equal(data$total_tbv, population * tbv_coverage, tolerance = 0.1)
+ expect_equal(data$total_mda, population * mda_coverage, tolerance = 0.1)
+ expect_equal(data$total_tbv_and_mda, 0)
+ expect_equal(data$total_tbv_or_mda, data$total_tbv + data$total_mda)
+})
diff --git a/tests/testthat/test-seasonality.R b/tests/testthat/test-seasonality.R
index 01302d8d..f600ebf4 100644
--- a/tests/testthat/test-seasonality.R
+++ b/tests/testthat/test-seasonality.R
@@ -15,14 +15,14 @@ test_that('Seasonality correctly affects P', {
counts <- c()
for (t in seq(timesteps)) {
- counts <- rbind(counts, c(t, solver_get_states(solvers[[1]])))
+ counts <- rbind(counts, c(t, solvers[[1]]$get_states()))
aquatic_mosquito_model_update(
- models[[1]],
+ models[[1]]$.model,
total_M,
parameters$blood_meal_rates,
parameters$mum
)
- solver_step(solvers[[1]])
+ solvers[[1]]$step()
}
burn_in <- 20
diff --git a/tests/testthat/test-simulation-e2e.R b/tests/testthat/test-simulation-e2e.R
index 0e7f7a6c..fc8338ed 100644
--- a/tests/testthat/test-simulation-e2e.R
+++ b/tests/testthat/test-simulation-e2e.R
@@ -10,8 +10,19 @@ test_that('run_metapop_simulation fails with incorrect mixing matrix', {
paramlist <- list(parameters, parameters)
# incorrect params
mixing <- matrix(c(1, 1), nrow = 1, ncol = 2)
+ p_captured <- diag(nrow=2)
expect_error(
- run_metapop_simulation(timesteps, parameters, NULL, mixing)
+ run_metapop_simulation(
+ timesteps,
+ parameters,
+ NULL,
+ mixing_tt = 1,
+ export_mixing = list(mixing),
+ import_mixing = list(mixing),
+ p_captured_tt = 1,
+ p_captured = list(diag(nrow=2)),
+ p_success = 1
+ )
)
})
@@ -20,9 +31,20 @@ test_that('run_metapop_simulation integrates two models correctly', {
timesteps <- 5
parameters <- get_parameters(list(human_population = population))
parametersets <- list(parameters, parameters)
- mixing <- diag(1, nrow = 2, ncol = 2)
+ mixing <- diag(nrow = 2)
+ p_captured <- 1 - diag(nrow = 2)
- outputs <- run_metapop_simulation(timesteps, parametersets, NULL, mixing)
+ outputs <- run_metapop_simulation(
+ timesteps,
+ parametersets,
+ NULL,
+ mixing_tt = 1,
+ export_mixing = list(mixing),
+ import_mixing = list(mixing),
+ p_captured_tt = 1,
+ p_captured = list(p_captured),
+ p_success = 1
+ )
expect_equal(length(outputs), 2)
expect_equal(nrow(outputs[[1]]), 5)
expect_equal(nrow(outputs[[2]]), 5)
diff --git a/tests/testthat/test-tbv.R b/tests/testthat/test-tbv.R
index 0e4451a1..e8af946e 100644
--- a/tests/testthat/test-tbv.R
+++ b/tests/testthat/test-tbv.R
@@ -1,3 +1,14 @@
+test_that('TBV checks arguments', {
+ parameters <- get_parameters()
+ expect_error(
+ parameters <- set_tbv(
+ parameters,
+ timesteps = c(50, 150),
+ coverages = 1,
+ ages = 5:60
+ ), "coverages and timesteps do no align")
+})
+
test_that('TBV strategy parameterisation works', {
parameters <- get_parameters()
parameters <- set_tbv(
diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R
new file mode 100644
index 00000000..0b1f56ec
--- /dev/null
+++ b/tests/testthat/test-utils.R
@@ -0,0 +1,43 @@
+
+test_that('time_cached calls the function the first time round', {
+ fn <- mockery::mock(42)
+ cached_fn <- time_cached(fn)
+ expect_equal(cached_fn(timestep = 1), 42)
+ mockery::expect_called(fn, 1)
+})
+
+test_that('time_cached returns the cached result the second time round', {
+ fn <- mockery::mock(42)
+ cached_fn <- time_cached(fn)
+ expect_equal(cached_fn(timestep = 1), 42)
+ expect_equal(cached_fn(timestep = 1), 42)
+ mockery::expect_called(fn, 1)
+})
+
+test_that('time_cached calls again for a different timestep', {
+ fn <- mockery::mock(42, 43)
+ cached_fn <- time_cached(fn)
+ expect_equal(cached_fn(timestep = 1), 42)
+ expect_equal(cached_fn(timestep = 2), 43)
+ mockery::expect_called(fn, 2)
+})
+
+test_that("bitset_index works", {
+ a <- individual::Bitset$new(10)$insert(c(3,5,7,9))
+ b <- individual::Bitset$new(10)$insert(c(2,4,5,8,9))
+ expect_equal(bitset_index(a, b), c(2,4))
+
+ a <- individual::Bitset$new(10)
+ b <- individual::Bitset$new(10)$insert(c(2,4,5,8,9))
+ expect_equal(length(bitset_index(a, b)), 0)
+
+ a <- individual::Bitset$new(10)$insert(c(3,5,7,9))
+ b <- individual::Bitset$new(10)
+ expect_equal(length(bitset_index(a, b)), 0)
+})
+
+test_that("bitset_index errors if size does not match", {
+ a <- individual::Bitset$new(10)$insert(c(3,5,7,9))
+ b <- individual::Bitset$new(20)$insert(c(2,4,5,8,9))
+ expect_error(bitset_index(a, b), "Incompatible bitmap sizes")
+})
diff --git a/tests/testthat/test-vector-control.R b/tests/testthat/test-vector-control.R
index 34f9d6ef..212e1cd3 100644
--- a/tests/testthat/test-vector-control.R
+++ b/tests/testthat/test-vector-control.R
@@ -201,9 +201,11 @@ test_that('indoor_spraying process sets spray_time correctly', {
ms_gamma = matrix(c(-0.009, -0.009), nrow=2, ncol=1)
)
spray_time <- mock_double(rep(0, 4))
+ renderer <- individual::Render$new(timestep)
correlations <- get_correlation_parameters(parameters)
process <- indoor_spraying(
spray_time,
+ renderer,
parameters,
correlations
)
@@ -372,18 +374,18 @@ test_that('set_carrying_capacity works',{
species = "gamb",
carrying_capacity = TRUE,
carrying_capacity_timesteps = 1,
- carrying_capacity_values = matrix(0.1)
+ carrying_capacity_scalers = matrix(0.1)
)
)
expect_error(
set_carrying_capacity(p, 1, matrix(c(0.1, 0.1), nrow = 2)),
- "nrow(carrying_capacity) == length(timesteps) is not TRUE",
+ "nrow(carrying_capacity_scalers) == length(timesteps) is not TRUE",
fixed = TRUE
)
expect_error(
set_carrying_capacity(p, 1, matrix(c(0.1, 0.1), ncol = 2)),
- "ncol(carrying_capacity) == length(parameters$species) is not TRUE",
+ "ncol(carrying_capacity_scalers) == length(parameters$species) is not TRUE",
fixed = TRUE
)
expect_error(
@@ -393,7 +395,7 @@ test_that('set_carrying_capacity works',{
)
expect_error(
set_carrying_capacity(p, 1, matrix(-1)),
- "min(carrying_capacity) >= 0",
+ "min(carrying_capacity_scalers) >= 0",
fixed = TRUE
)
})
diff --git a/vignettes/Antimalarial_Resistance.Rmd b/vignettes/Antimalarial_Resistance.Rmd
new file mode 100644
index 00000000..3bd2fb1a
--- /dev/null
+++ b/vignettes/Antimalarial_Resistance.Rmd
@@ -0,0 +1,410 @@
+---
+title: "Antimalarial Resistance"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Antimalarial Resistance}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+ collapse = TRUE,
+ comment = "#>"
+)
+```
+
+```{r setup}
+
+# Load the requisite packages:
+library(malariasimulation)
+
+# Set colour palette:
+cols <- c("#E69F00", "#56B4E9", "#009E73", "#CC79A7","#F0E442", "#0072B2", "#D55E00")
+
+```
+
+## Introduction
+One of the major threats to the continued success of efforts to reduce the burden of malaria is the evolution and spread of resistance to the antimalarial drugs used to treat uncomplicated cases of malaria. The most effective frontline antimalarials are a class of drugs called artemisinin combination therapies (ACTs). ACTs combine a fast-acting, short-lived artemisinin derivative (e.g. artemether), with a slower-acting, longer-lasting partner drug (e.g. lumefantrine) that clears the remaining parasites from the patient's system. Efforts to understand the effect of resistance to ACTs on malaria morbidity and mortality, and to develop strategies to control or mitigate the spread of resistance, would benefit from insights derived from mathematical modelling. Building on the model developed by Slater et al. (2016), `malariasimulation` provides the functionality to simulate the effects of resistance to the artemisinin and/or partner drug components to multiple, independent ACTs, on malaria transmission dynamics.
+
+Resistance to the artemisinin component of an ACT can result either in slow parasite clearance (SPC), in which treatment with an ACT takes longer than 3 days to fully clear patients with resistant parasites, or early treatment failure (ETF), in which the ACT fails to clear the infection and the individual develops a clinical infection. Resistance to the partner drug, where the partner drug fails to clear the parasite after the artemisinin derivative is depleted, results in infections recrudescing to either clinical (D) or asymptomatic infections (A). Resistance to the partner drug can also result in individuals developing a novel, resistant infection following treatment, as the prophylaxis provided by the ACT fails to protect the individual against reinfection by a resistant strain. In the following vignette, we illustrate how to parameterise and run `malariasimulation` simulations with resistance to ACTs deployed as a clinical treatment
+
+## Using set_antimalarial_resistance() to parameterise resistance
+Simulations capturing the effects of resistance to clinical treatment using antimalarial drugs are parameterised using the `set_antimalarial_resistance()` function. This function appends user-defined resistance parameters to a `malariasimulation` parameter list and accepts ten inputs. The first is a list of `malariasimulation` parameters to append the resistance parameters to, and the second the index of the `drug` for which resistance is being parameterised, as set using the `set_drugs()` function. The `set_antimalarial_resistance()` function requires the `timesteps`, `artemisinin_resistance_proportion`, `partner_drug_resistance_proportion_proportion`, `slow_parasite_clearance_probability`, `early_treatment_failure_probability`, `late_clinical_failure_probability`, `late_parasitological_failure_prob`, and `reinfection_during_prophylaxis_probability` inputs to be of equal length so that, for each time step in which an update occurs, a value is available for each parameter. Finally, the `slow_parasite_clearance_time` parameter represents the mean residence time, in days, for artemisinin-resistant individuals experiencing slow parasite clearance (SPC) in the Treated compartment, and must be input as a single, positive value.
+
+## Simulating static resistance
+To illustrate how to parameterise resistance to an ACT using the `set_antimalarial_resistance()` function, we'll set-up and run three simulations. The first simulates malaria transmission in the absence of interventions or resistance. The second simulates a simple regime of clinical treatment in which 80% of clinical cases are treated with artemether lumefantrine (AL), beginning after one year, in the absence of antimalarial resistance. The third simulates the same clinical treatment programme but with resistance to the artemisinin component of AL emerging after two years. For illustrative purposes, we assume that the proportion of infections resistant to the artemisinin component of AL increases from 0% to 80%, and that these infections have a 90% chance of resulting in early treatment failure.
+
+### Parameterisation
+First, we load the default `malariasimulation` model parameters, using the `overrides` argument to increase the human population. The human and mosquito population parameters are then calibrated to a user-specified initial EIR using the `set_equilibrium()` function. Next, we load the in-built parameters for the antimalarial drug AL and append them to the parameter list using `set_drugs()`. We can then use `set_clinical_treatment()` to specify a clinical treatment regime, beginning after one year, that treats, on average, 80% of the clinical cases of malaria with AL (`AL_params`). The `set_antimalarial_resistance()` function is then used to specify a scenario in which resistance is initially absent from the population, but after two years the proportion of malaria infections that are resistant to the artemisinin component of AL rises to 80%. We also set the probability that artemisinin-resistant infections result in early treatment failure to 0.9. In the current instance, we've set the proportion of infections resistant to the AL partner drug to 0% and the probabilities of other resistant infection outcomes to zero for simplicity.
+
+```{r, eval = TRUE}
+
+# Specify the time steps over which to simulate:
+timesteps <- 365 * 3
+
+# Specify an initial EIR to calibrate to:
+init_EIR <- 8
+
+# Specify a time step for treatment to begin:
+treatment_start <- (1 * 365) + 1
+
+# Specify a time step for resistance to emerge:
+resistance_start <- (2 * 365) + 1
+
+# Load the base malariasimulation parameter set:
+simparams <- get_parameters(
+ overrides = list(
+ human_population = 10000)
+)
+
+# Calibrate to the initial EIR:
+simparams <- set_equilibrium(parameters = simparams, init_EIR = init_EIR)
+
+# Append the parameters for artemether lumefantrine (AL) to the parameter list:
+simparams_clin_treatment <- set_drugs(parameters = simparams, drugs = list(AL_params))
+
+# Use the set_clinical_treatment() function to specify a treatment regime for AL:
+simparams_clin_treatment <- set_clinical_treatment(parameters = simparams_clin_treatment,
+ drug = 1,
+ timesteps = treatment_start,
+ coverages = 0.8)
+
+# Use the set_antimalarial_resistance() function to specify resistance to AL:
+simparams_resistance <- set_antimalarial_resistance(parameters = simparams_clin_treatment,
+ drug = 1,
+ timesteps = c(0, resistance_start),
+ artemisinin_resistance_proportion = c(0, 0.8),
+ partner_drug_resistance_proportion = rep(0, 2),
+ slow_parasite_clearance_probability = rep(0, 2),
+ early_treatment_failure_probability = c(0, 0.9),
+ late_clinical_failure_probability = rep(0, 2),
+ late_parasitological_failure_probability = rep(0, 2),
+ reinfection_during_prophylaxis_probability = rep(0, 2),
+ slow_parasite_clearance_time = 10)
+
+```
+
+### Simulation
+We can now use the `run_simulation()` to simulate the three scenarios for which we have established parameter lists above.
+
+```{r, eval = TRUE}
+
+# Baseline: No-intervention, no resistance simulation:
+sim_out_baseline <- run_simulation(timesteps = timesteps, parameters = simparams)
+
+# Clinical treatment with no antimalarial drug resistance:
+sim_out_clin_treatment <- run_simulation(timesteps = timesteps, parameters = simparams_clin_treatment)
+
+# Clinical treatment with antimalarial drug resistance:
+sim_out_resistance <- run_simulation(timesteps = timesteps, parameters = simparams_resistance)
+
+```
+
+### Visualisation
+With the outputs from the `run_simulation()` function, we can visualise the effect of resistance on malaria transmission by plotting the prevalence of malaria in children aged 2-10 years old (*Pf*PR~2-10~) over time.
+
+```{r, fig.align = 'center', eval = TRUE}
+
+# In each timestep, calculate PfPR_2-10 and add it to as a new column for each simulation output:
+sim_out_baseline$pfpr210 = sim_out_baseline$n_detect_lm_730_3650/sim_out_baseline$n_age_730_3650
+sim_out_clin_treatment$pfpr210 = sim_out_clin_treatment$n_detect_lm_730_3650/sim_out_clin_treatment$n_age_730_3650
+sim_out_resistance$pfpr210 = sim_out_resistance$n_detect_lm_730_3650/sim_out_resistance$n_age_730_3650
+
+# Plot the prevalence through time in each of the three simulated scenarios:
+plot.new(); par(mar = c(4, 4, 1, 1), new = TRUE)
+plot(x = sim_out_baseline$timestep, y = sim_out_baseline$pfpr210,
+ xlab = "Time (days)",
+ ylab = expression(paste(italic(Pf),"PR"[2-10])), cex = 0.7,
+ ylim = c(0, 1), type = "l", lwd = 2, xaxs = "i", yaxs = "i",
+ col = cols[3])
+
+# Add a line for the clinical treatment scenario:
+lines(x = sim_out_clin_treatment$timestep,
+ y = sim_out_clin_treatment$pfpr210,
+ col = cols[4])
+
+# Add a line for the clinical treatment with resistance scenario:
+lines(x = sim_out_resistance$timestep,
+ y = sim_out_resistance$pfpr210,
+ col = cols[7])
+
+# Add lines to indicate the initiation of treatment and resistance:
+abline(v = treatment_start, lty = "dashed")
+abline(v = resistance_start, lty = "dashed")
+
+# Annotate the added vlines:
+text(x = treatment_start + 10, y = 0.9, labels = "Start of\nTreatment", adj = 0, cex = 0.7)
+text(x = resistance_start + 10, y = 0.9, labels = "Start of\nResistance", adj = 0, cex = 0.7)
+
+# Add gridlines:
+grid(lty = 2, col = "grey80", nx = NULL, ny = NULL, lwd = 0.5); box()
+
+# Add a legend:
+legend(x = 20, y = 0.99, legend = c("Baseline", "Treatment", "Resistance"),
+ col= c(cols[3:4], cols[7]), box.col = "white",
+ lwd = 1, lty = c(1, 1), cex = 0.7)
+
+```
+
+In the absence of clinical treatment or resistance, prevalence is comparable between all three scenarios for the first year. Following the initiation of clinical treatment at the beginning of the second year, *Pf*PR~2-10~ approximately halves relative to the no-intervention baseline. However, following the introduction of artemisinin resistance at the beginning of the third year, early treatment failure causes the *Pf*PR~2-10~ to increase to an intermediate level in the resistance scenario.
+
+## Simulating dynamic resistance
+We can also capture scenarios in which resistance to a drug changes through time. To illustrate, we'll establish and simulate a scenario in which resistance to sulfadoxine-pyrimethamine amodiaquine (SP-AQ) is absent from the population in the first year, but emerges in the third year and doubles in proportion each year thereafter until 100% of infections are artemisinin resistant. For simplicity, we'll assume only artemisinin resistance is present in the population, and resistance to artemisinin results only, and always, in early treatment failure.
+
+### Parameterisation
+First, we store in vectors the artemisinin resistance proportions and the time steps on which they will be updated in the simulation. We also create a vector of early treatment failure probabilities which, for simplicity, we assume remain at 1 for each update. Next, we load the default `malariasimulation` parameter set, specifying a larger population size and seasonal transmission, and append the parameters for SP-AQ (`SP_AQ_params`) using the `set_drugs()` function. We'll specify a simple treatment regimen using `set_clinical_treatment()` where, on average, 80% of clinical cases are treated with SP-AQ, beginning after one year. We then specify a resistance schedule in which artemisinin resistance is introduced at a proportion of 0.2 after 3 years, and doubles each year thereafter until all infections are artemisinin resistant. Finally, we calibrate the human and mosquito population parameters to a defined entomological inoculation rate (EIR) and are ready to run the simulation.
+
+```{r, eval = TRUE}
+
+# Specify the time steps over which to simulate:
+timesteps <- 365 * 8
+
+# Set an initial EIR value:
+initial_eir <- 8
+
+# Specify the proportion of infections that are artemisinin resistant:
+resistance_updates <- c(0, 0.2, 0.4, 0.8, 1)
+
+# Specify the time steps in which to update the resistance parameters:
+resistance_update_timesteps <- c(0, seq(3*365, 6*365, by = 365))
+
+# Specify the probability artemisinin resistance infections result in early treatment failure:
+early_treatment_failure_updates <- rep(1, length(resistance_update_timesteps))
+
+# Load the base malariasimulation parameter set, with seasonal transmission:
+simparams <- get_parameters(
+ overrides = list(
+ human_population = 1000,
+ model_seasonality = TRUE,
+ g0 = 0.284596,
+ g = c(-0.317878,-0.0017527,0.116455),
+ h = c(-0.331361,0.293128,-0.0617547)
+))
+
+# Append the parameters for sulfadomamine pyrimethaine (SP-AQ) to the parameter list:
+simparams <- set_drugs(parameters = simparams, drugs = list(SP_AQ_params))
+
+# Use the set_clinical_treatment() function to specify a treatment regime for SP-AQ:
+simparams <- set_clinical_treatment(parameters = simparams,
+ drug = 1,
+ timesteps = 365 * 1,
+ coverages = 0.8)
+
+# Use the set_antimalarial_resistance() function to specify resistance to SP-AQ:
+simparams <- set_antimalarial_resistance(parameters = simparams,
+ drug = 1,
+ timesteps = resistance_update_timesteps,
+ artemisinin_resistance_proportion = resistance_updates,
+ partner_drug_resistance_proportion = rep(0, length(resistance_update_timesteps)),
+ slow_parasite_clearance_probability = rep(0, length(resistance_update_timesteps)),
+ early_treatment_failure_probability = early_treatment_failure_updates,
+ late_clinical_failure_probability = rep(0, length(resistance_update_timesteps)),
+ late_parasitological_failure_probability = rep(0, length(resistance_update_timesteps)),
+ reinfection_during_prophylaxis_probability = rep(0, length(resistance_update_timesteps)),
+ slow_parasite_clearance_time = 10)
+
+# Calibrate the parameters to an initial EIR:
+simparams <- set_equilibrium(parameters = simparams, init_EIR = initial_eir)
+
+```
+
+### Simulation
+We can now use our parameter list to run the simulation using the the `run_simulation()` function.
+
+```{r, eval = TRUE}
+
+# Run the simulation:
+dynamic_resistance_output <- run_simulation(timesteps = timesteps, parameters = simparams)
+
+```
+
+### Visualisation
+We can visualise the effect of increasing resistance through time by plotting the *Pf*PR~2-10~. We've added vertical lines to indicate when clinical treatment begins, and when the proportion of infections resistant to artemisinin is updated.
+
+```{r, fig.align = 'center', eval = TRUE}
+
+# Calculate the prevalence (PfPR210) through time:
+dynamic_resistance_output$pfpr210 <- dynamic_resistance_output$n_detect_lm_730_3650/dynamic_resistance_output$n_age_730_3650
+
+# Open a new plotting window and add a grid:
+plot.new(); par(mar = c(4, 4, 1, 1), new = TRUE)
+plot(x = dynamic_resistance_output$timestep,
+ y = dynamic_resistance_output$pfpr210,
+ xaxt = "n",
+ xlab = "Time (years)",
+ ylab = expression(paste(italic(Pf),"PR"[2-10])), cex = 0.8,
+ ylim = c(0, 1), type = "l", lwd = 2, xaxs = "i", yaxs = "i",
+ col = cols[3])
+
+# Specify x-axis ticks and labels:
+axis(1, at = seq(0, 8 * 365, by = 365), labels = seq(0, 8 * 365, by = 365)/365)
+
+# Add a line indicating the start of the clinical treatment:
+abline(v = 365, lty = "dotted")
+
+# Add lines indicating when resistance is updated:
+abline(v = resistance_update_timesteps, lty = "dashed")
+
+# Add a line highlighting the maximum PfPR_2-10 value prior to treatment or resistance:
+abline(h = max(dynamic_resistance_output$pfpr210[1:365]), col = "red")
+
+# Add annotations for the vlines:
+text(x = 365 + 30, y = 0.6, labels = "Clin. treat. begins", adj = 0, cex = 0.8, srt = 90)
+text(x = resistance_update_timesteps[2:5] + 30, y = 0.6, labels = paste0("Art. Res. = ", resistance_updates[2:5]),
+ adj = 0, cex = 0.8, srt = 90)
+
+```
+
+Looking at the figure, we can see that the *Pf*PR~2-10~ decreases over the two years following the onset of clinical treatment in the absence of artemisinin resistance. However, as resistance is introduced and increases through time, the *Pf*PR~2-10~ increases towards the pre-intervention seasonal peak as SP-AQ becomes increasingly ineffective in the treatment of clinical cases of malaria.
+
+## Simulating antimalarial resistance with multiple resistance outcomes
+
+As we've discussed, resistance to an ACT can manifest in multiple ways. For instance, resistance to the artemisinin component of an ACT can result in either early treatment failure or slow parasite clearance.
+
+Using `malariasimulation`, we can simulate the effects of multiple potential outcomes of resistance on malaria transmission dynamics. To illustrate, we'll parameterise and run a series of simulations in is i) no clinical treatment, ii) no resistance, iii) resistance with early treatment failure, iv) resistance with slow parasite clearance, and v) resistance with early treatment failure and slow parasite clearance.
+
+### Parameterisation
+```{r}
+
+# Determine the number of timesteps to run for:
+timesteps <- 365 * 6
+
+# Set up a list to store the simulation parameter lists in:
+simulation_parameters <- list()
+
+# Establish a list of the base parameters with no clinical treatment or antimalarial resistance:
+get_parameters(overrides = list(human_population = 1000)) -> simulation_parameters$base
+
+# Establish a parameter list with clinical treatment starting after one year:
+simulation_parameters$base |>
+ set_drugs(drugs = list(AL_params)) |>
+ set_clinical_treatment(drug = 1, timesteps = (365 * 1) + 1, coverages = c(0.8)) |>
+ set_equilibrium(init_EIR = 16) -> simulation_parameters$treatment
+
+# Set the equilibrium for the base parameters:
+simulation_parameters$base |>
+ set_equilibrium(init_EIR = 16) -> simulation_parameters$base
+
+# Establish a parameter list with clinical treatment and early treatment failure
+simulation_parameters$treatment |>
+ set_antimalarial_resistance(drug = 1,
+ timesteps = c(0, (365 * 3) + 1),
+ artemisinin_resistance_proportion = c(0, 0.8),
+ partner_drug_resistance_proportion = c(0, 0),
+ slow_parasite_clearance_probability = c(0, 0),
+ early_treatment_failure_probability = c(0, 0.8),
+ late_clinical_failure_probability = c(0, 0),
+ late_parasitological_failure_probability = c(0, 0),
+ reinfection_during_prophylaxis_probability = c(0, 0),
+ slow_parasite_clearance_time = 10) -> simulation_parameters$etf
+
+# Establish a parameter list with clinical treatment and slow parasite clearance
+simulation_parameters$treatment |>
+ set_antimalarial_resistance(drug = 1,
+ timesteps = c(0, (365 * 3) + 1),
+ artemisinin_resistance_proportion = c(0, 0.8),
+ partner_drug_resistance_proportion = c(0, 0),
+ slow_parasite_clearance_probability = c(0, 0.8),
+ early_treatment_failure_probability = c(0, 0),
+ late_clinical_failure_probability = c(0, 0),
+ late_parasitological_failure_probability = c(0, 0),
+ reinfection_during_prophylaxis_probability = c(0, 0),
+ slow_parasite_clearance_time = 10) -> simulation_parameters$spc
+
+# Establish a parameter list with clinical treatment, early treatment failure and slow parasite clearance:
+simulation_parameters$treatment |>
+ set_antimalarial_resistance(drug = 1,
+ timesteps = c(0, (365 * 3) + 1),
+ artemisinin_resistance_proportion = c(0, 0.8),
+ partner_drug_resistance_proportion = c(0, 0),
+ slow_parasite_clearance_probability = c(0, 0.8),
+ early_treatment_failure_probability = c(0, 0.8),
+ late_clinical_failure_probability = c(0, 0),
+ late_parasitological_failure_probability = c(0, 0),
+ reinfection_during_prophylaxis_probability = c(0, 0),
+ slow_parasite_clearance_time = 10) -> simulation_parameters$etf_spc
+
+```
+
+### Simulation
+We can now use our lists of `malariasimulation` parameters to run the simulations.
+
+```{r}
+
+# Open a list to store the simulation outputs in:
+simulation_outputs <- list()
+
+# Run the simulations
+for(i in seq(length(simulation_parameters))) {
+
+ # Run the i-th simulation
+ simulation_temp <- run_simulation(timesteps = timesteps,
+ parameters = simulation_parameters[[i]])
+
+ # Append the simulation identifier:
+ simulation_temp$identifier <- names(simulation_parameters)[i]
+
+ # Append the ith simulation outputs to the combined simulation dataframe:
+ simulation_outputs[[names(simulation_parameters)[i]]] <- simulation_temp
+
+ # Print the number of columns in the i-th simulation outputs dataframe:
+ print(ncol(simulation_temp))
+}
+
+```
+
+### Visualisation
+
+We can compare the effects of independent resistance outcomes with combined resistance outcomes visually. In the following plot, we compare the *Pf*PR~2-10~ between a baseline without any clinical treatment or antimalarial resistance, a clinical-treatment only run, a clinical treatment with early treatment failure run, a clinical treatment with slow parasite clearance run, and a clinical treatment with both early treatment failure and slow parasite clearance run.
+
+```{R}
+
+# Open a new plotting window and add a grid:
+plot.new(); par(mar = c(4, 4, 1, 1), new = TRUE)
+
+# Plot malaria prevalence in 2-10 years through time:
+plot(x = simulation_outputs$base$timestep,
+ y = simulation_outputs$base$n_detect_lm_730_3650/simulation_outputs$base$n_age_730_3650,
+ xlab = "Time (days)",
+ ylab = expression(paste(italic(Pf),"PR"[2-10])), cex = 0.8,
+ ylim = c(0, 1), type = "l", lwd = 2, xaxs = "i", yaxs = "i",
+ col = cols[3])
+
+# Add the dynamics for no-intervention simulation
+lines(x = simulation_outputs$treatment$timestep,
+ y = simulation_outputs$treatment$n_detect_lm_730_3650/simulation_outputs$treatment$n_age_730_3650,
+ col = cols[4])
+
+lines(x = simulation_outputs$etf$timestep,
+ y = simulation_outputs$etf$n_detect_lm_730_3650/simulation_outputs$etf$n_age_730_3650,
+ col = cols[5])
+
+lines(x = simulation_outputs$spc$timestep,
+ y = simulation_outputs$spc$n_detect_lm_730_3650/simulation_outputs$spc$n_age_730_3650,
+ col = cols[6])
+
+lines(x = simulation_outputs$etf_spc$timestep,
+ y = simulation_outputs$etf_spc$n_detect_lm_730_3650/simulation_outputs$etf_spc$n_age_730_3650,
+ col = cols[7])
+
+# Add vlines to indicate when SP-AQ were administered:
+abline(v = 365 + 1, lty = "dashed", lwd = 1)
+text(x = (365 * 1) - 40, y = 0.6, labels = "Treatment Introduced", adj = 0, cex = 0.8, srt = 90)
+
+abline(v = (365 * 3) + 1, lty = "dashed", lwd = 1)
+text(x = (365 * 3) - 40, y = 0.6, labels = "Resistance Introduced", adj = 0, cex = 0.8, srt = 90)
+
+# Add gridlines:
+grid(lty = 2, col = "grey80", nx = NULL, ny = NULL, lwd = 0.5); box()
+
+# Add a legend:
+legend(x = 3000, y = 0.99, legend = c("Baseline", "Treatment", "ETF-only", "SPC-only", "ETF and SPC"),
+ col= c(cols[3:7]), box.col = "white",
+ lwd = 1, lty = c(1, 1), cex = 0.8)
+
+
+```
+
+## References
+Slater, H.C., Griffin, J.T., Ghani, A.C. and Okell, L.C., 2016. Assessing the potential impact of artemisinin and partner drug resistance in sub-Saharan Africa. Malaria journal, 15(1), pp.1-11.
diff --git a/vignettes/Carrying-capacity.Rmd b/vignettes/Carrying-capacity.Rmd
index c0cfcf7c..e17ac25d 100644
--- a/vignettes/Carrying-capacity.Rmd
+++ b/vignettes/Carrying-capacity.Rmd
@@ -66,10 +66,10 @@ and can run the simulations and compare the outputs
```{r, fig.width = 7, fig.height = 4, out.width='100%'}
set.seed(123)
s <- run_simulation(timesteps = timesteps, parameters = p)
-s$pfpr <- s$n_detect_730_3650 / s$n_730_3650
+s$pfpr <- s$n_detect_lm_730_3650 / s$n_age_730_3650
set.seed(123)
s_seasonal <- run_simulation(timesteps = timesteps, parameters = p_seasonal)
-s_seasonal$pfpr <- s_seasonal$n_detect_730_3650 / s_seasonal$n_730_3650
+s_seasonal$pfpr <- s_seasonal$n_detect_lm_730_3650 / s_seasonal$n_age_730_3650
par(mfrow = c(1, 2))
plot(s$EIR_gamb ~ s$timestep, t = "l", ylim = c(0, 200), xlab = "Time", ylab = "EIR")
@@ -81,17 +81,13 @@ lines(s_seasonal$pfpr ~ s_seasonal$timestep, col = "darkorchid3")
## Custom modification of the mosquito carrying capacity
In malariasimulation, we can also modify the carrying capacity over time in a more
-bespoke manner. Firstly it is helpful to start with our baseline (equilibrium)
-carrying capacity. We can access this for our baseline parameters with:
+bespoke manner. We can use the `set_carrying_capacity()` helper function to
+specify scalars that modify the species-specific carrying capacity through time,
+relative to the baseline carrying capacity, at defined time steps. The baseline
+carrying capacity is generated when calling `set_equilibrium()`, to match the
+specified EIR and population size.
-```{r}
-cc <- get_init_carrying_capacity(p)
-cc
-```
-
-We can then use this in combination with `set_carrying_capacity()` to provide
-modified, species-specific carrying capacity values at given timepoints. This
-allows us to model a number of useful things:
+This functionality allows us to model a number of useful things:
### Larval source management
@@ -102,15 +98,15 @@ can be used to specify this intervention
```{r, fig.width = 7, fig.height = 4, out.width='100%'}
# Specify the LSM coverage
lsm_coverage <- 0.8
-# Set LSM by reducing the carrying capacity by (1 - coverage)
+# Set LSM by scaling the carrying capacity by (1 - coverage)
p_lsm <- p |>
set_carrying_capacity(
- carrying_capacity = matrix(cc * (1 - lsm_coverage), ncol = 1),
+ carrying_capacity_scalers = matrix(1 - lsm_coverage, ncol = 1),
timesteps = 365
)
set.seed(123)
s_lsm <- run_simulation(timesteps = timesteps, parameters = p_lsm)
-s_lsm$pfpr <- s_lsm$n_detect_730_3650 / s_lsm$n_730_3650
+s_lsm$pfpr <- s_lsm$n_detect_lm_730_3650 / s_lsm$n_age_730_3650
par(mfrow = c(1, 2))
plot(s$EIR_gamb ~ s$timestep, t = "l", ylim = c(0, 150), xlab = "Time", ylab = "EIR")
@@ -124,7 +120,7 @@ abline(v = 365, lty = 2, col = "grey60")
### Invasive species
An invasive species may exploit a new niche, increase the carrying
-capacity at the point of invasion. The functions
+capacity at the point of invasion. The function
`set_carrying_capacity()` gives complete freedom to allow
changes to the carrying capacity to be made. Here
we will demonstrate using carrying capacity rescaling to capture the
@@ -136,19 +132,19 @@ invasion of _Anopheles stephensi_.
p_stephensi <- p |>
set_species(list(gamb_params, steph_params), c(0.995, 1 - 0.995)) |>
set_equilibrium(init_EIR = 5)
-cc_invasive <- get_init_carrying_capacity(p_stephensi)
+
# Next, at the time point of invasion, we scale up the carrying capacity for
-# the invasive species by a factor that will be dependent on the proporties of
+# the invasive species by a factor that will be dependent on the properties of
# the invasion.
p_stephensi <- p_stephensi |>
set_carrying_capacity(
- carrying_capacity = matrix(cc_invasive * c(1, 2000), ncol = 2),
+ carrying_capacity_scalers = matrix(c(1, 2000), ncol = 2),
timesteps = 365
)
set.seed(123)
s_stephensi <- run_simulation(timesteps = timesteps, parameters = p_stephensi)
-s_stephensi$pfpr <- s_stephensi$n_detect_730_3650 / s_stephensi$n_730_3650
+s_stephensi$pfpr <- s_stephensi$n_detect_lm_730_3650 / s_stephensi$n_age_730_3650
par(mfrow = c(1, 2))
plot(s_stephensi$EIR_gamb ~ s_stephensi$timestep,
@@ -169,13 +165,13 @@ time
```{r, fig.width = 7, fig.height = 4, out.width='100%'}
p_flexible <- p |>
set_carrying_capacity(
- carrying_capacity = cc * matrix(c(0.1, 2, 0.1, 0.5, 0.9), ncol = 1),
+ carrying_capacity = matrix(c(0.1, 2, 0.1, 0.5, 0.9), ncol = 1),
timesteps = seq(100, 500, 100)
)
set.seed(123)
s_flexible <- run_simulation(timesteps = timesteps, parameters = p_flexible)
-s_flexible$pfpr <- s_flexible$n_detect_730_3650 / s_flexible$n_730_3650
+s_flexible$pfpr <- s_flexible$n_detect_lm_730_3650 / s_flexible$n_age_730_3650
par(mfrow = c(1, 2))
plot(s$EIR_gamb ~ s$timestep, t = "l", ylim = c(0, 150), xlab = "Time", ylab = "EIR")
diff --git a/vignettes/Demography.Rmd b/vignettes/Demography.Rmd
index d8c96a93..9de15d9c 100644
--- a/vignettes/Demography.Rmd
+++ b/vignettes/Demography.Rmd
@@ -27,7 +27,7 @@ The dynamics of malaria transmission, and the efficacy of interventions designed
## Age group rendering
-First, we'll establish a base set of parameters using the `get_parameters()` function and accept the default values. The `run_simulation()` function's default behaviour is to output only the number of individuals aged 2-10 years old (`output$n_730_3650`, where 730 and 3650 are the ages in days). However, the user can instruct the model to output the number of individuals in age groups of their choosing using the `age_group_rendering_min_ages` and `age_group_rendering_max_ages` parameters. These arguments take vectors containing the minimum and maximum ages (in daily time steps) of each age group to be rendered. To allow us to see the effect of changing demographic parameters, we'll use this functionality to output the number of individuals in ages groups ranging from 0 to 85 at 5 year intervals. Note that the same is possible for other model outputs using their equivalent min/max age-class rendering arguments (`n_detect` , `p_detect`, `n_severe`, `n_inc`, `p_inc`, `n_inc_clinical`, `p_inc_clinical`, `n_inc_severe`, and `p_inc_severe`, run `?run_simulation()` for more detail).
+First, we'll establish a base set of parameters using the `get_parameters()` function and accept the default values. The `run_simulation()` function's default behaviour is to output only the number of individuals aged 2-10 years old (`output$n_age_730_3650`, where 730 and 3650 are the ages in days). However, the user can instruct the model to output the number of individuals in age groups of their choosing using the `age_group_rendering_min_ages` and `age_group_rendering_max_ages` parameters. These arguments take vectors containing the minimum and maximum ages (in daily time steps) of each age group to be rendered. To allow us to see the effect of changing demographic parameters, we'll use this functionality to output the number of individuals in ages groups ranging from 0 to 85 at 5 year intervals. Note that the same is possible for other model outputs using their equivalent min/max age-class rendering arguments (`n_detect` , `p_detect`, `n_severe`, `n_inc`, `p_inc`, `n_inc_clinical`, `p_inc_clinical`, `n_inc_severe`, and `p_inc_severe`, run `?run_simulation()` for more detail).
We next use the `set_equilibrium()` function to tune the initial parameter set to those required to observe the specified initial entomological inoculation rate (`starting_EIR`) at equilibrium. We now have a set of default parameters ready to use to run simulations.
diff --git a/vignettes/EIRprevmatch.Rmd b/vignettes/EIRprevmatch.Rmd
index f519faa5..cdf46b21 100644
--- a/vignettes/EIRprevmatch.Rmd
+++ b/vignettes/EIRprevmatch.Rmd
@@ -117,7 +117,7 @@ simparams <- set_clinical_treatment(parameters = simparams,
Having established a set of `malariasimulation` parameters, we are now ready to run simulations. In the following code chunk, we'll run the `run_simulation()` function across a range of initial EIR values to generate sufficient points to fit a curve matching *Pf*PR~2-10~ to the initial EIR. For each initial EIR, we first use the `set_equilibrium()` to update the model parameter list with the human and vector population parameter values required to achieve the specified EIR at equilibrium. This updated parameter list is then used to run the simulation.
-The `run_simulation()` outputs an EIR per time step, per species, across the entire human population. We first convert these to get the number of infectious bites experienced, on average, by each individual across the final year across all vector species. Next, the average *Pf*PR~2-10~ across the final year of the simulation is calculated by dividing the total number of individuals aged 2-10 by the number (`n_730_3650`) of detectable cases of malaria in individuals aged 2-10 (`n_detect_730_3650`) on each day and calculating the mean of these values. Finally, initial EIR, output EIR, and *Pf*PR~2-10~ are stored in a data frame.
+The `run_simulation()` outputs an EIR per time step, per species, across the entire human population. We first convert these to get the number of infectious bites experienced, on average, by each individual across the final year across all vector species. Next, the average *Pf*PR~2-10~ across the final year of the simulation is calculated by dividing the total number of individuals aged 2-10 by the number (`n_age_730_3650`) of detectable cases of malaria in individuals aged 2-10 (`n_detect_lm_730_3650`) on each day and calculating the mean of these values. Finally, initial EIR, output EIR, and *Pf*PR~2-10~ are stored in a data frame.
```{r}
# Establish a vector of initial EIR values to simulate over and generate matching
@@ -158,10 +158,10 @@ malSim_prev <- lapply(
mean(
output[
output$timestep %in% seq(4 * 365, 5 * 365),
- 'n_detect_730_3650'
+ 'n_detect_lm_730_3650'
] / output[
output$timestep %in% seq(4 * 365, 5 * 365),
- 'n_730_3650'
+ 'n_age_730_3650'
]
)
}
@@ -276,7 +276,7 @@ library(cali)
summary_mean_pfpr_2_10 <- function (x) {
# Calculate the PfPR2-10:
- prev_2_10 <- mean(x$n_detect_730_3650/x$n_730_3650)
+ prev_2_10 <- mean(x$n_detect_lm_730_3650/x$n_age_730_3650)
# Return the calculated PfPR2-10:
return(prev_2_10)
@@ -325,8 +325,8 @@ malsim_sim <- run_simulation(timesteps = (simparams_malsim$timesteps),
parameters = simparams_malsim)
# Extract the PfPR2-10 values for the cali and malsim simulation outputs:
-cali_pfpr2_10 <- cali_sim$n_detect_730_3650 / cali_sim$n_730_3650
-malsim_pfpr2_10 <- malsim_sim$n_detect_730_3650 / malsim_sim$n_730_3650
+cali_pfpr2_10 <- cali_sim$n_detect_lm_730_3650 / cali_sim$n_age_730_3650
+malsim_pfpr2_10 <- malsim_sim$n_detect_lm_730_3650 / malsim_sim$n_age_730_3650
# Store the PfPR2-10 in each time step for the two methods:
df <- data.frame(timestep = seq(1, length(cali_pfpr2_10)),
diff --git a/vignettes/MDA.Rmd b/vignettes/MDA.Rmd
index d464c533..2da93a6e 100644
--- a/vignettes/MDA.Rmd
+++ b/vignettes/MDA.Rmd
@@ -143,7 +143,7 @@ plot.new(); par(mar = c(4, 4, 1, 1), new = TRUE)
# Plot malaria prevalence in 2-10 years through time:
plot(x = mda_output$timestep,
- y = mda_output$n_detect_730_3650/mda_output$n_730_3650,
+ y = mda_output$n_detect_lm_730_3650/mda_output$n_age_730_3650,
xlab = "Time (days)",
ylab = expression(paste(italic(Pf),"PR"[2-10])), cex = 0.8,
ylim = c(0, 1), type = "l", lwd = 2, xaxs = "i", yaxs = "i",
@@ -151,7 +151,7 @@ plot(x = mda_output$timestep,
# Add the dynamics for no-intervention simulation
lines(x = noint_output$timestep,
- y = noint_output$n_detect_730_3650/noint_output$n_730_3650,
+ y = noint_output$n_detect_lm_730_3650/noint_output$n_age_730_3650,
col = cols[4])
# Add vlines to indicate when SP-AQ were administered:
@@ -282,7 +282,7 @@ legend("topleft",
plot.new(); par(new = TRUE, mar = c(4, 4, 1, 1))
# Plot malaria prevalence in 2-10 years through time:
-plot(x = smc_output$timestep, y = smc_output$n_detect_730_3650/smc_output$n_730_3650,
+plot(x = smc_output$timestep, y = smc_output$n_detect_lm_730_3650/smc_output$n_age_730_3650,
xlab = "Time (days)",
ylab = expression(paste(italic(Pf),"PR"[2-10])), cex = 0.8,
ylim = c(0, 1), type = "l", lwd = 2, xaxs = "i", yaxs = "i",
@@ -290,7 +290,7 @@ plot(x = smc_output$timestep, y = smc_output$n_detect_730_3650/smc_output$n_730_
# Add the dynamics for no-intervention simulation
lines(x = noint_output$timestep,
- y = noint_output$n_detect_730_3650/noint_output$n_730_3650,
+ y = noint_output$n_detect_lm_730_3650/noint_output$n_age_730_3650,
col = cols[4])
# Add lines to indicate SMC events:
@@ -305,4 +305,4 @@ legend("topleft",
legend = c("SMC", "No-Int"),
col= c(cols[3:4]), box.col = "white",
lwd = 1, lty = c(1, 1), cex = 0.8)
-```
\ No newline at end of file
+```
diff --git a/vignettes/Metapopulation.Rmd b/vignettes/Metapopulation.Rmd
index bece7840..0f3bf776 100644
--- a/vignettes/Metapopulation.Rmd
+++ b/vignettes/Metapopulation.Rmd
@@ -85,7 +85,12 @@ metapop_loop <- function(mixing, mixnam){ # mixing matrix
output <- run_metapop_simulation(timesteps = sim_length,
parameters = paramslist,
correlations = NULL,
- mixing = mixing)
+ mixing_tt = 1,
+ export_mixing = list(mixing),
+ import_mixing = list(mixing),
+ p_captured = list(matrix(rep(0, 9), nrow = 3, ncol = 3)),
+ p_captured_tt = 1,
+ p_success = 0.95)
# convert to dataframe and label EIR and mixing matrix type
output <- do.call('rbind', output)
@@ -107,7 +112,7 @@ output3$mix <- 'perfectly-mixed'
output <- rbind(output1, output2, output3)
# get mean PfPR 2-10 by year
-output$prev2to10 = output$p_detect_730_3650 / output$n_730_3650
+output$prev2to10 = output$p_detect_lm_730_3650 / output$n_age_730_3650
output$year = ceiling(output$timestep / 365)
output$mix = factor(output$mix, levels = c('isolated', 'semi-mixed', 'perfectly-mixed'))
output <- aggregate(prev2to10 ~ mix + EIR + year, data = output, FUN = mean)
diff --git a/vignettes/Model.Rmd b/vignettes/Model.Rmd
index c09932c2..3a9c4a32 100644
--- a/vignettes/Model.Rmd
+++ b/vignettes/Model.Rmd
@@ -153,9 +153,9 @@ The `run_simulation()` function then simulates malaria transmission dynamics and
- `id_mean`: mean immunity from detected using microscopy
- `iva_mean`: mean acquired immunity to severe infection
- `ivm_mean`: mean maternal immunity to severe infection
-- `n_730_3650`: population size of an age group of interest (where the default is set to 730-3650 days old, or 2-10 years, but which may be adjusted (see [Demography](https://mrc-ide.github.io/malariasimulation/articles/Demography.html) vignette for more details)
-- `n_detect_730_3650`: number with possible detection through microscopy of a given age group
-- `p_detect_730_3650`: the sum of probabilities of detection through microscopy of a given age group
+- `n_age_730_3650`: population size of an age group of interest (where the default is set to 730-3650 days old, or 2-10 years, but which may be adjusted (see [Demography](https://mrc-ide.github.io/malariasimulation/articles/Demography.html) vignette for more details)
+- `n_detect_lm_730_3650`: number with possible detection through microscopy of a given age group
+- `p_detect_lm_730_3650`: the sum of probabilities of detection through microscopy of a given age group
- `E_gamb_count`, `L_gamb_count`, `P_gamb_count`, `Sm_gamb_count`, `Pm_gamb_count`, `Im_gamb_count`: species-specific mosquito population sizes in each state (default set to *An. gambiae*)
- `total_M_gamb`: species-specific number of adult mosquitoes (default set to *An. gambiae*)
@@ -173,7 +173,7 @@ Where **treatments** are specified, `n_treated` will report the number that have
### Output visualisation
-These outputs can then be visualised, such as the population changes in states. Another key output is the prevalence of detectable infections between the ages of 2-10 (*Pf*PR~2-10~), which can be obtained by dividing `n_detect_730_3650` by `n_730_3650`.
+These outputs can then be visualised, such as the population changes in states. Another key output is the prevalence of detectable infections between the ages of 2-10 (*Pf*PR~2-10~), which can be obtained by dividing `n_detect_lm_730_3650` by `n_age_730_3650`.
```{r, fig.align = 'center', out.width='100%', fig.asp=0.55, }
# Define vector of column names to plot
@@ -202,7 +202,7 @@ par(mfrow = c(1,2))
states_plot(test_sim)
# Calculate Pf PR 2-10
-test_sim$PfPR2_10 <- test_sim$n_detect_730_3650/test_sim$n_730_3650
+test_sim$PfPR2_10 <- test_sim$n_detect_lm_730_3650/test_sim$n_age_730_3650
# Plot Pf PR 2-10
plot(x = test_sim$timestep, y = test_sim$PfPR2_10, type = "l",
@@ -226,7 +226,7 @@ par(mfrow = c(1,2))
states_plot(test_sim_eq)
# Calculate Pf PR 2-10
-test_sim_eq$PfPR2_10 <- test_sim_eq$n_detect_730_3650/test_sim_eq$n_730_3650
+test_sim_eq$PfPR2_10 <- test_sim_eq$n_detect_lm_730_3650/test_sim_eq$n_age_730_3650
# Plot Pf PR 2-10
plot(x = test_sim_eq$timestep, y = test_sim_eq$PfPR2_10, type = "l",
diff --git a/vignettes/Parameter_variation.Rmd b/vignettes/Parameter_variation.Rmd
index a0eef828..eec04fd7 100644
--- a/vignettes/Parameter_variation.Rmd
+++ b/vignettes/Parameter_variation.Rmd
@@ -40,7 +40,7 @@ sim <- run_simulation(timesteps = 1000, simparams)
# plot the default median parameter
plot(
sim$timestep,
- sim$n_detect_730_3650 / sim$n_730_3650,
+ sim$n_detect_lm_730_3650 / sim$n_age_730_3650,
t = "l",
ylim = c(0, 1),
ylab = "PfPr",
@@ -60,7 +60,7 @@ Keep in mind that `set_parameter_draw` must be called prior to `set_equilibrium`
# plot the default median parameter
plot(
sim$timestep[1:500],
- sim$n_detect_730_3650[1:500] / sim$n_730_3650[1:500],
+ sim$n_detect_lm_730_3650[1:500] / sim$n_age_730_3650[1:500],
t = "l",
ylim = c(0, 1),
ylab = "PfPr",
@@ -78,9 +78,9 @@ for (i in 1:7) {
sim <- run_simulation(timesteps = 500, param_draw)
- lines(sim$timestep, sim$n_detect_730_3650 / sim$n_730_3650, col = cols[i])
+ lines(sim$timestep, sim$n_detect_lm_730_3650 / sim$n_age_730_3650, col = cols[i])
}
```
-For more information on uncertainty in parameters, please refer to [The US President's Malaria Initiative, Plasmodium falciparum transmission and mortality: A modelling study](https://journals.plos.org/plosmedicine/article?id=10.1371/journal.pmed.1002448), Supplemental material, Section 4.
\ No newline at end of file
+For more information on uncertainty in parameters, please refer to [The US President's Malaria Initiative, Plasmodium falciparum transmission and mortality: A modelling study](https://journals.plos.org/plosmedicine/article?id=10.1371/journal.pmed.1002448), Supplemental material, Section 4.
diff --git a/vignettes/SetSpecies.Rmd b/vignettes/SetSpecies.Rmd
index 10b1676d..762a3ccf 100644
--- a/vignettes/SetSpecies.Rmd
+++ b/vignettes/SetSpecies.Rmd
@@ -40,11 +40,11 @@ We will create a plotting function to visualise the output.
```{r}
# Plotting functions
plot_prev <- function() {
- plot(x = output_endophilic$timestep, y = output_endophilic$n_detect_730_3650 / output_endophilic$n_730_3650,
+ plot(x = output_endophilic$timestep, y = output_endophilic$n_detect_lm_730_3650 / output_endophilic$n_age_730_3650,
type = "l", col = cols[3], lwd = 1,
xlab = "Time (days)", ylab = expression(paste(italic(Pf),"PR"[2-10])),
xaxs = "i", yaxs = "i", ylim = c(0,1))
- lines(x = output_exophilic$timestep, y = output_exophilic$n_detect_730_3650 / output_exophilic$n_730_3650,
+ lines(x = output_exophilic$timestep, y = output_exophilic$n_detect_lm_730_3650 / output_exophilic$n_age_730_3650,
col = cols[5], lwd = 1)
abline(v = sprayingtimesteps, lty = 2, lwd = 2.5, col = "black")
text(x = sprayingtimesteps + 10, y = 0.9, labels = "Spraying\nint.", adj = 0, cex = 0.8)
diff --git a/vignettes/Treatment.Rmd b/vignettes/Treatment.Rmd
index d325aa74..03efa301 100644
--- a/vignettes/Treatment.Rmd
+++ b/vignettes/Treatment.Rmd
@@ -124,20 +124,20 @@ output <- run_simulation(sim_length, treatment_params)
### Visualisation
-Following simulation of malaria transmission under this treatment regimen, we can now visualise the effect of the regimen on the number of detectable cases through time using the `n_detect_730_3650`.
+Following simulation of malaria transmission under this treatment regimen, we can now visualise the effect of the regimen on the number of detectable cases through time using the `n_detect_lm_730_3650`.
```{r, fig.align = 'center', out.width='100%'}
# Plot results
-plot(x = output$timestep, y = output$n_detect_730_3650, type = "l",
+plot(x = output$timestep, y = output$n_detect_lm_730_3650, type = "l",
xlab = "Days", ylab = "Detectable cases", col = cols[1],
- ylim = c(min(output$n_detect_730_3650)-1, max(output$n_detect_730_3650)+7),
+ ylim = c(min(output$n_detect_lm_730_3650)-1, max(output$n_detect_lm_730_3650)+7),
xaxs = "i", yaxs = "i")
# Show treatment times
abline(v = 300, lty = 2)
-text(x = 310, y = max(output$n_detect_730_3650), labels = "Treatment\nbegins", adj = 0, cex = 0.8)
+text(x = 310, y = max(output$n_detect_lm_730_3650), labels = "Treatment\nbegins", adj = 0, cex = 0.8)
abline(v = 600, lty = 2)
-text(x = 610, y = max(output$n_detect_730_3650), labels = "Treatment\nends", adj = 0, cex = 0.8)
+text(x = 610, y = max(output$n_detect_lm_730_3650), labels = "Treatment\nends", adj = 0, cex = 0.8)
# Add grid lines
grid(lty = 2, col = "grey80", nx = 11, ny = 10, lwd = 0.5)
diff --git a/vignettes/Vaccines.Rmd b/vignettes/Vaccines.Rmd
index 51bffd0e..b36f09ca 100644
--- a/vignettes/Vaccines.Rmd
+++ b/vignettes/Vaccines.Rmd
@@ -37,9 +37,9 @@ plot_inci <- function(type = "not seasonal"){
comparison <- output_control
vaccinetime <- 1
}
- output$clinical_incidence <- 1000 * output$n_inc_clinical_0_1825 / output$n_0_1825
+ output$clinical_incidence <- 1000 * output$n_inc_clinical_0_1825 / output$n_age_0_1825
output$time_year <- output$timestep / year
- comparison$clinical_incidence <- 1000 * comparison$n_inc_clinical_0_1825 / comparison$n_0_1825
+ comparison$clinical_incidence <- 1000 * comparison$n_inc_clinical_0_1825 / comparison$n_age_0_1825
comparison$time_year <- comparison$timestep / year
plot(x = output$time_year, y = output$clinical_incidence,
@@ -77,12 +77,12 @@ plot_prev <- function(type = "not seasonal"){
output$time_year <- output$timestep / year
comparison$time_year <- comparison$timestep / year
- plot(x = output$time_year, y = output$n_detect_730_3650/output$n_730_3650,
+ plot(x = output$time_year, y = output$n_detect_lm_730_3650/output$n_age_730_3650,
type = "l", col = cols[3], ylim=c(0,1), lwd = 3,
xlab = "Time (years)", ylab = expression(paste(italic(Pf),"PR"[2-10])),
xaxs = "i", yaxs = "i")
grid(lty = 2, col = "grey80", lwd = 0.5)
- lines(x = comparison$time_year, y = comparison$n_detect_730_3650/comparison$n_730_3650,
+ lines(x = comparison$time_year, y = comparison$n_detect_lm_730_3650/comparison$n_age_730_3650,
col = cols[6], lwd = 3)
abline(v = vaccinetime, col = "black", lty = 2, lwd = 2.5)
text(x = vaccinetime + 0.05, y = 0.9, labels = "Start of\nvaccination", adj = 0, cex = 0.8)
@@ -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.
)
@@ -388,7 +388,7 @@ plot_prev()
```{r, fig.align = 'center', out.width='100%', message=FALSE}
# Plot doses
output$month <- ceiling(output$timestep / month)
-doses <- output[, c(2:6, 38)]
+doses <- output[, c(grep(pattern = "n_pev", x = names(output), value = T), "month")]
doses <- aggregate(cbind(doses[1:5]),
by = list(doses$month),
FUN = sum)
diff --git a/vignettes/Variation.Rmd b/vignettes/Variation.Rmd
index 7146d47f..10da8a80 100644
--- a/vignettes/Variation.Rmd
+++ b/vignettes/Variation.Rmd
@@ -29,7 +29,7 @@ plot_prev <- function(output, ylab = TRUE, ylim = c(0,1)){
if (ylab == TRUE) {
ylab = "Prevalence in children aged 2-10 years"
} else {ylab = ""}
- plot(x = output$timestep, y = output$n_detect_730_3650 / output$n_730_3650,
+ plot(x = output$timestep, y = output$n_detect_lm_730_3650 / output$n_age_730_3650,
type = "l", col = cols[3], ylim = ylim,
xlab = "Time (days)", ylab = ylab, lwd = 1,
xaxs = "i", yaxs = "i")
@@ -40,7 +40,7 @@ plot_inci <- function(output, ylab = TRUE, ylim){
if (ylab == TRUE) {
ylab = "Incidence per 1000 children aged 0-5 years"
} else {ylab = ""}
- plot(x = output$timestep, y = output$n_inc_clinical_0_1825 / output$n_0_1825 * 1000,
+ plot(x = output$timestep, y = output$n_inc_clinical_0_1825 / output$n_age_0_1825 * 1000,
type = "l", col = cols[5], ylim = ylim,
xlab = "Time (days)", ylab = ylab, lwd = 1,
xaxs = "i", yaxs = "i")
@@ -49,7 +49,7 @@ plot_inci <- function(output, ylab = TRUE, ylim){
aggregate_function <- function(df){
tmp <- aggregate(
- df$n_detect_730_3650,
+ df$n_detect_lm_730_3650,
by=list(df$timestep),
FUN = function(x) {
c(median = median(x),
@@ -108,7 +108,7 @@ simparams_big <- set_equilibrium(parameters = simparams_big, init_EIR = 50)
### Simulations
-The `n_detect_730_3650` output below shows the total number of individuals in the age group rendered (here, 730-3650 timesteps or 2-10 years) who have microscopy-detectable malaria. Notice that the output is smoother at a higher population.
+The `n_detect_lm_730_3650` output below shows the total number of individuals in the age group rendered (here, 730-3650 timesteps or 2-10 years) who have microscopy-detectable malaria. Notice that the output is smoother at a higher population.
Some outcomes will be more sensitive than others to stochastic variation even with the same population size. In the plots below, prevalence is smoother than incidence even at the same population. This is because prevalence is a measure of existing infection, while incidence is recording new cases per timestep.
diff --git a/vignettes/VectorControl_Bednets.Rmd b/vignettes/VectorControl_Bednets.Rmd
index ae6a62c4..f8cf4dd9 100644
--- a/vignettes/VectorControl_Bednets.Rmd
+++ b/vignettes/VectorControl_Bednets.Rmd
@@ -30,11 +30,11 @@ We can create a few plotting functions to visualise the output.
```{r}
# Plotting functions
plot_prev <- function() {
- plot(x = output$timestep, y = output$n_detect_730_3650 / output$n_730_3650,
+ plot(x = output$timestep, y = output$n_detect_lm_730_3650 / output$n_age_730_3650,
type = "l", col = cols[3], lwd = 1,
xlab = "Time (days)", ylab = expression(paste(italic(Pf),"PR"[2-10])),
xaxs = "i", yaxs = "i", ylim = c(0, 1))
- lines(x = output_control$timestep, y = output_control$n_detect_730_3650 / output_control$n_730_3650,
+ lines(x = output_control$timestep, y = output_control$n_detect_lm_730_3650 / output_control$n_age_730_3650,
col = cols[5], lwd = 1)
abline(v = bednetstimesteps, col = "black", lty = 2, lwd = 1)
text(x = bednetstimesteps + 10, y = 0.95, labels = "Bed net int.", adj = 0, cex = 0.8)
diff --git a/vignettes/VectorControl_IRS.Rmd b/vignettes/VectorControl_IRS.Rmd
index 3cf8ab7e..1db0727d 100644
--- a/vignettes/VectorControl_IRS.Rmd
+++ b/vignettes/VectorControl_IRS.Rmd
@@ -30,11 +30,11 @@ We will create a few plotting functions to visualise the output.
```{r}
# Plotting functions
plot_prev <- function() {
- plot(x = output$timestep, y = output$n_detect_730_3650 / output$n_730_3650,
+ plot(x = output$timestep, y = output$n_detect_lm_730_3650 / output$n_age_730_3650,
type = "l", col = cols[3], lwd = 1,
xlab = "Time (days)", ylab = expression(paste(italic(Pf),"PR"[2-10])),
xaxs = "i", yaxs = "i", ylim = c(0,1))
- lines(x = output_control$timestep, y = output_control$n_detect_730_3650 / output_control$n_730_3650,
+ lines(x = output_control$timestep, y = output_control$n_detect_lm_730_3650 / output_control$n_age_730_3650,
col = cols[5], lwd = 1)
abline(v = sprayingtimesteps, lty = 2, lwd = 1, col = "black")
text(x = sprayingtimesteps + 10, y = 0.9, labels = "Spraying\nint.", adj = 0, cex = 0.8)