diff --git a/.Rbuildignore b/.Rbuildignore
index 1a56f843..3e91f6fd 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -10,3 +10,5 @@ LICENSE.md
codecov.yml
.github
^data-raw$
+^doc$
+^Meta$
diff --git a/.gitignore b/.gitignore
index ee50e62b..eb4ff0ee 100644
--- a/.gitignore
+++ b/.gitignore
@@ -10,3 +10,5 @@ malariasimulation_*.tar.gz
/build/
doc
inst/doc
+/doc/
+/Meta/
diff --git a/DESCRIPTION b/DESCRIPTION
index c718bcd4..74445497 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: malariasimulation
Title: An individual based model for malaria
-Version: 1.6.0
+Version: 1.6.1
Authors@R: c(
person(
given = "Giovanni",
@@ -32,6 +32,30 @@ Authors@R: c(
role = c('aut'),
email = 'r.fitzjohn@imperial.ac.uk'
),
+ person(
+ given = "Richard",
+ family = "Sheppard",
+ role = c('aut'),
+ email = 'r.sheppard11@imperial.ac.uk'
+ ),
+ person(
+ given = "Tom",
+ family = "Brewer",
+ role = c('aut'),
+ email = 'thomas.brewer16@imperial.ac.uk'
+ ),
+ person(
+ given = "Kelly",
+ family = "McCain",
+ role = c('aut'),
+ email = 'k.mccain22@imperial.ac.uk'
+ ),
+ person(
+ given = "Lydia",
+ family = "Haile",
+ role = c('aut'),
+ email = 'l.haile@imperial.ac.uk'
+ ),
person(
given = "Imperial College of Science, Technology and Medicine",
family = "",
@@ -45,13 +69,15 @@ LazyData: true
Remotes:
mrc-ide/malariaEquilibrium,
mrc-ide/individual
+Additional_repositories:
+ https://mrc-ide.r-universe.dev
Imports:
- individual (>= 0.1.7),
+ individual (>= 0.1.16),
malariaEquilibrium (>= 1.0.1),
Rcpp,
statmod,
MASS,
- dqrng,
+ dqrng (>= 0.3.2.2),
sitmo,
BH,
R6,
@@ -67,7 +93,7 @@ Suggests:
ggplot2,
covr,
mgcv
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
Roxygen: list(markdown = TRUE)
LinkingTo:
Rcpp,
diff --git a/NAMESPACE b/NAMESPACE
index 4fd1b1da..4ba1e15d 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -18,6 +18,7 @@ export(rtss_profile)
export(run_metapop_simulation)
export(run_simulation)
export(run_simulation_with_repetitions)
+export(set_antimalarial_resistance)
export(set_bednets)
export(set_carrying_capacity)
export(set_clinical_treatment)
diff --git a/NEWS.md b/NEWS.md
index 5d619abd..860567da 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,12 +1,20 @@
-# malariasimulation 1.6.0
+# malariasimulation 1.6.1 (wip)
- * Fix MDA bug where undetectable asymptomatics are treated
+ * 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.5.0
+# malariasimulation 1.6.0
+ * Fix MDA bug where undetectable asymptomatics are treated
+ * New vignettes
+ * Progress bar for long simulations
+ * Individual mosquitoes off by default
* New vaccination code:
* pre-erythrocytic vaccine functions have been renamed to pev
* pev functions have PEVProfiles for alternate pev vaccines and boosters
+ * Specify carrying capacity over time
# malariasimulation 1.4.0
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..801aea20 100644
--- a/R/biting_process.R
+++ b/R/biting_process.R
@@ -103,7 +103,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)
@@ -167,7 +167,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 +189,7 @@ simulate_bites <- function(
)
} else {
adult_mosquito_model_update(
- models[[s_i]],
+ models[[s_i]]$.model,
mu,
foim,
solver_states[[ADULT_ODE_INDICES['Sm']]],
@@ -235,7 +235,7 @@ 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(
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/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..d9ac11e4 100644
--- a/R/disease_progression.R
+++ b/R/disease_progression.R
@@ -19,15 +19,27 @@ update_infection <- function(
}
create_progression_process <- function(
- state,
- from_state,
- to_state,
- rate,
- infectivity,
- new_infectivity
- ) {
+ state,
+ from_state,
+ to_state,
+ rate,
+ infectivity,
+ new_infectivity
+) {
function(timestep) {
- to_move <- state$get_index_of(from_state)$sample(1/rate)
+
+ # Retrieve the indices of all individuals in the to_move state:
+ index <- state$get_index_of(from_state)
+
+ # If the length of rate is greater than 1 (when it's a variable):
+ if (inherits(rate, "DoubleVariable")) {
+ rate <- rate$get_values(index)
+ }
+
+ # Sample the individuals to be moved into a new Bitset using the transition rate(s):
+ to_move <- index$sample(1/rate)
+
+ # Update the infection status of those individuals who are moving:
update_infection(
state,
to_state,
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..d62b16f0 100644
--- a/R/human_infection.R
+++ b/R/human_infection.R
@@ -129,9 +129,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(
@@ -262,23 +263,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 +294,80 @@ 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)
+
+ #+++ DRUG EFFICACY +++#
+ #+++++++++++++++++++++#
+ effectively_treated_index <- bernoulli_multi_p(parameters$drug_efficacy[drugs])
+ effectively_treated <- bitset_at(seek_treatment, effectively_treated_index)
+ drugs <- drugs[effectively_treated_index]
+ n_drug_efficacy_failures <- n_treat - effectively_treated$size()
+ renderer$render('n_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('n_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('n_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('n_successfully_treated', successfully_treated$size(), timestep)
+ dt_slow_parasite_clearance <- dt_slow_parasite_clearance[slow_parasite_clearance_indices]
+
+ } else {
+
+ successfully_treated <- effectively_treated
+ renderer$render('n_successfully_treated', successfully_treated$size(), timestep)
+
+ }
+
+ if (successfully_treated$size() > 0) {
+ variables$state$queue_update("Tr", successfully_treated)
variables$infectivity$queue_update(
- parameters$cd * parameters$drug_rel_c[drugs[successful]],
- treated_index
+ parameters$cd * parameters$drug_rel_c[drugs],
+ successfully_treated
)
variables$drug$queue_update(
- drugs[successful],
- treated_index
+ drugs,
+ successfully_treated
)
variables$drug_time$queue_update(
timestep,
- treated_index
+ successfully_treated
)
+ if(parameters$antimalarial_resistance) {
+ variables$dt$queue_update(
+ parameters$dt,
+ non_slow_parasite_clearance_individuals
+ )
+ variables$dt$queue_update(
+ dt_slow_parasite_clearance,
+ slow_parasite_clearance_individuals
+ )
+ }
}
- treated_index
+
+ successfully_treated
+
}
#' @title Schedule infections
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..72cbe779 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
@@ -14,7 +13,6 @@
#' @noRd
create_mda_listeners <- function(
variables,
- administer_event,
drug,
timesteps,
coverages,
@@ -78,11 +76,6 @@ create_mda_listeners <- function(
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)
- }
}
}
diff --git a/R/model.R b/R/model.R
index 48af9af9..67f79758 100644
--- a/R/model.R
+++ b/R/model.R
@@ -74,6 +74,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 +88,28 @@ 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.
+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)) {
@@ -105,7 +131,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 +159,31 @@ run_simulation <- function(
vector_models,
solvers,
correlations,
- list(create_lagged_eir(variables, solvers, parameters)),
- list(create_lagged_infectivity(variables, parameters))
+ list(lagged_eir),
+ list(lagged_infectivity),
+ timesteps
),
variables = variables,
- events = unlist(events),
- timesteps = timesteps
+ events = events,
+ timesteps = timesteps,
+ state = initial_state$individual,
+ restore_random_state = restore_random_state
)
- renderer$to_dataframe()
+
+ final_state <- list(
+ timesteps = timesteps,
+ individual = individual_state,
+ malariasimulation = individual::save_object_state(stateful_objects)
+ )
+
+ 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
@@ -206,6 +268,7 @@ run_metapop_simulation <- function(
correlations[[i]],
lagged_eir,
lagged_infectivity,
+ timesteps,
mixing[i,],
i
)
@@ -248,4 +311,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..37792f6c 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,12 +106,18 @@ 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)
+
+ # treated compartment residence time:
+ if(!is.null(variables$dt)) {
+ variables$dt$queue_update(parameters$dt, 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/parameters.R b/R/parameters.R
index 65779314..647b78b2 100644
--- a/R/parameters.R
+++ b/R/parameters.R
@@ -11,14 +11,14 @@
#' 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 = 0.1253333
+#' * mum - the rate at which developed mosquitoes die; default (An. gambiae) = .132
#'
#' immunity decay rates:
#'
@@ -135,9 +135,9 @@
#' * 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
-#' * species - names of the species in the simulation; default = "All"
+#' * species - names of the species in the simulation; default = "gamb"
#' * species_proportions - the relative proportions of each species; default = 1
-#' * blood_meal_rates - the blood meal rates for each species; default = 0.3333333333
+#' * blood_meal_rates - the blood meal rates for each species; default = 1/3
#' * Q0 - proportion of blood meals taken on humans; default = 0.92
#' * foraging_time - time spent taking blood meals; default = 0.69
#'
@@ -192,6 +192,22 @@
#' * 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
+#' `antimalarial_resistance.R: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
@@ -234,7 +250,7 @@ get_parameters <- function(overrides = list()) {
dl = 3.72,
dpl = .643,
mup = .249,
- mum = .1253333,
+ mum = .132,
sigma_squared = 1.67,
n_heterogeneity_groups = 5,
# immunity decay rates
@@ -317,8 +333,8 @@ get_parameters <- function(overrides = list()) {
beta = 21.2,
total_M = 1000,
init_foim= 0,
- # order of species: An gambiae s.s, An arabiensis, An funestus
- species = 'All',
+ # species-specific vector biology (default is An. gambiae s.s)
+ species = 'gamb',
species_proportions = 1,
blood_meal_rates = 1/3,
Q0 = .92,
@@ -377,6 +393,18 @@ get_parameters <- function(overrides = list()) {
tbv_timesteps = NULL,
tbv_coverages = NULL,
tbv_ages = 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,
# flexible carrying capacity
carrying_capacity = FALSE,
carrying_capacity_timesteps = NULL,
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 e54967fb..a9509f96 100644
--- a/R/pev_parameters.R
+++ b/R/pev_parameters.R
@@ -62,9 +62,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,13 +72,11 @@ rtss_booster_profile <- create_pev_profile(
#' between an individual receiving the final dose and the first booster. When using
#' both set_mass_pev and set_pev_epi, this represents the minimum time between
#' an individual being vaccinated under one scheme and vaccinated under another.
-#' @param booster_timestep the timesteps (following the final dose) at which booster vaccinations are administered
-#' @param booster_coverage the proportion of the vaccinated population who will
-#' receive each booster vaccine
-#' @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,
@@ -87,33 +85,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
@@ -126,7 +138,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
@@ -140,7 +152,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);
@@ -148,11 +160,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 who will
-#' receive each booster vaccine
-#' @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,
@@ -162,7 +172,7 @@ set_mass_pev <- function(
min_ages,
max_ages,
min_wait,
- booster_timestep,
+ booster_spacing,
booster_coverage,
booster_profile
) {
@@ -170,13 +180,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
@@ -191,29 +216,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/processes.R b/R/processes.R
index cb6674e7..12f8c3db 100644
--- a/R/processes.R
+++ b/R/processes.R
@@ -14,6 +14,7 @@
#' 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_index an index for this population's position in the
@@ -29,6 +30,7 @@ create_processes <- function(
correlations,
lagged_eir,
lagged_infectivity,
+ timesteps,
mixing = 1,
mixing_index = 1
) {
@@ -101,12 +103,32 @@ create_processes <- function(
parameters$du,
variables$infectivity,
0
- ),
+ )
+ )
+
+ # =======================
+ # Antimalarial Resistance
+ # =======================
+ # Add an a new process which governs the transition from Tr to S when
+ # antimalarial resistance is simulated. The rate of transition switches
+ # from a parameter to a variable when antimalarial resistance == TRUE.
+
+ # Assign the dt input to a separate object with the default single parameter value:
+ dt_input <- parameters$dt
+
+ # If antimalarial resistance is switched on, assign dt variable values to the
+ if(parameters$antimalarial_resistance) {
+ dt_input <- variables$dt
+ }
+
+ # Create the progression process for Tr --> S specifying dt_input as the rate:
+ processes <- c(
+ processes,
create_progression_process(
variables$state,
'Tr',
'S',
- parameters$dt,
+ dt_input,
variables$infectivity,
0
)
@@ -263,8 +285,9 @@ 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
diff --git a/R/render.R b/R/render.R
index 3fcf4882..60cb5b73 100644
--- a/R/render.R
+++ b/R/render.R
@@ -146,7 +146,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)
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..2262c939 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -64,3 +64,27 @@ rtexp <- function(n, m, t) { itexp(runif(n), m, t) }
match_timestep <- function(ts, t) {
min(sum(ts <= t), length(ts))
}
+
+#' @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)
+ }
+ }
+ )
+)
diff --git a/R/variables.R b/R/variables.R
index c5825606..092a6431 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
@@ -87,7 +93,7 @@ create_variables <- function(parameters) {
}
states <- c('S', 'D', 'A', 'U', 'Tr')
- initial_states <- initial_state(parameters, initial_age, groups, eq)
+ initial_states <- initial_state(parameters, initial_age, groups, eq, states)
state <- individual::CategoricalVariable$new(states, initial_states)
birth <- individual::IntegerVariable$new(-initial_age)
last_boosted_ib <- individual::DoubleVariable$new(rep(-1, size))
@@ -188,7 +194,8 @@ create_variables <- function(parameters) {
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))
@@ -215,12 +222,22 @@ create_variables <- function(parameters) {
infectivity = infectivity,
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 antimalarial resistance state residency times (dt)
+ if(parameters$antimalarial_resistance) {
+ dt <- individual::DoubleVariable$new(rep(parameters$dt, size))
+ variables <- c(
+ variables,
+ dt = dt
+ )
+ }
# Add variables for individual mosquitoes
if (parameters$individual_mosquitoes) {
@@ -316,10 +333,10 @@ initial_immunity <- function(
rep(parameter, length(age))
}
-initial_state <- function(parameters, age, groups, eq) {
- ibm_states <- c('S', 'A', 'D', 'U', 'Tr')
+initial_state <- function(parameters, age, groups, eq, states) {
+ ibm_states <- states
if (!is.null(eq)) {
- eq_states <- c('S', 'A', 'D', 'U', 'T')
+ eq_states <- c('S', 'D', 'A', 'U', 'T')
age <- age / 365
return(vcapply(
seq_along(age),
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 6d8f5915..b86f6ac3 100644
--- a/README.md
+++ b/README.md
@@ -63,6 +63,8 @@ library('malariasimulation')
output <- run_simulation(100)
```
+Please see [vignettes](https://mrc-ide.github.io/malariasimulation/articles/Model.html) for more detailed use.
+
## Code organisation
*model.R* - is the entry point for the model. It creates the different
diff --git a/_pkgdown.yml b/_pkgdown.yml
index 6ef5f5a6..28a83e81 100644
--- a/_pkgdown.yml
+++ b/_pkgdown.yml
@@ -1 +1,101 @@
destination: docs
+
+navbar:
+ title: "malariasimulation"
+ structure:
+ left: [vignettes, functions, news]
+ right: [icon]
+ components:
+ vignettes:
+ text: "Vignettes"
+ menu:
+ - text: "Model Introduction"
+ href: articles/Model.html
+ - text: "Demography"
+ href: articles/Demography.html
+ - text: "Treatment"
+ href: articles/Treatment.html
+ - text: "MDA and Chemoprevention"
+ href: articles/MDA.html
+ - text: "Vaccines"
+ href: articles/Vaccines.html
+ - text: "Vector Control: Bednets"
+ href: articles/VectorControl_Bednets.html
+ - text: "Vector Control: Indoor Residual Spraying"
+ href: articles/VectorControl_IRS.html
+ - text: "Mosquito Species"
+ href: articles/SetSpecies.html
+ - text: "Carrying Capacity"
+ href: articles/Carrying-capacity.html
+ - text: "Matching PfPR2-10 to EIR"
+ href: articles/EIRprevmatch.html
+ - text: "Metapopulation Modelling"
+ href: articles/Metapopulation.html
+ - text: "Stochastic Variation"
+ href: articles/Variation.html
+ - text: "Parameter Variation"
+ href: articles/Parameter_variation.html
+ functions:
+ text: "Functions"
+ href: reference/index.html
+ icon:
+ icon: fa-github
+ href: https://github.com/mrc-ide/malariasimulation
+
+reference:
+- title: "Run functions"
+ contents:
+ - run_simulation
+ - run_metapop_simulation
+ - run_simulation_with_repetitions
+- title: "Parameter functions"
+ contents:
+ - get_parameters
+ - get_correlation_parameters
+ - set_parameter_draw
+ - set_equilibrium
+- title: "Demography functions"
+ contents:
+ - set_demography
+- title: "Mosquito species functions and parameters"
+ contents:
+ - set_species
+ - set_carrying_capacity
+ - arab_params
+ - fun_params
+ - gamb_params
+ - steph_params
+- title: "Intervention functions"
+- subtitle: "Drug treatments"
+ contents:
+ - set_drugs
+ - set_clinical_treatment
+ - AL_params
+ - DHA_PQP_params
+ - SP_AQ_params
+- subtitle: "MDA and chemoprevention"
+ contents:
+ - set_mda
+ - set_pmc
+ - set_smc
+ - peak_season_offset
+- subtitle: "Vaccines"
+ contents:
+ - set_mass_pev
+ - set_pev_epi
+ - set_tbv
+- subtitle: "Vector control"
+ contents:
+ - set_bednets
+ - set_spraying
+- title: "Non-user functions"
+ contents:
+ - CorrelationParameters
+ - create_pev_profile
+ - create_progress_process
+ - find_birthrates
+ - parameter_draws
+ - parameterise_mosquito_equilibrium
+ - parameterise_total_M
+ - rtss_booster_profile
+ - rtss_profile
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{}}\preformatted{CorrelationParameters$save_state()}\if{html}{\out{
}}
+}
+
+}
+\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{(42)) {};
};
diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
index affb233d..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) {
@@ -265,6 +353,8 @@ 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..d2b36043 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);
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..c739f7e7 100644
--- a/tests/testthat/test-biology.R
+++ b/tests/testthat/test-biology.R
@@ -92,13 +92,13 @@ test_that('FOIM is consistent with equilibrium', {
psi <- unique_biting_rate(age, parameters)
zeta <- variables$zeta$get_values()
.pi <- human_pi(psi, zeta)
- calculate_foim(a, sum(.pi * variables$infectivity$get_values()))
+ calculate_foim(a, sum(.pi * variables$infectivity$get_values()), 1.)
}
)
expect_equal(
expected_foim,
actual_foim,
- tolerance = 1e-4
+ tolerance = 1e-3
)
})
diff --git a/tests/testthat/test-biting-integration.R b/tests/testthat/test-biting-integration.R
index 8a076b96..7da79b66 100644
--- a/tests/testthat/test-biting-integration.R
+++ b/tests/testthat/test-biting-integration.R
@@ -84,8 +84,8 @@ test_that('simulate_bites integrates eir calculation and mosquito side effects',
c(rep('Im', 10), rep('Sm', 15), rep('NonExistent', 75))
)
variables$species <- individual::CategoricalVariable$new(
- c('All'),
- rep('All', 100)
+ c('gamb'),
+ rep('gamb', 100)
)
lambda_mock <- mockery::mock(c(.5, .5, .5, .5))
@@ -131,7 +131,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,
diff --git a/tests/testthat/test-compartmental.R b/tests/testthat/test-compartmental.R
index 410b3be4..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()
@@ -31,12 +36,8 @@ test_that('ODE stays at equilibrium with a constant total_M', {
})
test_that('Adult ODE stays at equilibrium with a constant foim and mu', {
- foim <- 0.5
- parameters <- get_parameters(list(
- individual_mosquitoes = FALSE,
- init_foim = foim
- ))
- total_M <- 1000
+ parameters <- get_parameters()
+ parameters <- set_equilibrium(parameters, 100.)
f <- parameters$blood_meal_rates
timesteps <- 365 * 10
models <- parameterise_mosquito_models(parameters, timesteps)
@@ -45,30 +46,29 @@ 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,
- foim,
+ parameters$init_foim,
states[ADULT_ODE_INDICES['Sm']],
f
)
- solver_step(solvers[[1]])
+ solvers[[1]]$step()
}
-
+
expected <- c()
equilibrium <- initial_mosquito_counts(
parameters,
1,
parameters$init_foim,
- total_M
+ parameters$total_M
)
for (t in seq(timesteps)) {
expected <- rbind(expected, c(t, equilibrium))
}
-
expect_equal(counts, expected, tolerance=1e-4)
})
@@ -87,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()
@@ -126,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-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-emergence-integration.R b/tests/testthat/test-emergence-integration.R
index 226ad484..bf452d2f 100644
--- a/tests/testthat/test-emergence-integration.R
+++ b/tests/testthat/test-emergence-integration.R
@@ -5,25 +5,22 @@ test_that('emergence process fails when there are not enough individuals', {
c(rep('Im', 1000), rep('Sm', 1000))
)
species <- individual::CategoricalVariable$new(
- c('All'),
- rep('All', 2000)
+ 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('All'),
+ 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..83d7def9 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,7 +15,7 @@ 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))
@@ -27,7 +27,7 @@ test_that('simulate_infection integrates different types of infection and schedu
treated <- individual::Bitset$new(population)$insert(3)
treated_mock <- mockery::mock(treated)
schedule_mock <- mockery::mock()
-
+
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)
@@ -45,7 +45,7 @@ test_that('simulate_infection integrates different types of infection and schedu
timestep,
renderer
)
-
+
mockery::expect_args(
boost_immunity_mock,
1,
@@ -55,7 +55,7 @@ test_that('simulate_infection integrates different types of infection and schedu
5,
parameters$ub
)
-
+
mockery::expect_args(
infection_mock,
1,
@@ -65,7 +65,7 @@ test_that('simulate_infection integrates different types of infection and schedu
renderer,
timestep
)
-
+
mockery::expect_args(
clinical_infection_mock,
1,
@@ -75,7 +75,7 @@ test_that('simulate_infection integrates different types of infection and schedu
renderer,
timestep
)
-
+
mockery::expect_args(
severe_infection_mock,
1,
@@ -85,7 +85,7 @@ test_that('simulate_infection integrates different types of infection and schedu
parameters,
renderer
)
-
+
mockery::expect_args(
treated_mock,
1,
@@ -95,7 +95,7 @@ test_that('simulate_infection integrates different types of infection and schedu
timestep,
renderer
)
-
+
mockery::expect_args(
schedule_mock,
1,
@@ -121,11 +121,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 +133,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 +148,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,9 +158,9 @@ 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))
-
+
infections <- calculate_infections(
variables,
bitten_humans,
@@ -168,9 +168,9 @@ test_that('calculate_infections works various combinations of drug and vaccinati
mock_render(timestep),
timestep
)
-
+
expect_equal(infections$to_vector(), 3)
-
+
mockery::expect_args(immunity_mock, 1, c(.3, .5, .9), parameters)
mockery::expect_args(
weibull_mock,
@@ -179,7 +179,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,
@@ -203,14 +203,13 @@ test_that('calculate_infections works various combinations of drug and vaccinati
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 +217,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 +243,7 @@ test_that('calculate_clinical_infections correctly samples clinically infected',
c(.3, .5, .9),
parameters
)
-
+
mockery::expect_args(
bernoulli_mock,
1,
@@ -265,10 +264,10 @@ test_that('calculate_treated correctly samples treated and updates the drug stat
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,
@@ -280,7 +279,7 @@ test_that('calculate_treated correctly samples treated and updates the drug stat
bernoulli_mock <- mockery::mock(c(1, 3))
mockery::stub(calculate_treated, '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 +289,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 +298,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 +315,288 @@ 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()),
+ drug = list(queue_update = mockery::mock()),
+ drug_time = list(queue_update = mockery::mock()),
+ dt = 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))
+ mockery::stub(calculate_treated, '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$dt$queue_update, 5, c(2, 3, 4, 5, 6, 7), 1)
+ expect_bitset_update(variables$dt$queue_update, 15, c(1), 2)
+})
+
+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()),
+ drug = list(queue_update = mockery::mock()),
+ drug_time = list(queue_update = mockery::mock()),
+ dt = 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:
+ mockery::stub(calculate_treated, '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 non-slow parasite clearance individuals is correct:
+ expect_bitset_update(
+ variables$dt$queue_update,
+ parameters$dt,
+ c(2, 3, 4, 5, 6, 7),
+ 1)
+
+ # Check that update queued for dt for the slow parasite clearance individuals is correct:
+ expect_bitset_update(
+ variables$dt$queue_update,
+ unlist(parameters$dt_slow_parasite_clearance),
+ c(1),
+ 2)
+
+})
+
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,
@@ -338,15 +605,15 @@ test_that('schedule_infections correctly schedules new infections', {
parameters,
42
)
-
+
actual_infected <- mockery::mock_args(infection_mock)[[1]][[5]]$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 +625,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,15 +633,15 @@ 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(
variables,
bitten,
@@ -382,7 +649,7 @@ test_that('prophylaxis is considered for medicated humans', {
mock_render(timestep),
timestep
)
-
+
expect_equal(
mockery::mock_args(m)[[1]][[1]],
c(2.491951e-07, 2.384032e-01, 5.899334e-01),
@@ -394,17 +661,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 +679,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 +699,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 +718,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 +738,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 +771,11 @@ 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)
empty <- individual::Bitset$new(population)
-
+
update_severe_disease(
timestep,
empty,
@@ -516,7 +783,7 @@ test_that('update_severe_disease renders with no infections', {
parameters,
renderer
)
-
+
mockery::expect_args(
render_function,
1,
@@ -531,3 +798,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()),
+ drug = list(queue_update = mockery::mock()),
+ drug_time = list(queue_update = mockery::mock()),
+ dt = 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..1ee440f6 100644
--- a/tests/testthat/test-mda.R
+++ b/tests/testthat/test-mda.R
@@ -81,11 +81,8 @@ test_that('MDA moves the diseased and non-diseased population correctly', {
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,
@@ -141,12 +138,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', {
@@ -176,11 +167,8 @@ test_that('MDA moves the diseased and non-diseased population correctly - second
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,
@@ -265,11 +253,8 @@ test_that('MDA ignores non-detectable asymptomatics', {
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,
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..09c4cf7d 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(
@@ -150,8 +190,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 +203,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 +240,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 +320,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 +332,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 +345,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 +363,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 +397,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 +411,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 +423,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 +442,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 +466,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 +539,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 +553,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 +577,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 +588,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 +613,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 +648,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-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..29f0d6b0
--- /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_any_process(p, 1)
+ v$.update()
+
+ expect_equal(v$get_values(), c(0, 0.25, 0.5, 1, 2, 5))
+
+ individual:::execute_any_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-resume.R b/tests/testthat/test-resume.R
new file mode 100644
index 00000000..1fb7ff87
--- /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)
+ }
+
+ 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-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-vector-control.R b/tests/testthat/test-vector-control.R
index 6001eeac..8c2e2d49 100644
--- a/tests/testthat/test-vector-control.R
+++ b/tests/testthat/test-vector-control.R
@@ -363,27 +363,27 @@ test_that('usage renderer outputs correct values', {
test_that('set_carrying_capacity works',{
p <- list()
- p$species <- "All"
+ p$species <- "gamb"
p_out <- set_carrying_capacity(p, 1, matrix(0.1))
expect_equal(
p_out,
list(
- species = "All",
+ 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 +393,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..5b6acd40
--- /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_730_3650/sim_out_baseline$n_730_3650
+sim_out_clin_treatment$pfpr210 = sim_out_clin_treatment$n_detect_730_3650/sim_out_clin_treatment$n_730_3650
+sim_out_resistance$pfpr210 = sim_out_resistance$n_detect_730_3650/sim_out_resistance$n_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_730_3650/dynamic_resistance_output$n_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_730_3650/simulation_outputs$base$n_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_730_3650/simulation_outputs$treatment$n_730_3650,
+ col = cols[4])
+
+lines(x = simulation_outputs$etf$timestep,
+ y = simulation_outputs$etf$n_detect_730_3650/simulation_outputs$etf$n_730_3650,
+ col = cols[5])
+
+lines(x = simulation_outputs$spc$timestep,
+ y = simulation_outputs$spc$n_detect_730_3650/simulation_outputs$spc$n_730_3650,
+ col = cols[6])
+
+lines(x = simulation_outputs$etf_spc$timestep,
+ y = simulation_outputs$etf_spc$n_detect_730_3650/simulation_outputs$etf_spc$n_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.
\ No newline at end of file
diff --git a/vignettes/Carrying-capacity.Rmd b/vignettes/Carrying-capacity.Rmd
index 82fd77d2..39558355 100644
--- a/vignettes/Carrying-capacity.Rmd
+++ b/vignettes/Carrying-capacity.Rmd
@@ -13,7 +13,9 @@ editor_options:
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
- comment = "#>"
+ comment = "#>",
+ dpi=300,
+ fig.width=7
)
```
@@ -61,7 +63,7 @@ p_seasonal <- p_seasonal |>
and can run the simulations and compare the outputs
-```{r, fig.width = 7, fig.height = 4}
+```{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
@@ -70,8 +72,8 @@ s_seasonal <- run_simulation(timesteps = timesteps, parameters = p_seasonal)
s_seasonal$pfpr <- s_seasonal$n_detect_730_3650 / s_seasonal$n_730_3650
par(mfrow = c(1, 2))
-plot(s$EIR_All ~ s$timestep, t = "l", ylim = c(0, 200), xlab = "Time", ylab = "EIR")
-lines(s_seasonal$EIR_All ~ s_seasonal$timestep, col = "darkorchid3")
+plot(s$EIR_gamb ~ s$timestep, t = "l", ylim = c(0, 200), xlab = "Time", ylab = "EIR")
+lines(s_seasonal$EIR_gamb ~ s_seasonal$timestep, col = "darkorchid3")
plot(s$pfpr ~ s$timestep, t = "l", ylim = c(0, 1), xlab = "Time", ylab = "PfPr")
lines(s_seasonal$pfpr ~ s_seasonal$timestep, col = "darkorchid3")
```
@@ -79,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
@@ -97,13 +95,13 @@ The impact of larval source management (LSM) is captured by reducing the
carrying capacity. The helper function `set_carrying_capacity()`
can be used to specify this intervention
-```{r, fig.width = 7, fig.height = 4}
+```{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)
@@ -111,8 +109,8 @@ s_lsm <- run_simulation(timesteps = timesteps, parameters = p_lsm)
s_lsm$pfpr <- s_lsm$n_detect_730_3650 / s_lsm$n_730_3650
par(mfrow = c(1, 2))
-plot(s$EIR_All ~ s$timestep, t = "l", ylim = c(0, 150), xlab = "Time", ylab = "EIR")
-lines(s_lsm$EIR_All ~ s_lsm$timestep, col = "darkorchid3")
+plot(s$EIR_gamb ~ s$timestep, t = "l", ylim = c(0, 150), xlab = "Time", ylab = "EIR")
+lines(s_lsm$EIR_gamb ~ s_lsm$timestep, col = "darkorchid3")
abline(v = 365, lty = 2, col = "grey60")
plot(s$pfpr ~ s$timestep, t = "l", ylim = c(0, 1), xlab = "Time", ylab = "PfPr")
lines(s_lsm$pfpr ~ s_lsm$timestep, col = "darkorchid3")
@@ -122,25 +120,25 @@ 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
invasion of _Anopheles stephensi_.
-```{r, fig.width = 7, fig.height = 4}
+```{r, fig.width = 7, fig.height = 4, out.width='100%'}
# First initialise the mosquito species so that the invasive species starts with
# a negligible, but non-zero proportion.
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
)
@@ -164,10 +162,10 @@ specific carrying capacity changes over time. We can demonstrate this
below by arbitrarily stepping the carrying capacity up and down over
time
-```{r, fig.width = 7, fig.height = 4}
+```{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)
)
@@ -176,8 +174,8 @@ s_flexible <- run_simulation(timesteps = timesteps, parameters = p_flexible)
s_flexible$pfpr <- s_flexible$n_detect_730_3650 / s_flexible$n_730_3650
par(mfrow = c(1, 2))
-plot(s$EIR_All ~ s$timestep, t = "l", ylim = c(0, 150), xlab = "Time", ylab = "EIR")
-lines(s_flexible$EIR_All ~ s_flexible$timestep, col = "darkorchid3")
+plot(s$EIR_gamb ~ s$timestep, t = "l", ylim = c(0, 150), xlab = "Time", ylab = "EIR")
+lines(s_flexible$EIR_gamb ~ s_flexible$timestep, col = "darkorchid3")
abline(v = 365, lty = 2, col = "grey60")
plot(s$pfpr ~ s$timestep, t = "l", ylim = c(0, 1), xlab = "Time", ylab = "PfPr")
lines(s_flexible$pfpr ~ s_flexible$timestep, col = "darkorchid3")
diff --git a/vignettes/Demography.Rmd b/vignettes/Demography.Rmd
index cfa68a00..d8c96a93 100644
--- a/vignettes/Demography.Rmd
+++ b/vignettes/Demography.Rmd
@@ -10,29 +10,41 @@ vignette: >
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
- comment = "#>"
+ comment = "#>",
+ dpi=300,
+ fig.width=7
)
```
```{r setup}
-suppressPackageStartupMessages(library(ggplot2))
+# Load the requisite packages:
library(malariasimulation)
+# Set colour palette:
+cols <- c("#E69F00", "#56B4E9", "#009E73", "#CC79A7","#F0E442", "#0072B2", "#D55E00")
```
-# Parameterisation
+The dynamics of malaria transmission, and the efficacy of interventions designed to interrupt it, are highly context specific and an important consideration is the demography of the population(s) under investigation. To suit the research needs of the user, `malariasimulation` allows for the specification of custom human population demographics by allowing them to specify age-group specific death rate parameters. It also enables users to instruct the model to render outputs with variables of interest (e.g. human population, number of cases detectable by microscopy, number of severe cases, etc.) presented by user-defined age groups. In this vignette, we use simple, illustrative cases to demonstrate how to customise the output rendered by the `run_simulation()` function, and how to specify both fixed and time-varying custom death rates.
-We are going to create a scenario where we track severe prevalence for 5 years.
+## 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).
+
+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.
```{r}
-year <- 365
-month <- 30
-sim_length <- 5 * year
+# Set the timespan over which to simulate
+year <- 365; years <- 5; sim_length <- year * years
+
+# Set an initial human population and initial entomological inoculation rate (EIR)
human_population <- 1000
starting_EIR <- 5
+# Set the age ranges (in days)
age_min <- seq(0, 80, 5) * 365
age_max <- seq(5, 85, 5) * 365
+# Use the get_parameters() function to establish the default simulation parameters, specifying
+# age categories from 0-85 in 5 year intervals.
simparams <- get_parameters(
list(
human_population = human_population,
@@ -41,55 +53,71 @@ simparams <- get_parameters(
)
)
+# Use set_equilibrium to tune the human and mosquito populations to those required for the
+# defined EIR
simparams <- set_equilibrium(simparams, starting_EIR)
```
-## Custom demography
+## Set custom demography
-We can set a custom demography:
+Next, we'll use the in-built `set_demography()` function to specify human death rates by age group. This function accepts as inputs a parameter list to update, a vector of the age groups (in days) for which we specify death rates, a vector of time steps in which we want the death rates to be updated, and a matrix containing the death rates for each age group in each timestep. The `set_demography()` function appends these to the parameter list and updates the `custom_demography` parameter to `TRUE`. Here, we instruct the model to implement these changes to the demographic parameters at the beginning of the simulation (`timesteps = 0`).
```{r}
-demography_params <- simparams
+# Copy the simulation parameters as demography parameters:
+dem_params <- simparams
-# Set a flat demography
-ages <- round(c(
- .083333, 1, 5, 10, 15, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70, 75, 80,
- 85, 90, 95, 200) * year)
+# We can set our own custom demography:
+ages <- round(c(0.083333, 1, 5, 10, 15, 20, 25, 30, 35, 40, 45,
+ 50, 55, 60, 65, 70, 75, 80, 85, 90, 95, 200) * year)
+# Set deathrates for each age group (divide annual values by 365:
deathrates <- c(
.4014834, .0583379, .0380348, .0395061, .0347255, .0240849, .0300902,
.0357914, .0443123, .0604932, .0466799, .0426199, .0268332, .049361,
.0234852, .0988317, .046755, .1638875, .1148753, .3409079, .2239224,
.8338688) / 365
-demography_params <- set_demography(
- demography_params,
+# Update the parameter list with the custom ages and death rates through the in-built
+# set_demography() function, instructing the custom demography to be implemented at the
+# beginning of the model run (timestep = 0):
+dem_params <- set_demography(
+ dem_params,
agegroups = ages,
timesteps = 0,
deathrates = matrix(deathrates, nrow = 1)
)
+
+# Confirm that the custom demography has been set:
+dem_params$custom_demography
```
-Let's run the simulations
+### Simulation
+
+Having established parameter sets with both default and custom demographic parameterisations, we can now run a simulation for each using the `run_simulation()` function. We'll also add a column to each to identify the runs.
```{r}
-# run and combine the outputs
+# Run the simulation with the default demographic set-up:
exp_output <- run_simulation(sim_length, simparams)
exp_output$run <- 'exponential'
-custom_output <- run_simulation(sim_length, demography_params)
+
+# Run the simulation for the custom demographic set-up:
+custom_output <- run_simulation(sim_length, dem_params)
custom_output$run <- 'custom'
```
-and now we can compare the age distributions in the populations
-in year 5:
+### Visualisation
-```{r}
-# wrangle outputs
-output <- rbind(exp_output, custom_output)
-output <- output[output$timestep == 5 * 365,]
+Using barplots, we can visualise the effect of altering the demographic parameters by comparing the distribution of people among the age-classes we instructed the model to output on the final day of the simulation. The default demography is depicted in blue, while the custom demography is given in orange. Under the custom demography, the frequency of individuals in older age classes declines almost linearly, while in the default demography the number of individuals in each age class declines exponentially with age.
+
+```{r, fig.align = 'center', out.width='100%', fig.asp=0.5}
+# Combine the two dataframes:
+dem_output <- rbind(exp_output, custom_output)
+
+# Subset the final day of the simulation for each of the two demography runs:
+dem_output <- dem_output[dem_output$timestep == 5 * 365,]
-# A function to extract the age variables and convert to long format
-convert_to_long <- function(age_min, age_max, output){
+# Extract the age variables and convert the dataframe to long format:
+convert_to_long <- function(age_min, age_max, output) {
output <- lapply(
seq_along(age_min),
function(i) {
@@ -97,60 +125,102 @@ convert_to_long <- function(age_min, age_max, output){
age_lower = age_min[[i]],
age_upper = age_max[[i]],
n = output[,paste0('n_age_', age_min[[i]], '_',age_max[[i]])],
- age_mid = (age_min[[i]] + (age_min[[i]] - age_max[[i]]) / 2) / 365,
- run = output$run,
+ age_plot = age_min[[i]]/365,
+ run = output$run,
timestep = output$timestep)
}
)
output <- do.call("rbind", output)
}
-output <- convert_to_long(age_min, age_max, output)
-
-# Plot the age distributions
-ggplot(output, aes(x = age_mid, y = n)) +
- geom_bar(stat = "identity") +
- theme_bw() +
- facet_wrap(~ run)
+# Convert the output for plotting:
+dem_output <- convert_to_long(age_min, age_max, dem_output)
+
+# Define the plotting window
+par(mfrow = c(1, 2), mar = c(4, 4, 1, 1))
+
+# a) Default/Exponentially-distributed demography
+plot.new(); grid(lty = 2, col = "grey80", lwd = 0.5, ny = 5, nx = 6); par(new = TRUE)
+barplot(height = dem_output[dem_output$run == "exponential", c("n", "age_plot")]$n,
+ names = c(paste0(seq(0,75, by = 5),"-",seq(0,75, by = 5)+4), "80+"),
+ axes = TRUE, space = 0, ylim = c(0, 250), xaxs = "i", yaxs = "i",
+ main = "Default", xlab = "Age Group", ylab = "Individuals",
+ cex.axis = 0.8, cex.names = 0.8, cex.lab = 1, cex.main = 1, las = 2,
+ col = cols[2]); box()
+
+# b) Custom demography
+plot.new()
+grid(lty = 2, col = "grey80", lwd = 0.5, ny = 5, nx = 6)
+par(new = TRUE)
+barplot(height = dem_output[dem_output$run == "custom", c("n", "age_plot")]$n,
+ names = c(paste0(seq(0,75, by = 5),"-",seq(0,75, by = 5)+4), "80+"),
+ axes = TRUE, space = 0, ylim = c(0, 250), xaxs = "i", yaxs = "i",
+ main = "Custom", xlab = "Age Group",
+ cex.axis = 0.8, cex.names = 0.8, cex.lab = 1, cex.main = 1, las = 2,
+ col = cols[1]); box()
```
-We can also specify time-varying death rates to capture a dynamic demography
+## Set dynamic demography
-```{r, fig.width=7}
-dynamic_demography_params <- simparams
+Using the `timesteps` and `deathrates` arguments, we can also use the `set_demography()` function to update the death rates of specific age groups through time. In the following example, we'll use this functionality to first set our own initial death rates by age group, then instruct the model to increase the death rates in the age groups 5-10, 10-15, and 15-20 years old by a factor of 10 after 2 years. We'll finish by plotting the number of individuals in each age class at the end of each year to visualise the effect of time-varying death rates on the human population age-structure.
-# Set a flat demography
-ages <- round(c(
- .083333, 1, 5, 10, 15, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70, 75, 80,
- 85, 90, 95, 200) * year)
+### Parameterisation
-deathrates <- c(
- .4014834, .0583379, .0380348, .0395061, .0347255, .0240849, .0300902,
- .0357914, .0443123, .0604932, .0466799, .0426199, .0268332, .049361,
- .0234852, .0988317, .046755, .1638875, .1148753, .3409079, .2239224,
- .8338688) / 365
-# Let's increase the death rates in some age groups
-deathrates_changed <- deathrates
-deathrates_changed[3:6] <- deathrates_changed[3:6] * 10
+We'll start by making a copy of the base parameters which have been instructed to output the population size through time (`simparams`). Next, we create a version of the `deathrates` vector created earlier updated to increase the death rates of the 5-10, 10-15, and 15-20 age groups by 10%. Finally, we use `set_demography()` to update our parameter list and specify our custom demography. This is achieved providing the `timesteps` argument with a vector of days to update the death rates (0 and 730 days), and providing `deathrates` with a matrix of death rates where each row corresponds to a set of death rates for a given update.
+
+```{r}
+# Store the simulation parameters in a new object for modification
+dyn_dem_params <- simparams
+
+# Increase the death rates in some age groups (5-15 year olds):
+deathrates_increased <- deathrates
+deathrates_increased[3:6] <- deathrates_increased[3:6] * 10
-dynamic_demography_params <- set_demography(
- dynamic_demography_params,
+# Set the population demography using these updated deathrates
+dyn_dem_params <- set_demography(
+ dyn_dem_params,
agegroups = ages,
- timesteps = c(0, 2 * 365),
- deathrates = matrix(c(deathrates, deathrates_changed), nrow = 2, byrow = TRUE)
+ timesteps = c(0, 2*365),
+ deathrates = matrix(c(deathrates, deathrates_increased), nrow = 2, byrow = TRUE)
)
+```
-dynamic_demography_output <- run_simulation(sim_length, dynamic_demography_params)
-
-# wrangle outputs
-dynamic_demography_output <- dynamic_demography_output[dynamic_demography_output$timestep %in% (1:5 * 365),]
-dynamic_demography_output$run <- "dynamic"
+### Simulation
+Having established the parameter list for the dynamic death rate simulation, we can now run the simulation using the `run_simulation()` function.
-dynamic_demography_output <- convert_to_long(age_min, age_max, dynamic_demography_output)
+```{r}
+# Run the simulation for the dynamic death rate demography
+dyn_dem_output <- run_simulation(sim_length, dyn_dem_params)
+```
-# Plot the age distributions each year
-ggplot(dynamic_demography_output, aes(x = age_mid, y = n)) +
- geom_bar(stat = "identity") +
- theme_bw() +
- facet_wrap(~ timestep / 365, ncol = 5)
-```
\ No newline at end of file
+### Visualisation
+
+Bar plots of the age structure of the human population at the end of each year show the marked effect that increasing the death rate within a small subset of age classes can have on the demography of the human population over time.
+
+```{r, fig.align = 'center', out.width='100%', fig.asp=0.35}
+# Filter out the end-of-year population sizes, add a column naming the run, and convert
+# dataframe to long-form:
+dyn_dem_output <- dyn_dem_output[dyn_dem_output$timestep %in% (c(1,3,5) * 365),]
+dyn_dem_output$run <- 'dynamic'
+dyn_dem_output <- convert_to_long(age_min, age_max, dyn_dem_output)
+
+# Set a 1x5 plotting window:
+par(mfrow = c(1,3), mar = c(4, 4, 1, 1))
+
+# Loop through the years to plot:
+for(i in c(1,3,5)) {
+ plot.new()
+ grid(lty = 2, col = "grey80", lwd = 0.5, ny = 5, nx = 6)
+ par(new = TRUE)
+ barplot(height = dyn_dem_output[dyn_dem_output$timestep/365 == i,c("n", "age_plot")]$n,
+ names = c(paste0(seq(0,75, by = 5),"-",seq(0,75, by = 5)+4), "80+"),
+ axes = TRUE, space = 0,
+ ylim = c(0, 500),
+ main = paste0("Year ", i), cex.main = 1.4,
+ xlab = ifelse(i == 3, "Age Group", ""),
+ ylab = ifelse(i == 1, "Individuals", ""),
+ xaxs = "i", yaxs = "i", las = 2,
+ cex.axis = 0.8, cex.names = 0.8, cex.lab = 1, cex.main = 1, col = cols[3])
+ box()
+}
+```
diff --git a/vignettes/EIRprevmatch.Rmd b/vignettes/EIRprevmatch.Rmd
index e46b7e6c..f519faa5 100644
--- a/vignettes/EIRprevmatch.Rmd
+++ b/vignettes/EIRprevmatch.Rmd
@@ -1,8 +1,8 @@
---
-title: "Matching PfPR2-10 to EIR"
+title: "Matching EIR to *Pf*PR~2-10~"
output: rmarkdown::html_vignette
vignette: >
- %\VignetteIndexEntry{EIRprevmatch}
+ %\VignetteIndexEntry{Matching EIR to *Pf*PR~2-10~}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
@@ -10,63 +10,139 @@ vignette: >
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
- comment = "#>"
+ comment = "#>",
+ dpi=300,
+ fig.width=7
)
```
```{r setup, message=F, warning=F}
+# Load the requisite packages:
library(malariasimulation)
-library(mgcv)
+library(malariaEquilibrium)
+# Set colour palette:
+cols <- c("#E69F00", "#56B4E9", "#009E73", "#CC79A7","#F0E442", "#0072B2", "#D55E00")
+
```
-Begin by parameterizing the model you wish to run. Be sure to include any seasonality factors and interventions you want to include at baseline.
+The entomological inoculation rate (EIR), defined as the number of infectious bites experienced per person per unit time, and malaria prevalence, the proportion of the population with detectable malaria, are two metrics used to measure and/or describe malaria transmission. With respect to the latter, the focus is often on the prevalence rate of *Plasmodium falciparum* in children aged two to ten years old, denoted *Pf*PR~2-10~.
+
+When setting up a simulation, `malariasimulation` users often need to calibrate the model run to an observed level of transmission. Calibrating to an EIR value can be done directly using the `set_equilibrium()` function, but EIR is difficult to measure and in practice *Pf*PR~2-10~ is more commonly recorded/reported as a measure of transmission. However, `malariasimulation` does not allow users to calibrate directly to an *Pf*PR~2-10~ value. To calibrate to a target *Pf*PR~2-10~, users must instead identify and input the EIR value that yields the target *Pf*PR~2-10~ value. In this vignette, three methods for matching the EIR to a target *Pf*PR~2-10~ are outlined and compared.
+
+The first and fastest method uses the `malariaEquilibrium` package function `human_equilibrium()` to calculate the equilibrium *Pf*PR~2-10~ for a given EIR using the canonical equilibrium solution for the `malariasimulation` model. The second method involves running `malariasimulation` simulations across a small set of initial EIR values, extracting the *Pf*PR~2-10~ from each simulation run, and fitting a model relating initial EIR to *Pf*PR~2-10~ to allow users to predict the initial EIR value required to yield the desired *Pf*PR~2-10~. The third approach is to calibrate the model using the `cali` package function (see https://github.com/mrc-ide/cali for more information) `calibrate()` , which searches a user-defined EIR parameter space and identifies the value which yields the target *Pf*PR~2-10~ to a defined tolerance.
+
+## *Pf*PR~2-10~ matching using malariaEquilibrium
+
+The `malariaEquilibrium` package function `human_equilibrium()` returns the canonical equilibrium solution for a given EIR and the *Pf*PR~2-10~ can be calculated from the output (see for more information). The first step is to set a large range of EIR values to generate matching *Pf*PR~2-10~ values for. Next, we load the package's default parameter set, specify an effective clinical treatment coverage (`ft`) of 0.45 and, for each EIR value generated, run the `human_equilibrium()` function.
+
+The `human_equilibrium()` function returns a dataframe containing the proportion of each age class in each state variable at equilibrium. The *Pf*PR~2-10~ can be calculated from the output for each EIR value by summing the proportion of people aged 2-10 with cases of malaria (`pos_M`) and dividing this proportion by the proportion of the population between the ages 2-10 (`prop`). Finally, we store the matching EIR and *Pf*PR~2-10~ values in a data frame.
+
+```{r}
+# Establish a range of EIR values to generate matching PfPR2-10 values for:
+malEq_EIR <- seq(from = 0.1, to = 50, by = 0.5)
+
+# Load the base malariaSimulation parameter set:
+q_simparams <- malariaEquilibrium::load_parameter_set("Jamie_parameters.rds")
+
+# Use human_equilibrium() to calculate the PfPR2-10 values for the range of
+# EIR values:
+malEq_prev <- vapply(
+ malEq_EIR,
+ function(eir) {
+ eq <- malariaEquilibrium::human_equilibrium(
+ eir,
+ ft = 0.45,
+ p = q_simparams,
+ age = 0:100
+ )
+ sum(eq$states[3:11, 'pos_M']) / sum(eq$states[3:11, 'prop'])
+ },
+ numeric(1)
+)
+
+# Establish a dataframe containing the matching EIR and PfPR2-10 values:
+malEq_P2E <- cbind.data.frame(EIR = malEq_EIR, prev = malEq_prev)
+
+# View the dataframe containing the EIR and matching PfPR2-10 values:
+head(malEq_P2E, n = 7)
+```
-```{r parameters}
+As this method does not involve running simulations it can return matching *Pf*PR~2-10~ for a wide range of EIR values very quickly. However, it is only viable for systems at steady state, with a fixed set of parameter values, and only enables the user to capture the effects of the clinical treatment of cases. Often when running `malariasimulation` simulations, one or both of these conditions are not met. In this example, we have set the proportion of cases effectively treated (`ft`) to 0.45 to capture the effect of clinical treatment with antimalarial drugs. However, the user may, for example, also wish to include the effects of a broader suite of interventions (e.g. bed nets, vaccines, etc.), or to capture changes in the proportion of people clinically treated over time. In these cases, a different solution would therefore be required.
+
+## *Pf*PR~2-10~ matching using malariasimulation
+
+Where the `malariaEquilibrium` method is not viable, an alternative is to run `malariasimulation` simulations over a smaller range of initial EIR values, extract the *Pf*PR~2-10~ from each run, fit a model relating initial EIR to *Pf*PR~2-10~, and use the model to predict the initial EIR value required to yield the desired *Pf*PR~2-10~. This approach allows users to benefit from the tremendous flexibility in human population, mosquito population, and intervention package parameters afforded by the `malariasimulation` package. An example of this method is outlined below.
+
+### Establish malariasimulation parameters
+
+To run `malariasimulation`, the first step is to generate a list of parameters using the `get_parameters()` function, which loads the default `malariasimulation` parameter list. Within this function call, we adapt the average age of the human population to flatten its demographic profile, instruct the model to output malaria prevalence in the age range of 2-10 years old, and switch off the individual-based mosquito module. The `set_species()` function is then called to specify a vector community composed of *An. gambiae*, *An. funestus*, and *An arabiensis* at a ratio of 2:1:1. The `set_drugs()` function is used to append the built-in parameters for artemether lumefantrine (AL) and, finally, the `set_clinical_treatment()` function is called to specify a treatment campaign that distributes AL to 45% of the population in the first time step (t = 1).
+
+```{r}
+# Specify the time frame over which to simulate and the human population size:
year <- 365
human_population <- 5000
-params <- get_parameters(list(
+# Use the get_parameters() function to establish a list of simulation parameters:
+simparams <- get_parameters(list(
+
+ # Set the population size:
human_population = human_population,
- average_age = 8453.323, # to match flat_demog
- model_seasonality = TRUE, # assign seasonality
- g0 = 0.284596,
- g = c(-0.317878, -0.0017527, 0.116455),
- h = c(-0.331361, 0.293128, -0.0617547),
- prevalence_rendering_min_ages = 2 * year, # set prev age range
- prevalence_rendering_max_ages = 10 * year,
- individual_mosquitoes = FALSE))
-
- # set species / drugs / treatment parameters
-params <- set_species(params, species = list(arab_params, fun_params, gamb_params),
- proportions = c(0.25, 0.25, 0.5))
-params <- set_drugs(params, list(AL_params))
-params <- set_clinical_treatment(params, 1, c(1), c(0.45))
+
+ # Set the average age (days) of the population:
+ average_age = 23 * year,
+
+ # Instruct model to render prevalence in age group 2-10:
+ prevalence_rendering_min_ages = 2 * year,
+ prevalence_rendering_max_ages = 10 * year))
+
+# Use the set_species() function to specify the mosquito population (species and
+# relative abundances):
+simparams <- set_species(parameters = simparams,
+ species = list(arab_params, fun_params, gamb_params),
+ proportions = c(0.25, 0.25, 0.5))
+
+# Use the set_drugs() function to append the in-built parameters for the
+# drug artemether lumefantrine (AL):
+simparams <- set_drugs(simparams, list(AL_params))
+# Use the set_clinical_treatment() function to parameterise human
+# population treatment with AL in the first timestep:
+simparams <- set_clinical_treatment(parameters = simparams,
+ drug = 1,
+ timesteps = c(1),
+ coverages = c(0.45))
```
-Now run `malariasimulation` over a range of EIRs. The goal is to run enough points to generate a curve to which you can match PfPR2-10 to EIR effectively.
+### Run the simulations and calculate *Pf*PR~2-10~
-```{r model}
-# loop over malariasimulation runs
-init_EIR <- c(0.01, 0.1, 1, 5, 10, 25, 50) # set EIR values
+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.
-# run model
-outputs <- lapply(
+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.
+
+```{r}
+# Establish a vector of initial EIR values to simulate over and generate matching
+# PfPR2-10 values for:
+init_EIR <- c(0.01, 0.1, 1, 5, 10, 25, 50)
+
+# For each initial EIR, calculate equilibrium parameter set and run the simulation:
+malSim_outs <- lapply(
init_EIR,
function(init) {
- p_i <- set_equilibrium(params, init)
- run_simulation(5 * year, p_i) # sim time = 5 years
+ p_i <- set_equilibrium(simparams, init)
+ run_simulation(5 * year, p_i)
}
)
-# output EIR values
-EIR <- lapply(
- outputs,
+# Convert the default EIR output (per vector species, per timestep, across
+# the entire human population) to a cross-vector species average EIR per
+# person per year across the final year of the simulation:
+malSim_EIR <- lapply(
+ malSim_outs,
function(output) {
mean(
rowSums(
output[
- output$timestep %in% seq(4 * 365, 5 * 365), # just use data from the last year
+ output$timestep %in% seq(4 * 365, 5 * 365),
grepl('EIR_', names(output))
] / human_population * year
)
@@ -74,9 +150,10 @@ EIR <- lapply(
}
)
-# output prev 2-10 values
-prev <- lapply(
- outputs,
+# Calculate the average PfPR2-10 value across the final year for each initial
+# EIR value:
+malSim_prev <- lapply(
+ malSim_outs,
function(output) {
mean(
output[
@@ -89,85 +166,217 @@ prev <- lapply(
)
}
)
+
+# Create dataframe of initial EIR, output EIR, and PfPR2-10 results:
+malSim_P2E <- cbind.data.frame(init_EIR, EIR = unlist(malSim_EIR), prev = unlist(malSim_prev))
-# create dataframe of initial EIR, output EIR, and prev 2-10 results
-EIR_prev <- cbind.data.frame(init_EIR, output_EIR = unlist(EIR), prev = unlist(prev))
-
+# View the dataframe containing the EIR and matching PfPR2-10 values:
+malSim_P2E
```
-Now plot your results! Code is included to compare the results of matching PfPR2-10 to EIR based on `malariaEquilibrium` (blue line) versus matching based on parameterized `malariasimulation` runs (red line). Notice that the generated points do not form a smooth curve. We ran `malariasimulation` using a population of just 5,000. Increasing the population to 10,000 or even 100,000 will generate more accurate estimates, but will take longer to run.
+### Fit line of best fit relating initial EIR values to *Pf*PR~2-10~
-```{r plot}
-# calculate EIR / prev 2-10 relationship from malariaEquilibrium
-eir <- seq(from = 0.1, to = 50, by=.5)
-eq_params <- malariaEquilibrium::load_parameter_set("Jamie_parameters.rds")
+Having run `malariasimulation` simulations for a range of initial EIRs, we can fit a line of best fit through the initial EIR and *Pf*PR~2-10~ data using the `gam()` function (`mgcv`) and then use the `predict()` function to return the *Pf*PR~2-10~ for a wider range of initial EIRs (given the set of parameters used).
-prev <- vapply( # calculate prevalence between 2:10 for a bunch of EIRs
- eir,
- function(eir) {
- eq <- malariaEquilibrium::human_equilibrium(
- eir,
- ft=0,
- p=eq_params,
- age=0:100
- )
- sum(eq$states[2:10, 'pos_M']) / sum(eq$states[2:10, 'prop'])
- },
- numeric(1)
-)
+```{r, eval = F}
+library(mgcv)
-prevmatch <- cbind.data.frame(eir, prev)
+# Fit a line of best fit through malariasimulation initial EIR and PfPR2-10
+# and use it to predict a series of PfPR2-10 values for initial EIRs ranging
+# from 0.1 to 50:
+malSim_fit <- predict(gam(prev~s(init_EIR, k = 5), data = malSim_P2E),
+ newdata = data.frame(init_EIR = c(0, seq(0.1, 50, 0.1))),
+ type = "response")
-# calculate best fit line through malariasimulation data
-fit <- predict(gam(prev~s(init_EIR, k=5), data=EIR_prev),
- newdata = data.frame(init_EIR=c(0,seq(0.1,50,0.1))), type="response")
-fit <- cbind(fit, data.frame(init_EIR=c(0,seq(0.1,50,0.1))))
+# Create a dataframe of initial EIR values and PfPR2-10 values:
+malSim_fit <- cbind(malSim_fit, data.frame(init_EIR = c(0 ,seq(0.1, 50, 0.1))))
+```
-# plot
-plot(x=1, type = "n",
- frame = F,
- xlab = "initial EIR",
- ylab = expression(paste(italic(Pf),"PR"[2-10])),
- xlim = c(0,50),
- ylim = c(0,.7))
+## Visualisation
+
+Let's visually compare the `malariaEquilibrium` and `malariasimulation` methods for matching EIR to *Pf*PR~2-10~ values. In the section below we open a blank plot, plot the initial EIR and resulting *Pf*PR~2-10~ points generated using `malariasimulation` runs and overlay the line of best fit (orange line). Also overlayed is a line mapping EIR and *Pf*PR~2-10~ values calculated using `malariaEquilibrium` (blue line).
-points(x=EIR_prev$init_EIR,
- y=EIR_prev$prev,
+```{r, eval = F}
+# Establish a plotting window:
+plot(x = 1, type = "n",
+ xlab = "Initial EIR", ylab = expression(paste(italic(Pf),"PR"[2-10])),
+ xlim = c(0,50), ylim = c(0, 1),
+ xaxs = "i", yaxs = "i");grid(lty = 2, col = "grey80", lwd = 0.5)
+
+# Overlay the initial EIR and corresponding PfPR2-10 points from malariasimulation:
+points(x = malSim_P2E$init_EIR,
+ y = malSim_P2E$prev,
pch = 19,
col = 'black')
-lines(x=fit$init_EIR,
- y=fit$fit,
- col = "red",
+# Overlay the malariasimulation line of best fit:
+lines(x = malSim_fit$init_EIR,
+ y = malSim_fit$malSim_fit,
+ col = cols[1],
+ lwd = 2,
type = "l",
lty = 1)
-lines(x=prevmatch$eir,
- y=prevmatch$prev,
- col = "blue",
- type = "l",
+# Overlay the malariaEquilibrium EIR to PfPR2-10 line:
+lines(x = malEq_P2E$EIR,
+ y = malEq_P2E$prev,
+ col = cols[2],
+ type = "l",
+ lwd = 2,
lty = 1)
-legend("bottomright", legend=c("malariasimulation", "malariaEquilibrium"), col=c("red", "blue"), lty = c(1,1), cex=0.8)
-
+# Add a legend:
+legend("topright",
+ legend = c("malariasimulation", "malariaEquilibrium"),
+ col = c(cols[1:2]),
+ lty = c(1,1),
+ box.col = "white",
+ cex = 0.8)
```
-Now extract values from the fitted line to generate EIR estimates at your desired PfPR2-10 values.
+M ), incubating (*P*M ) and infectious individuals (*I*M ). Mosquitoes in any state may die, where they enter the NonExistent state. The model tracks both male and female juvenile mosquitoes, but only female adult mosquitoes.
+
+#### Parameters
+
+Parameters shown on the infographic include mosquito developmental rates:
+
+- $r_{EL}$: from early to late larval stage
+
+- $r_{L}$: from late larval stage to pupal stage
+
+- $r_P$: from pupal stage to adult stage
+
+Mosquito infection and incubation rates:
+
+- $\Lambda_M$: the force of infection on mosquitos (FOIM, i.e. from human to mosquito)
+
+- $r_{EM}$: extrinsic incubation period
+
+And mortality rates:
+
+- $\mu_E(t)$: the early larval stage death rate
+
+- $\mu_L(t)$: the late larval stage death rate
+
+- $\mu_P$: the pupal death rate
+
+- $\mu_M$: the adult mosquito death rate
+
+Larval mosquitoes experience density dependent mortality due to a carrying capacity, $K(t)$, which may change seasonally with rainfall and where $\gamma$ is the effect of density-dependence on late stage larvae compared with early stage larvae as follows:
+
+$$
+\mu_E = \mu_E^0(1+\frac{E(t)+L(t)}{K(t)}) \\
+\mu_L = \mu_L^0(1+\gamma\frac{E(t)+L(t)}{K(t)})
+$$
+
+### Key Model References (structure and dynamics)
+
+Griffin JT, Hollingsworth TD, Okell LC, Churcher TS, White M, et al. (2010) Reducing *Plasmodium falciparum* Malaria Transmission in Africa: A Model-Based Evaluation of Intervention Strategies. PLOS Medicine 7(8): e1000324.
+
+White, M.T., Griffin, J.T., Churcher, T.S. *et al.* Modelling the impact of vector control interventions on *Anopheles gambiae* population dynamics. *Parasites Vectors* **4**, 153 (2011).
+
+Griffin, J., Ferguson, N. & Ghani, A. Estimates of the changing age-burden of *Plasmodium falciparum* malaria disease in sub-Saharan Africa. *Nat Commun* **5**, 3136 (2014).
+
+Griffin, J. T., Déirdre Hollingsworth, T., Reyburn, H., Drakeley, C. J., Riley, E. M., & Ghani, A. C. (2015). Gradual acquisition of immunity to severe malaria with increasing exposure. Proceedings of the Royal Society B: Biological Sciences, 282(1801).
+
+Griffin, J. T., Bhatt, S., Sinka, M. E., Gething, P. W., Lynch, M., Patouillard, E., Shutes, E., Newman, R. D., Alonso, P., Cibulskis, R. E., & Ghani, A. C. (2016). Potential for reduction of burden and local elimination of malaria by reducing Plasmodium falciparum malaria transmission: A mathematical modelling study. The Lancet Infectious Diseases, 16(4), 465--472. [https://doi.org/10.1016/S1473-3099(15)00423-5](https://doi.org/10.1016/S1473-3099(15)00423-5)
+
+## Run simulation
+
+### Code
+
+The key package function is `run_simulation()` which simply requires, in its most basic form, a number of timesteps in days. Default parameter settings assume a human population size of 100, an initial mosquito population size of 1000 (where the default species is set to *Anopheles gambiae*), with no treatment interventions and no seasonality and models the spread of *Plasmodium falciparum*. The full parameters list can be seen in the documentation for `get_parameters()`.
+
+```{r, output.lines=6}
+test_sim <- run_simulation(timesteps = 100)
+```
+
+### Output
+
+The `run_simulation()` function then simulates malaria transmission dynamics and returns a dataframe containing the following outputs through time:
+
+- `infectivity`: human infectiousness
+- `EIR_All`: the entomological inoculation rate (for all mosquito species)
+- `FOIM`: the force of infection on mosquitoes
+- `mu_All`: adult mosquito death rate (for all species)
+- `n_bitten`: the number of infectious bites
+- `n_infections`: the number human infections
+- `natural_deaths`: deaths from old age
+- `S_count`, `A_count`, `D_count`, `U_count`, `Tr_count`: the human population size in each state
+- `ica_mean`: mean acquired immunity to clinical infection
+- `icm_mean`: mean maternal immunity to clinical infection
+- `ib_mean`: mean blood immunity to all infection
+- `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
+- `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*)
+
+```{r, output.lines=6}
+head(test_sim, n = 3)
```
-# Mosquito Biology
+Additional output details can be found in the `run_simulation()` documentation.
+
+### Additional outputs
+
+**Age stratified** results for **incidence**, **clinical incidence** and **severe case incidence** may also be included in the output if desired and must be specified in the parameter list (see `get_parameters()` for more details and [Demography](https://mrc-ide.github.io/malariasimulation/articles/Demography.html) for an example). These inputs will add extra columns to the output for the number of infections (**`n_`**) and the sum of probabilities of infection (**`p_`**) for the relevant total, clinical or severe incidences for each specified age group.
+
+Where **treatments** are specified, `n_treated` will report the number that have received treatment. Where **bed nets** are distributed, `net_usage` specifies the number sleeping under a bednet.
-The mosquito biological processes are spread out between the following files:
+### Output visualisation
- 1. 'src/mosquito_ode.cpp' (green)
- 2. 'src/mosquito_emergence.cpp' (green)
- 3. 'R/mosquito_biology.R' (orange)
- 4. 'R/mosquito_biology.R' (red)
+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`.
-```{r echo=FALSE}
-DiagrammeR::grViz("digraph {
- graph [layout = dot, rankdir = LR]
+```{r, fig.align = 'center', out.width='100%', fig.asp=0.55, }
+# Define vector of column names to plot
+cols_to_plot <- paste0(c("S","D","A","U","Tr"),"_count")
+
+# Create plotting function
+states_plot <- function(sim){
- subgraph clusterode {
- style=filled;
- color=lightblue;
- node [shape = rectangle]
- E
- L
- P
- label='ODE'
- }
-
- node [shape = rectangle]
- Sm
- Pm
- Im
- NonExistent
+ # Set up plot with first state
+ plot(x = sim$timestep, y = sim[,cols_to_plot[1]],
+ type = "l", col = cols[1], ylim = c(0,80),
+ ylab = "Population size", xlab = "Days",
+ xaxs = "i", yaxs = "i", lwd = 2)
- # edge definitions with the node IDs
- E -> L -> P [color='green', label='1']
- P -> Sm [color='green', label='2']
- Sm -> Pm -> Im [color='orange', label='3']
- Sm -> NonExistent [color='red', label='4']
- Pm -> NonExistent [color='red', label='4']
- Im -> NonExistent [color='red', label='4']
- }")
+ # Add remaining states
+ sapply(2:5, function(x){
+ points(x = sim$timestep, y = sim[,cols_to_plot[x]],
+ type = "l", lwd = 2, col = cols[x])})
+ grid(lty = 2, col = "grey80", lwd = 0.5)
+ # Add legend
+ legend("topleft", legend = c("S","D","A","U","Tr"), col = cols,
+ lty = 1, lwd = 2, bty = "n", ncol = 3, cex = 0.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
+
+# Plot Pf PR 2-10
+plot(x = test_sim$timestep, y = test_sim$PfPR2_10, type = "l",
+ col = cols[7], ylim = c(0,1), lwd = 2,
+ ylab = expression(paste(italic(Pf),"PR"[2-10])), xlab = "Days",
+ xaxs = "i", yaxs = "i")
+grid(lty = 2, col = "grey80", lwd = 0.5)
+```
+
+## Set equilibrium
+
+Note that the model will not begin simulations from an equilibrium state as default (as in the simulation above). To begin the simulation at approximate equilibrium conditions, please use the `set_equilibrium()` function, which requires you to specify an initial EIR value:
+
+```{r, fig.align = 'center', out.width='100%', fig.asp=0.55}
+params <- get_parameters() |>
+ set_equilibrium(init_EIR = 5)
+
+test_sim_eq <- run_simulation(timesteps = 100, parameters = params)
+
+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
+
+# Plot Pf PR 2-10
+plot(x = test_sim_eq$timestep, y = test_sim_eq$PfPR2_10, type = "l",
+ col = cols[7], ylim = c(0,1),
+ ylab = expression(paste(italic(Pf),"PR"[2-10])), xlab = "Days",
+ xaxs = "i", yaxs = "i", lwd = 2)
+grid(lty = 2, col = "grey80", lwd = 0.5)
+
+```
+
+## Override parameters
+
+The `get_parameters()` function generates a complete parameter set that may be fed into `run_simulation()`. A number of **helper functions** have been designed to assist in changing and setting key parameters, which are explained across the remaining vignettes.
+
+Some parameters (e.g. population size, age group rendering, setting seasonality) must still be replaced directly. When this is the case, care must be taken to ensure the replacement parameters are in the same class as the default parameters (e.g. if the parameter is a numeric, its replacement must also be numeric, if logical, the replacement must also be logical). Parameters are replaced by passing a list of named parameters to the `get_parameters()` function using the `overrides` argument. The following example shows how to change the `human_population` parameter.
+
+```{r}
+# Use get_parameters(overrides = list(...))) to set new parameters
+new_params <- get_parameters(overrides = list(human_population = 200))
+```
+
+While other parameters can be changed individually, we do not generally recommended adjusting these without a detailed understanding of how this will impact the model assumptions. We strongly encourage users to stick with the parameter setting functions and methods described in these vignettes when adjusting parameter settings.
+
+## Seasonality
+
+The `malariasimulation` package has the capacity to simulate malaria transmission for a range of seasonal transmission profiles. This is achieved by specifying an annual rainfall profile that shapes mosquito population dynamics, thereby impacting malaria transmission. Please see the [Umbrella](https://github.com/mrc-ide/umbrella) package for instructions on generating seasonality parameters.
+
+To include seasonality, we must set the parameter `model_seasonality = TRUE` and assign values to parameters that determine seasonality: `g0`, `g` and `h` (which represent fourier coefficients). These parameters must be set directly by passing a list of named parameters to the `overrides` argument of the `get_parameters()` function.
+
+```{r, fig.align = 'center', out.width='100%'}
+# Set parameters, including seasonality parameters
+params_seasons <- get_parameters(overrides = list(
+ model_seasonality = TRUE,
+ g0 = 0.28,
+ g = c(0.2, -0.07, -0.001),
+ h = c(0.2, -0.07, -0.1)))
+
+# Run simulation
+seasonality_simulation <- run_simulation(timesteps = 600, parameters = params_seasons)
+
+# Collect results
+All_mos_cols <- paste0(c("E","L","P","Sm","Pm", "Im"),"_gamb_count")
+
+# Plot results
+plot(seasonality_simulation[,1], rowSums(seasonality_simulation[,All_mos_cols]), lwd = 2,
+ ylim = c(0, 120000), type = "l", xlab = "Days", ylab = "Mosquito population size")
+grid()
+```
+
+The mosquito population size is no longer constant and follows the patterns set by rainfall.
+
+## Individual mosquitoes
+
+Mosquitoes may also be modelled deterministically (the default) or individually.
+
+To model individual mosquitoes, set `individual_mosquitoes` to `TRUE` in the `overrides` argument of `get_parameters()`.
+
+```{r}
+simparams <- get_parameters(overrides = list(individual_mosquitoes = TRUE))
```
+
+## Vignettes
+
+The remaining vignettes describe how to adjust sets of parameters through a number of methods and functions as follows:
+
+1. [Demography](https://mrc-ide.github.io/malariasimulation/articles/Demography.html)
+
+ - Population age group rendering
+
+ - `set_demography()`: setting population demographies and time-varying death rates
+
+2. [Treatment](https://mrc-ide.github.io/malariasimulation/articles/Treatment.html)
+
+ - `set_drugs()`: for drug-specific parameters (with in-built parameter sets)
+
+ - `set_clinical_treatment()`: implemention of clinical treatment interventions
+
+3. [MDA and Chemoprevention](https://mrc-ide.github.io/malariasimulation/articles/MDA.html)
+
+ - `set_mda()`: implementation of mass drug administration interventions
+
+ - `set_smc()`: implementation of seasonal malarial chemoprevention interventions
+
+ - `set_pmc()`: implementation of perennial malarial chemoprevention interventions
+
+ - `peak_season_offset()`: correlating timed interventions with seasonal malaria
+
+4. [Vaccines](https://mrc-ide.github.io/malariasimulation/articles/Vaccines.html)
+
+ - `set_mass_pev()`: implementation of a pre-erythrocytic vaccination intervention via a mass distribution strategy
+
+ - `set_pev_epi()`: implementation of a pre-erythrocytic vaccination intervention via an age-based distribution strategy
+
+ - `set_tbv()`: implementation of a transmission blocking vaccination intervention
+
+5. [Vector Control: Bednets](https://mrc-ide.github.io/malariasimulation/articles/VectorControl_Bednets.html)
+
+ - `set_bednets()`: implementation of bednet distribution intervention
+
+6. [Vector Control: Indoor Residual Spraying](https://mrc-ide.github.io/malariasimulation/articles/VectorControl_IRS.html)
+
+ - `set_spraying()`: implementation of an indoor residual spraying intervention
+
+7. [Mosquito Species](https://mrc-ide.github.io/malariasimulation/articles/SetSpecies.html)
+
+ - `set_species()`: setting mosquito distribution
+
+8. [Carrying Capacity](https://mrc-ide.github.io/malariasimulation/articles/Carrying-capacity.html)
+
+ - `set_carrying_capacity()`: changes mosquito carrying capacity, e.g. to model larval source management impact
+
+9. [Matching PfPR2-10 to EIR](https://mrc-ide.github.io/malariasimulation/articles/EIRprevmatch.html)
+
+ - Using *Pf*PR~2-10~ data to estimate EIR
+
+9. [Metapopulation Modelling](https://mrc-ide.github.io/malariasimulation/articles/Metapopulation.html)
+
+ - `run_metapop_simulation()`: run multiple interacting models simultaneously
+
+11. [Stochastic Variation](https://mrc-ide.github.io/malariasimulation/articles/Variation.html)
+
+ - `run_simulation_with_repetitions()`: running simulations with replicates
+
+12. [Parameter Variation](https://mrc-ide.github.io/malariasimulation/articles/ParameterVariation.html)
+
+ - `set_parameter_draw()`: incorporating parameter variation
diff --git a/vignettes/Model_human.svg b/vignettes/Model_human.svg
new file mode 100644
index 00000000..470ba600
--- /dev/null
+++ b/vignettes/Model_human.svg
@@ -0,0 +1,747 @@
+
+
+
+
+
+
+
+ %0
+
+ y2
+ Infection
+ "human_infection.R"
+
+
+
+ y4
+ Superinfection
+ "human_infection.R"
+
+
+
+ g2
+ Disease progression
+ "disease_progression.R"
+
+
+
+ y1
+
+
+
+ y1->y2
+
+
+
+ y3
+
+
+
+ y1->y3
+
+
+
+ y3->y4
+
+
+
+ g1
+
+
+
+ y3->g1
+
+
+
+ g1->g2
+
+
+
+ %0
+
+ S
+ S
+
+
+
+ i
+
+
+
+ S->i
+ Λ
+ i
+
+
+
+ D
+ D
+
+
+
+ A
+ A
+
+
+
+ D->A
+ r
+ D
+
+
+
+ U
+ U
+
+
+
+ A->U
+ r
+ A
+
+
+
+ A:sw->i:se
+ Λ
+ i
+
+
+
+ U:w->S:s
+ r
+ U
+
+
+
+ U->i:s
+ Λ
+ i
+
+
+
+ Tr
+ Tr
+
+
+
+ Tr:w->S:n
+ r
+ T
+
+
+
+ i->D
+ Ï•
+ i
+ (1-f
+ T
+ )
+
+
+
+ i->A
+ 1-Ï•
+ i
+
+
+
+ i->Tr
+ Ï•
+ i
+ f
+ T
+
+
+
diff --git a/vignettes/Model_mos.svg b/vignettes/Model_mos.svg
new file mode 100644
index 00000000..beee55cb
--- /dev/null
+++ b/vignettes/Model_mos.svg
@@ -0,0 +1,963 @@
+
+
+
+
+
+
+
+
+
+ %0
+
+
+ E
+ E
+
+
+
+ L
+ L
+
+
+
+ E->L
+ r
+ EL
+
+
+
+ I1
+
+
+
+ E->I1
+
+
+
+ I2
+
+
+
+ E->I2
+ µ
+ E
+ (t)
+
+
+
+ P
+ P
+
+
+
+ L->P
+ r
+ L
+
+
+
+ L->I2
+
+
+
+ I3
+
+
+
+ L->I3
+ µ
+ L
+ (t)
+
+
+
+ Sm
+ S
+ M
+
+
+
+ P->Sm
+ r
+ P
+
+
+
+ P->I3
+
+
+
+ I4
+
+
+
+ P->I4
+ µ
+ P
+
+
+
+ Pm
+ P
+ M
+
+
+
+ Sm->Pm
+ Λ
+ M
+
+
+
+ Sm->I4
+
+
+
+ I5
+
+
+
+ Sm->I5
+ µ
+ M
+
+
+
+ Im
+ I
+ M
+
+
+
+ Pm->Im
+ r
+ EM
+
+
+
+ Pm->I5
+
+
+
+ I6
+
+
+
+ Pm->I6
+ µ
+ M
+
+
+
+ Im->I6
+
+
+
+ I7
+
+
+
+ Im->I7
+ µ
+ M
+
+
+
+ I8
+
+
+
+ Im->I8
+
+
+
+ I8->I7
+
+
+
+ %0
+
+ g2
+ Development
+
+
+
+ y2
+ Infection
+
+
+
+ r2
+ Mortality
+
+
+
+ y1
+
+
+
+ y1->y2
+
+
+
+ r1
+
+
+
+ y1->r1
+
+
+
+ r1->r2
+
+
+
+ g1
+
+
+
+ g1->g2
+
+
+
+ g1->y1
+
+
+ Juvenile mosquitoes Adult mosquitoes
diff --git a/vignettes/Parameter_variation.Rmd b/vignettes/Parameter_variation.Rmd
new file mode 100644
index 00000000..a0eef828
--- /dev/null
+++ b/vignettes/Parameter_variation.Rmd
@@ -0,0 +1,86 @@
+---
+title: "Parameter Variation"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Parameter Variation}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+
+```{r setup, echo= FALSE}
+# Load the requisite packages:
+library(malariasimulation)
+# Set colour palette:
+cols <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
+knitr::opts_chunk$set(
+ collapse = TRUE,
+ comment = "#>",
+ dpi=300,
+ fig.width=7
+)
+```
+
+This vignette describes how variation in estimated model parameters can be incorporated into model simulations.
+
+## Estimating variation in parameters
+
+The malariasimulation transmission model was fit utilizing a Bayesian framework, which produced a posterior distribution of parameter sets. Default parameters for the model were taken as the median across 50 random sets of parameter draws.
+
+```{r, fig.align = 'center', out.width='100%'}
+## plot parasite prevalence with default model parameters
+simparams <- get_parameters(list(
+ human_population = 100,
+ individual_mosquitoes = FALSE
+))
+
+# Default (median) model parameters
+sim <- run_simulation(timesteps = 1000, simparams)
+
+# plot the default median parameter
+plot(
+ sim$timestep,
+ sim$n_detect_730_3650 / sim$n_730_3650,
+ t = "l",
+ ylim = c(0, 1),
+ ylab = "PfPr",
+ xlab = "Time in days",
+ xaxs = "i", yaxs = "i",
+ lwd = 2, main = 'Parasite prevalence over time with default model parameters',
+ cex.main = 0.9)
+grid(lty = 2, col = "grey80", lwd = 0.5)
+```
+
+If needed, we can produce stochastic model outputs incorporating variation in model parameters. This is done with the `set_parameter_draw` function, which pulls parameter draws from this joint posterior of Markov chain Monte Carlo (MCMC) fitting. This function overrides the default model parameters with a sample from one of 1000 draws from the joint posterior.
+
+Keep in mind that `set_parameter_draw` must be called prior to `set_equilibrium`, as the baseline transmission intensity must be calibrated to new model parameters.
+
+```{r, fig.align = 'center', out.width='100%'}
+## run simulation on different samples of the joint posterior distribution
+# plot the default median parameter
+plot(
+ sim$timestep[1:500],
+ sim$n_detect_730_3650[1:500] / sim$n_730_3650[1:500],
+ t = "l",
+ ylim = c(0, 1),
+ ylab = "PfPr",
+ xlab = "Time in days",
+ xaxs = "i", yaxs = "i",
+ main = 'Parasite prevalence over time for 8 sets of parameter draws',
+ cex.main = 0.9
+)
+grid(lty = 2, col = "grey80", lwd = 0.5)
+
+for (i in 1:7) {
+ param_draw <- simparams |>
+ set_parameter_draw(sample(1:1000, 1)) |>
+ set_equilibrium(init_EIR = 5)
+
+ sim <- run_simulation(timesteps = 500, param_draw)
+
+ lines(sim$timestep, sim$n_detect_730_3650 / sim$n_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
diff --git a/vignettes/SetSpecies.Rmd b/vignettes/SetSpecies.Rmd
new file mode 100644
index 00000000..10b1676d
--- /dev/null
+++ b/vignettes/SetSpecies.Rmd
@@ -0,0 +1,211 @@
+---
+title: "Mosquito species"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Mosquito species}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+ collapse = TRUE,
+ comment = "#>",
+ dpi=300,
+ fig.width=7
+)
+```
+
+```{r setup}
+# Load the requisite packages:
+library(malariasimulation)
+# Set colour palette:
+cols <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
+```
+
+As alluded to in the Model Structure, Vector Control: IRS, and Vector Control: Bed net vignettes, it is possible to account for varying proportions of mosquito species in the setting you are modelling using the `set_species()` function. IRS and bed nets could be expected to have different impacts depending on the proportion of each mosquito species because of variations in indoor resting, insecticide resistance, and proportion of bites on humans versus animals by species. If you have specified more than 1 species, then the arguments for `set_spraying()` and/or `set_bednets()` must be populated with values for each species at each timestep that the intervention is implemented.
+
+There are preset parameters for *An. gambiae*, *An. arabiensis*, *An. funestus* and *An. stephensi* that can be set by the helper objects `gamb_params`, `arab_params`, `fun_params` and `steph_params`, respectively. The default values for each species in these helper functions are from [Sherrard-Smith et al., 2018](https://doi.org/10.1038/s41467-018-07357-w). The parameters are:
+
+* `species`: the mosquito species name or signifier
+* `blood_meal_rates`: the blood meal rates for each species
+* `foraging_time`: time spent taking blood meals
+* `Q0`: proportion of blood meals taken on humans
+* `phi_bednets`: proportion of bites taken in bed
+* `phi_indoors`: proportion of bites taken indoors
+
+We will demonstrate how to specify different mosquito species and how this could alter intervention impact using an example with IRS.
+
+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,
+ 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,
+ 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)
+ grid(lty = 2, col = "grey80", lwd = 0.5)
+ legend("bottomleft", box.lty = 0,
+ legend = c("Prevalence for endophilic mosquitoes", "Prevalence for exophilic mosquitoes"),
+ col = c(cols[3], cols[5]), lty = c(1,1), lwd = 2, cex = 0.8, y.intersp = 1.3)
+}
+
+species_plot <- function(Mos_pops){
+ plot(x = Mos_pops[,1], y = Mos_pops[,2], type = "l", col = cols[2],
+ ylim = c(0,max(Mos_pops[,-1]*1.25)), ylab = "Mosquito population size", xlab = "Days",
+ xaxs = "i", yaxs = "i", lwd = 2)
+ grid(lty = 2, col = "grey80", lwd = 0.5)
+ sapply(3:4, function(x){
+ points(x = Mos_pops[,1], y = Mos_pops[,x], type = "l", col = cols[x])})
+ legend("topright", legend = c("A. arab","A. fun","A. gamb"),
+ col = cols[-1], lty = 1, lwd = 2, ncol = 1, cex = 0.8, bty = "n")
+ }
+
+```
+
+## Setting mosquito species parameters
+
+
+### Single endophilic mosquito species
+
+Use the `get_parameters()` function to generate a list of parameters, accepting most of the default values, but modifying seasonality values to model a seasonal setting. We will use `set_species` to model mosquitoes similar to *An. funestus* but with a higher propensity to bite indoors (which we will name "endophilic"). Then, we use the `set_equilibrium()` function to to initialise the model at a given entomological inoculation rate (EIR).
+
+We used the `set_spraying()` function to set an IRS intervention. This function takes as arguments the parameter list, timesteps of spraying, coverage of IRS in the population and a series of parameters related to the insecticide used in the IRS. The proportion of mosquitoes dying following entering a hut is dependent on the parameters `ls_theta`, the initial efficacy, and `ls_gamma`, how it changes over time. The proportion of mosquitoes successfully feeding is dependent on `ks_theta`, the initial impact of the insecticide in IRS, and `ks_gamma`, how the impact changes over time. Finally, the proportion of mosquitoes being deterred away from a sprayed hut depends on `ms_theta`, the initial impact of IRS, and `ms_gamma`, the change in impact over time. See a more comprehensive explanation in the Supplementary Information of [Sherrard-Smith et al., 2018](https://doi.org/10.1038/s41467-018-07357-w).
+
+```{r}
+year <- 365
+month <- 30
+sim_length <- 3 * year
+human_population <- 1000
+starting_EIR <- 50
+
+simparams <- get_parameters(
+ list(
+ human_population = human_population,
+ # seasonality parameters
+ model_seasonality = TRUE,
+ g0 = 0.285277,
+ g = c(-0.0248801, -0.0529426, -0.0168910),
+ h = c(-0.0216681, -0.0242904, -0.0073646)
+ )
+)
+
+peak <- peak_season_offset(simparams)
+
+# Create an example mosquito species (named endophilic) with a high value for `phi_indoors`
+endophilic_mosquito_params <- fun_params
+endophilic_mosquito_params$phi_indoors <- 0.9
+endophilic_mosquito_params$species <- 'endophilic'
+
+## Set mosquito species with a high propensity for indoor biting
+simparams <- set_species(
+ simparams,
+ species = list(endophilic_mosquito_params),
+ proportions = c(1)
+)
+
+sprayingtimesteps <- c(1, 2) * year + peak - 3 * month # There is a round of IRS in the 1st and second year 3 months prior to peak transmission.
+
+simparams <- set_spraying(
+ simparams,
+ timesteps = sprayingtimesteps,
+ coverages = rep(.8, 2), # # Each round covers 80% of the population
+ # nrows=length(timesteps), ncols=length(species)
+ ls_theta = matrix(2.025, nrow=length(sprayingtimesteps), ncol=1), # Matrix of mortality parameters per round of IRS and per species
+ ls_gamma = matrix(-0.009, nrow=length(sprayingtimesteps), ncol=1), # Matrix of mortality parameters per round of IRS and per species
+ ks_theta = matrix(-2.222, nrow=length(sprayingtimesteps), ncol=1), # Matrix of feeding success parameters per round of IRS and per species
+ ks_gamma = matrix(0.008, nrow=length(sprayingtimesteps), ncol=1), # Matrix of feeding success parameters per round of IRS and per species
+ ms_theta = matrix(-1.232, nrow=length(sprayingtimesteps), ncol=1), # Matrix of deterrence parameters per round of IRS and per species
+ ms_gamma = matrix(-0.009, nrow=length(sprayingtimesteps), ncol=1) # Matrix of deterrence parameters per round of IRS and per species
+)
+
+simparams <- set_equilibrium(simparams, starting_EIR)
+
+# Running simulation with IRS
+output_endophilic <- run_simulation(timesteps = sim_length, parameters = simparams)
+```
+
+We can see below that only the endophilic species is modelled.
+```{r}
+simparams$species
+simparams$species_proportions
+```
+
+### Single exophilic mosquito species
+
+We will run the same model with IRS as above, but this time with an example mosquito species similar to *An. funestus*, but with a lower propensity to bite indoors (which we will name "exophilic"). Note that now there are two rows for the `ls_theta`, `ls_gamma`, `ks_theta`, `ks_gamma`, `ms_theta`, and `ms_gamma` arguments (rows represent timesteps where changes occur, columns represent additional species). See the Vector Control: IRS vignette for more information about setting IRS with different mosquito species.
+
+```{r, fig.align = 'center', out.width='100%'}
+# Create an example mosquito species (named exophilic) with a low value for `phi_indoors`
+exophilic_mosquito_params <- fun_params
+exophilic_mosquito_params$phi_indoors <- 0.2
+exophilic_mosquito_params$species <- 'exophilic'
+
+## Set mosquito species with a low propensity for indoor biting
+simparams <- set_species(
+ simparams,
+ species = list(exophilic_mosquito_params),
+ proportions = c(1)
+)
+
+peak <- peak_season_offset(simparams)
+
+sprayingtimesteps <- c(1, 2) * year + peak - 3 * month # There is a round of IRS in the 1st and second year 3 months prior to peak transmission.
+
+simparams <- set_spraying(
+ simparams,
+ timesteps = sprayingtimesteps,
+ coverages = rep(.8, 2), # # Each round covers 80% of the population
+ # nrows=length(timesteps), ncols=length(species)
+ ls_theta = matrix(2.025, nrow=length(sprayingtimesteps), ncol=1), # Matrix of mortality parameters
+ ls_gamma = matrix(-0.009, nrow=length(sprayingtimesteps), ncol=1), # Matrix of mortality parameters per round of IRS and per species
+ ks_theta = matrix(-2.222, nrow=length(sprayingtimesteps), ncol=1), # Matrix of feeding success parameters per round of IRS and per species
+ ks_gamma = matrix(0.008, nrow=length(sprayingtimesteps), ncol=1), # Matrix of feeding success parameters per round of IRS and per species
+ ms_theta = matrix(-1.232, nrow=length(sprayingtimesteps), ncol=1), # Matrix of deterrence parameters per round of IRS and per species
+ ms_gamma = matrix(-0.009, nrow=length(sprayingtimesteps), ncol=1) # Matrix of deterrence parameters per round of IRS and per species
+)
+
+output_exophilic <- run_simulation(timesteps = sim_length, parameters = simparams)
+```
+
+### Plot adult female infectious mosquitoes by species over time
+
+In the plot below, we can see that IRS is much more effective when the endophilic mosquito species is modelled compared to the scenario where an exophilic species is modelled. In this case, IRS will not be as effective because a larger proportion of bites take place outside of the home.
+```{r, fig.align = 'center', out.width='100%'}
+plot_prev()
+```
+
+## Setting multiple mosquito species
+
+Finally, we give an example of how to set multiple mosquito species.
+
+
+```{r, fig.align = 'center', out.width='100%'}
+# Update parameter list with species distributions
+simparams <- get_parameters(
+ list(
+ human_population = human_population,
+ # seasonality parameters
+ model_seasonality = TRUE,
+ g0 = 0.285277,
+ g = c(-0.0248801, -0.0529426, -0.0168910),
+ h = c(-0.0216681, -0.0242904, -0.0073646)
+ )
+)
+
+params_species <- set_species(parameters = simparams,
+ species = list(arab_params, fun_params, gamb_params),
+ proportions = c(0.1,0.3,0.6))
+
+# Run simulation
+species_simulation <- run_simulation(timesteps = sim_length, parameters = params_species)
+
+## Plot species distributions
+Mos_sp_dist_sim <- species_simulation[,c("timestep", "total_M_arab", "total_M_fun", "total_M_gamb")]
+species_plot(Mos_sp_dist_sim)
+```
+
diff --git a/vignettes/Treatment.Rmd b/vignettes/Treatment.Rmd
index 3986c202..d325aa74 100644
--- a/vignettes/Treatment.Rmd
+++ b/vignettes/Treatment.Rmd
@@ -10,55 +10,135 @@ vignette: >
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
- comment = "#>"
+ comment = "#>",
+ dpi=300,
+ fig.width=7
)
```
```{r setup}
-suppressPackageStartupMessages(library(ggplot2))
+# Load the requisite packages:
library(malariasimulation)
-library(malariaEquilibrium)
+# Set colour palette:
+cols <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
```
-Set up some baseline parameters:
+This vignette describes how to implement clinical drug treatments in malariasimulation.
+
+The malariasimulation package contains built-in parameters sets for three anti-malarial drugs:
+
+1. `AL_params`: artemether-lumefantrine (AL)
+2. `DHA_PQP_params`: dihydroartemisinin and piperaquine (DHA-PQP)
+3. `SP_AQ_params`: sulfadoxine-pyrimethamine and amodiaquine (SP-AQ)
+
+While all these drugs can be used to treat malaria, DHA-PQP and SP-AQ remain in the body for some time following treatment, making them good candidates for chemoprevention in mass drug administrations (see [Mass Drug Administration and Chemoprevention](https://mrc-ide.github.io/malariasimulation/articles/MDA.html)). Any of these drugs can be included in the parameter list using the `set_drugs()` function (see [drugs_parameters.R](https://github.com/mrc-ide/malariasimulation/blob/master/R/drug_parameters.R) for full parameter details).
+
+Each drug parameter set is a vector of length four, with parameters that represent the drug efficacy, the infectiousness following treatment relative to an untreated infection, and parameters that determine the protection against reinfection ($P$): shape ($w$) and scale ($\lambda$). The decay of protection against infection follows a weibull distribution as follows:
+
+$$P = e^{{(-t/\lambda)}^w}$$
+
+The $P$ for each drug following treatment through time is plotted below.
+
+```{r, fig.align = 'center', out.width='100%'}
+calc_P <- function(w, lambda, t){
+ P <- exp(-(t/lambda)^w)
+}
+
+t <- 1:70
+
+P_matrix <- lapply(list(AL_params, DHA_PQP_params, SP_AQ_params), function(x){
+ calc_P(w = x[3], lambda = x[4], t = t)
+})
+
+plot(x = t, y = P_matrix[[1]], type = "l", col = cols[1],
+ xlab = "Days", ylab = expression(paste("Protection against reinfection (",italic(P),")")),
+ xaxs = "i", yaxs = "i", lwd = 2)
+grid(lty = 2, col = "grey80", lwd = 0.5)
+
+#
+invisible(sapply(2:3, function(x){
+ points(x = t, y = P_matrix[[x]], type = "l", col = cols[x], lwd = 2)
+}))
+
+# Add legend
+legend("topright", legend = c("AL","DHA-PQP","SP-AQ"), col = cols, lty = 1, lwd = 2, cex = 0.8)
+```
+
+For more details, please see:
+
+Okell, L., Cairns, M., Griffin, J. *et al.* Contrasting benefits of different artemisinin combination therapies as first-line malaria treatments using model-based cost-effectiveness analysis. *Nat Commun* **5**, 5606 (2014). .
+
+## Setting drugs and clinical treatment
+
+Drug parameters can be incorporated into a complete parameter set using the `set_drugs()` function which takes the full parameter set and a list of drug parameter sets.
+
+A treatment regimen for each drug can then be described using the `set_clinical_treatment()` function which takes the drug index, a vector of timesteps at which a change in coverage occurs (where the initial coverage is 0 until the first timestep specified) and a vector of coverages for the drug that correspond with the timestep changes, as well as the complete parameter set.
+
+Multiple drugs can be modelled simultaneously, with treatment coverage that can be specified for each drug. This function must be used for each drug included (e.g., if there are two drugs, `set_clinical_treatment()` must be called twice to specify the treatment plan).
+
+### Parameterisation and simulation
+
+We will run a simulation for two years using AL and DHA-PQP treatment regimens. We begin our AL and DHA-PQP treatments on day 300 at 40% and 30% coverage, respectively. We provide these treatments for 300 days before the regimen ends. Note that the sum of treatment coverages cannot exceed 100% at any timestep.
+
+Prior to the simulation, the function `set_equilibrium` can also be used to generate equilibrium values for the human and mosquito populations.
```{r}
+# Daily simulation timesteps for two years
year <- 365
sim_length <- 2 * year
+
+# With a population size of 1000
human_population <- 1000
-simparams <- get_parameters(list(human_population = human_population))
-simparams <- set_drugs(simparams, list(AL_params, DHA_PQP_params))
-```
+# Set human population size
+simparams <- get_parameters(overrides = list(human_population = human_population))
-Run the model for some starting EIRs and fts:
+# Update parameter set with chosen drug-specific parameters (AL and DHA/PQP)
+drug_params <- set_drugs(simparams, list(AL_params, DHA_PQP_params))
+
+# Choose initial EIR to 10
+starting_EIR <- 10
+
+# Set treatment program for AL (drug index = 1)
+treatment_params <- set_clinical_treatment(
+ parameters = drug_params,
+ drug = 1,
+ timesteps = c(300,600), # Treatment coverage changes on day 300 and day 600
+ coverages = c(0.4,0)) # The initial treatment coverage (0%) is the default
+# and does not need to be set
+
+# Set treatment program for DHA-PQP (drug index = 2)
+treatment_params <- set_clinical_treatment(
+ parameters = treatment_params,
+ drug = 2,
+ timesteps = c(300,600),
+ coverages = c(0.3,0))
+
+# Use set_equilibrium to update the parameter set for a given initial EIR
+treatment_params <- set_equilibrium(treatment_params, starting_EIR)
+
+# Run simulation:
+output <- run_simulation(sim_length, treatment_params)
-```{r}
-outputs <- list()
-starting_EIR <- 10
-fts <- c(0, .25, .5, .75, 1.)
-
-for (ft in fts) {
- simparams <- set_clinical_treatment(simparams, 1, 1, ft / 2)
- simparams <- set_clinical_treatment(simparams, 2, 1, ft / 2)
- simparams <- set_equilibrium(simparams, starting_EIR)
- output <- run_simulation(sim_length, simparams)
- # cut out the warmup
- output <- output[output$timestep > year,]
- outputs[[length(outputs) + 1]] <- output
-}
```
-Let's plot the effect of ft on PfPR2-10:
+### Visualisation
-```{r}
-df <- do.call('rbind', lapply(seq_along(outputs), function(i) {
- df <- outputs[[i]][c('timestep', 'n_detect_730_3650', 'n_730_3650')]
- df$ft <- fts[[i]]
- df
-}))
-
-ggplot(df) + geom_line(
- aes(x = timestep, y = (n_detect_730_3650/n_730_3650), colour = ft)) +
- labs(x = "timestep", y = "PfPR2-10")
+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`.
+
+```{r, fig.align = 'center', out.width='100%'}
+# Plot results
+plot(x = output$timestep, y = output$n_detect_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),
+ 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)
+abline(v = 600, lty = 2)
+text(x = 610, y = max(output$n_detect_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 d7365dcc..02eb9358 100644
--- a/vignettes/Vaccines.Rmd
+++ b/vignettes/Vaccines.Rmd
@@ -7,21 +7,116 @@ vignette: >
%\VignetteEncoding{UTF-8}
---
-```{r, include = FALSE}
+```{r, include = FALSE, message=FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
- comment = "#>"
+ comment = "#>",
+ dpi=300,
+ fig.width=7
)
```
-```{r setup}
-suppressPackageStartupMessages(library(ggplot2))
+```{r setup, message=FALSE, class.source = 'fold-hide'}
+# Load the requisite packages:
library(malariasimulation)
+# Set colour palette:
+cols <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
```
-# Parameterisation
+In this vignette, we will explore how to model different strategies for both pre-erythrocytic malaria vaccines and a theoretical malaria transmission blocking vaccine (TBV). Parameters for a pre-erythrocytic vaccine can be set for a routine age-based Expanded Programme on Immunization (EPI) strategy or a mass vaccination strategy using the helper functions `set_pev_epi()` and `set_mass_pev()`, while parameters for a TBV can be set using `set_tbv()`. Under an EPI strategy, everybody within a certain age range will be vaccinated within the routine immunisation system. A mass vaccination strategy is typically a one-time event where everybody, or everybody within a certain age group, is targeted for vaccination during a relatively short window of time. If you are modelling a seasonal setting, then it is also possible to schedule vaccination relative to the expected peak of malaria prevalence given by `peak_season_offset()`.
+
+First, we will define a few functions to visualise the outputs.
+
+```{r, class.source = 'fold-hide'}
+# Plotting clinical incidence
+plot_inci <- function(type = "not seasonal"){
+ if(type == "seasonal"){
+ comparison <- output_seas_control
+ vaccinetime <- round(year + (peak - month * 3.5), 0) / 365
+ } else {
+ comparison <- output_control
+ vaccinetime <- 1
+ }
+ output$clinical_incidence <- 1000 * output$n_inc_clinical_0_1825 / output$n_0_1825
+ output$time_year <- output$timestep / year
+ comparison$clinical_incidence <- 1000 * comparison$n_inc_clinical_0_1825 / comparison$n_0_1825
+ comparison$time_year <- comparison$timestep / year
+
+ plot(x = output$time_year, y = output$clinical_incidence,
+ type = "l", col = cols[2],
+ xlab = "Time (years)", ylab = "Clinical incidence (per 1000 children aged 0-5)",
+ ylim = c(0, max(output$clinical_incidence)*1.3),
+ xaxs = "i", yaxs = "i")
+ grid(lty = 2, col = "grey80", lwd = 0.5)
+ abline(v = vaccinetime, col = "black", lty = 2, lwd = 2.5)
+ text(x = vaccinetime + 0.05, y = max(output$clinical_incidence)*1.2, labels = "Start of\nvaccination", adj = 0, cex = 0.8)
+ curve_values <- loess(clinical_incidence ~ time_year, data = output,
+ span = 0.3, method = "loess")
+ lines(output$time_year, predict(curve_values),
+ col = cols[5], lwd = 3)
+ curve_valuescomp <- loess(clinical_incidence ~ time_year, data = comparison, span = 0.3,
+ method = "loess")
+ lines(comparison$time_year, predict(curve_valuescomp),
+ col = cols[6], lwd = 3)
+ legend("topright", box.lty = 0, bg = "white",
+ legend = c("Unsmoothed incidence for\nvaccine scenario",
+ "Smoothed incidence for\nvaccine scenario",
+ "Smoothed incidence for no\nintervention scenario"),
+ col = c(cols[2], cols[5], cols[6]), lty = c(1, 1, 1), lwd = 2.5, cex = 0.8, y.intersp = 1.5)
+}
+
+# Plot parasite prevalence
+plot_prev <- function(type = "not seasonal"){
+ if(type == "seasonal"){
+ comparison <- output_seas_control
+ vaccinetime <- round(year + (peak - month * 3.5), 0) / 365
+ } else {
+ comparison <- output_control
+ vaccinetime <- 1
+ }
+ 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,
+ 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,
+ 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)
+ legend("topright", box.lty = 0,
+ legend = c("Prevalence for\nvaccine scenario",
+ "Prevalence for no\nintervention scenario"),
+ col = c(cols[3], cols[6]), lty = c(1, 1),
+ lwd = 2.5, cex = 0.8, y.intersp = 1.5)
+}
+
+# Plot dose timing
+plot_doses <- function(){
+ output$month <- ceiling(output$timestep / month)
+ doses <- output[, c(grep("n_pev" , names(output)), grep("month", names(output)))]
+ doses <- aggregate(cbind(doses[1:4]),
+ by = list(doses$month),
+ FUN = sum)
+ doses <- as.matrix(t(doses[, -1]))
+
+ barplot(doses, xlab = "Month",
+ ylab = "Number of doses",
+ col = cols[1:6], space = 0, axes = T,
+ beside = FALSE, xaxs = "i", yaxs = "i",
+ ylim = c(0, max(colSums(doses))*1.1))
+ grid(lty = 2, col = "grey80", lwd = 0.5);box()
+ axis(side = 1, lty = 1, col = "black", pos = 0)
+ legend("topleft", box.lty = 0, legend = c("Dose 1","Dose 2","Dose 3","Booster 1"),
+ fill = cols[1:6], bg="transparent", cex = 0.8, y.intersp = 1.5)
+}
+```
+
+## Parameterisation
-In this tutorial we are going to explore different strategies for malaria vaccine implementation. Begin by setting the default parameters to run the simulation from an equilibrium starting point.
+We use the `get_parameters()` function to generate a list of parameters, accepting most of the default values, and then use the `set_equilibrium()` function to to initialise the model at a given entomological inoculation rate (EIR).
```{r}
year <- 365
@@ -32,171 +127,309 @@ starting_EIR <- 20
simparams <- get_parameters(list(
human_population = human_population,
- incidence_rendering_min_ages = 0,
- incidence_rendering_max_ages = 5 * year,
+ clinical_incidence_rendering_min_ages = 0,
+ clinical_incidence_rendering_max_ages = 5 * year,
individual_mosquitoes = FALSE
)
)
-simparams <- set_equilibrium(simparams, starting_EIR)
+simparams <- set_equilibrium(parameters = simparams, init_EIR = starting_EIR)
+
+# Run a model with no interventions in a setting with no seasonality
+output_control <- run_simulation(timesteps = sim_length * 2, parameters = simparams)
```
-Then we can run the simulation for a variety of vaccination strategies:
+Then we can run the simulation for a variety of vaccination strategies.
## Mass RTS,S
-This intervention implements a round of RTS,S vaccination (3 doses) for individuals between 5 and 17 months at a single time point followed by a single booster dose 18 months after the primary series. We specify that the intervention should use the RTS,S vaccine through the `profile` and `booster_profile` inputs.
+First, we will model a single round of RTS,S vaccine given in a mass vaccination strategy where those within a given age range will be vaccinated to a specified coverage level during a short window of time. In this example, individuals aged between 5 months and 50 years are vaccinated with a primary series (3 doses) followed by a single booster 12 months after the initial vaccination. The age groups to be vaccinated as well as timing of all vaccinations can be modified within the `set_mass_pev()` function. The model assumes that protection starts following the 3rd dose of the primary series.
+
+We specify that the intervention should use the RTS,S vaccine through the `profile` and `booster_profile` inputs.
+
+### Simulation
```{r}
-rtssparams <- simparams
-
-rtssparams <- set_mass_pev(
- rtssparams,
- profile = rtss_profile,
- timesteps = 1 * year,
- coverages = 1,
- min_wait = 0,
- min_ages = 5 * month,
- max_ages = 17 * month,
- booster_timestep = 18 * month,
- booster_coverage = 0.95,
- booster_profile = list(rtss_booster_profile)
+rtssmassparams <- set_mass_pev(
+ simparams,
+ profile = rtss_profile, # We will model implementation of the RTSS vaccine.
+ timesteps = 1 * year, # The single round of vaccination is at 1 year into the simulation.
+ coverages = 1, # The vaccine is given to 100% of the population between the specified ages.
+ 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_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.
)
-output <- run_simulation(sim_length, rtssparams)
-output$clinical_incidence <- 1000 * output$n_inc_0_1825 / output$n_0_1825
+output <- run_simulation(timesteps = sim_length, parameters = rtssmassparams)
+```
+
+### Visualisation
+
+```{r, fig.align = 'center', out.width='100%'}
+# Plot clinical incidence
+plot_inci()
+```
-ggplot(data = output, aes(x = timestep / 365, y = clinical_incidence)) +
- geom_line(col = "grey80") +
- stat_smooth(col = "darkblue", se = FALSE) +
- geom_vline(xintercept = 1, col = "red") +
- xlab("year") +
- ylab("Clinical incidence \n (per 1000 children aged 0-5)") +
- theme_bw()
+```{r, fig.align = 'center', out.width='100%'}
+# Plot prevalence
+plot_prev()
```
-We can look at the distribution of doses using the n_pev_mass_dose\_\* outputs:
+You can look at the distribution of doses using the `n_pev_mass_dose_*` or `n_pev_epi_dose_*` outputs. It is always a good idea to check the timing of vaccine doses to ensure that it is specified as intended.
+
+```{r, fig.align = 'center', out.width='100%', message=FALSE}
+# Plot doses
+plot_doses()
+```
+
+## Seasonal mass vaccination
+
+Mass vaccination can also be targeted seasonally. For example, we may want to have a mass vaccination campaign take place a few months prior to the peak transmission season. In the example below, we will create a parameter set with seasonality and first run a simulation with no vaccine, then run a simulation with a mass vaccination campaign targeting everyone between the ages of 5 months and 50 years.
+
+We specify that the intervention should use the RTS,S vaccine through the `profile` and `booster_profile` inputs to the `set_mass_pev()` function.
+
+### Simulation
```{r}
-dose_data <- data.frame(timestep = output$timestep,
- dose = rep(c("mass 1", "mass 2", "mass 3", "mass booster"), each = length(output$timestep)),
- n = c(output$n_pev_mass_dose_1, output$n_pev_mass_dose_2, output$n_pev_mass_dose_3,
- output$n_pev_mass_booster_1))
-dose_data[dose_data$n > 0, ]
+# Use the get_parameters() function to generate a new parameter set with a seasonal profile with malaria incidence in children aged 0-5 rendered in the model output:
+seas_simparams <- get_parameters(
+ list(
+ human_population = human_population,
+ clinical_incidence_rendering_min_ages = 0,
+ clinical_incidence_rendering_max_ages = 5 * year,
+ individual_mosquitoes = FALSE,
+ model_seasonality = TRUE,
+ g0 = 0.285505,
+ g = c(-0.325352, -0.0109352, 0.0779865),
+ h = c(-0.132815, 0.104675, -0.013919)
+ )
+)
+seas_simparams <- set_equilibrium(parameters = seas_simparams, init_EIR = starting_EIR)
+
+# Run no vaccine scenario
+output_seas_control <- run_simulation(timesteps = sim_length * 2, parameters = seas_simparams)
+```
+
+Next, we will run the scenario with a seasonal mass vaccination campaign implemented starting 3.5 months before the peak of the transmission season.
+```{r}
+# Find the peak seasonality
+peak <- peak_season_offset(seas_simparams)
+
+seasmass_simparams <- set_mass_pev(
+ parameters = seas_simparams,
+ profile = rtss_profile, # We will model implementation of the RTSS vaccine.
+ timesteps = round(year + (peak - month * 3.5), 0),# The vaccination will begin 3.5 months prior to the peak seasonality in the second year.
+ coverages = 1, # 100% of the population between min_ages and max_ages is vaccinated.
+ 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_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.
+ )
+
+output <- run_simulation(timesteps = sim_length * 2, parameters = seasmass_simparams)
+```
+
+### Visualisation
+
+```{r, fig.align = 'center', out.width='100%'}
+# Plot clinical incidence
+plot_inci(type = "seasonal")
+```
+
+```{r, fig.align = 'center', out.width='100%'}
+# Plot prevalence
+plot_prev(type = "seasonal")
+```
+
+```{r, fig.align = 'center', out.width='100%', message=FALSE}
+# Plot doses
+plot_doses()
```
+
## RTS,S EPI
-This intervention implements a more gradual age-based dosing of RTS,S vaccination such as would occur under the Expanded Programme on Immunization (EPI). Individuals here will be vaccinated once they reach 5 months of age. We specify that the intervention should use the RTS,S vaccine through the `profile` and `booster_profile` inputs.
+We can also opt to vaccinate using the EPI strategy, where individuals will be vaccinated once they reach a certain age. In the example below, individuals will be vaccinated once they reach 5 months of age. For this intervention, we see a much more gradual impact following implementation compared to the mass vaccination strategy. Note: the model assumes that protection from the vaccine begins after the third dose.
-```{r}
-rtssepiparams <- simparams
+### Simulation
-# Add RTS,S strategy
+```{r}
+# Add RTS,S EPI strategy
rtssepiparams <- set_pev_epi(
- rtssepiparams,
- profile = rtss_profile,
- timesteps = 1 * year,
- coverages = 1,
- min_wait = 0,
- age = 5 * month,
- booster_timestep = 18 * month,
- booster_coverage = 0.95,
- booster_profile = list(rtss_booster_profile)
+ simparams,
+ profile = rtss_profile, # We will model implementation of the RTSS vaccine.
+ timesteps = 1 * year, # Vaccination will begin at 1 year into the simulation.
+ 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_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.
)
-output <- run_simulation(sim_length * 2, rtssepiparams)
-output$clinical_incidence <- 1000 * output$n_inc_0_1825 / output$n_0_1825
+output <- run_simulation(timesteps = sim_length * 2, parameters = rtssepiparams)
+```
+
+The default values for the `pev_doses` variable shows that individuals will be vaccinated with dose one at day 0, or the day that the vaccine campaign begins (at 1 year in the example above), with dose two 45 days after the first dose, and with dose three 90 days after the first dose. This will correspond to ages 5, 6.5, and 8 months for the primary series. The booster will be administered 12 months after dose three, which is at 20 months of age in the example above.
+```{r}
+rtssepiparams$pev_doses
+```
+
+
+### Visualisation
+
+```{r, fig.align = 'center', out.width='100%'}
+# Plot clinical incidence
+plot_inci()
+```
+
+```{r, fig.align = 'center', out.width='100%'}
+# Plot prevalence
+plot_prev()
+```
+
+A limited impact upon prevalence is observed because the target population for vaccination is small relative to the entire population, resulting only in direct protection of those vaccinated.
-ggplot(data = output, aes(x = timestep / 365, y = clinical_incidence)) +
- geom_line(col = "grey80") +
- stat_smooth(col = "darkblue", se = FALSE) +
- geom_vline(xintercept = 1, col = "red") +
- xlab("year") +
- ylab("Clinical incidence \n (per 1000 children aged 0-5)") +
- theme_bw()
+```{r, fig.align = 'center', out.width='100%', message=FALSE}
+# Plot doses
+plot_doses()
```
-We see a much more gradual decrease in clinical incidence following EPI implementation compared to the mass vaccination strategy.
+
+## RTS,S EPI with seasonal boosters
-## RTS,S seasonal boosters
+In a seasonal setting, we can set booster timesteps relative to the start of the year instead of relative to the last dose. This allows us to consider seasonal dynamics and implement booster doses right before the start of the high transmission season to maximise impact.
-In a seasonal setting, we can set booster timesteps relative to the start of the year. This allows us to consider seasonal dynamics and implement booster doses right before the start of the high transmission season to maximize impact.
+### Simulation
```{r}
-rtssepiseasonalparams <- simparams
-rtssepiseasonalparams$model_seasonality = TRUE
-rtssepiseasonalparams$g0 = 0.28605
-rtssepiseasonalparams$g = c(0.20636, -0.0740318, -0.0009293)
-rtssepiseasonalparams$h = c(0.173743, -0.0730962, -0.116019)
-peak <- peak_season_offset(rtssepiseasonalparams)
+# Calculate the peak of the transmission season based on seasonality parameters above.
+peak <- peak_season_offset(seas_simparams)
# Add RTS,S seasonal strategy
rtssepiseasonalparams <- set_pev_epi(
- rtssepiseasonalparams,
- profile = rtss_profile,
- timesteps = 1 * year,
- coverages = 1,
- min_wait = 6 * month,
- age = 5 * month,
- booster_timestep = (peak - 3 * month) + c(0, year),
- booster_coverage = rep(.7, 2),
- booster_profile = list(rtss_booster_profile, rtss_booster_profile),
- seasonal_boosters = TRUE
+ seas_simparams,
+ profile = rtss_profile, # We will model implementation of the RTSS vaccine.
+ timesteps = 1 * year, # Vaccination begins 1 year after the start of the simulation.
+ 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_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.
)
+output <- run_simulation(timesteps = sim_length * 2, parameters = rtssepiseasonalparams)
+```
+
+### Visualisation
+
+```{r, fig.align = 'center', out.width='100%'}
+# Plot clinical incidence
+plot_inci(type = "seasonal")
+```
+
+```{r, fig.align = 'center', out.width='100%'}
+# Plot prevalence
+plot_prev(type = "seasonal")
+```
+
+```{r, fig.align = 'center', out.width='100%', message=FALSE}
+# Plot doses
+plot_doses()
```
## RTS,S dosing
-We can also try different dosing schedules using the `pev_doses` parameter. Here we administer dose 1 at 5 months, dose 2 30 days after dose 1, and dose 3 60 days after dose 1. We also administer three booster doses 12, 18, and 24 months following dose 3.
+We can implement different dosing schedules using the `pev_doses` parameter. Here we administer dose one at 5 months, dose two 30 days after dose one, and dose three 60 days after dose one. We also administer two booster doses 12 and 24 months following dose three. As before, it is a good idea to visualise the dose timing to ensure that the vaccine is implemented as intended.
+
+### Simulation
```{r}
-rtssepiparams2 <- rtssepiparams
-rtssepiparams2$pev_doses <- c(0, 30, 60)
rtssepiparams2 <- set_pev_epi(
- rtssepiparams2,
- profile = rtss_profile,
- timesteps = 1 * year,
- coverages = 1,
- age = 5 * month,
- min_wait = 0,
- booster_timestep = c(12 * month, 18 * month, 24 * month),
- booster_coverage = c(1, 1, 1),
- booster_profile = list(
- rtss_booster_profile,
- rtss_booster_profile,
- rtss_booster_profile
- )
+ simparams,
+ profile = rtss_profile, # We will model implementation of the RTSS vaccine.
+ timesteps = 1 * year, # Vaccination begins 1 year after the start of the simulation.
+ 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_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.
)
+
+rtssepiparams2$pev_doses <- c(0, 30, 60) # setting the timesteps for the 3 doses in the primary series at 0, 1, 2 months
+
+output <- run_simulation(timesteps = sim_length * 2, parameters = rtssepiparams2)
+```
+
+### Visualisation
+
+```{r, fig.align = 'center', out.width='100%'}
+# Plot clinical incidence
+plot_inci()
+```
+
+```{r, fig.align = 'center', out.width='100%'}
+# Plot prevalence
+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 <- aggregate(cbind(doses[1:5]),
+ by = list(doses$month),
+ FUN = sum)
+doses <- as.matrix(t(doses[, -1]))
+
+barplot(doses, xlab = "Month",
+ ylab = "Number of doses",
+ col = cols[1:6], space = 0, axes = T,
+ beside = FALSE, xaxs = "i", yaxs = "i",
+ ylim = c(0, max(colSums(doses))*1.1))
+ grid(lty = 2, col = "grey80", lwd = 0.5);box()
+ axis(side = 1, lty = 1, col = "black", pos = 0)
+ legend("topleft", box.lty = 0, legend = c("Dose 1","Dose 2","Dose 3","Booster 1", "Booster 2"),
+ fill = cols[1:6], y.intersp = 1.5, bg = "transparent", cex = 0.8)
```
## TBV
-We can also model vaccines with completely different modes of actions. For example, transmission blocking vaccines (TBV). This example demonstrates administration of 5 rounds of TBV to a proportion of the population ages 5 to 60 years.
+We can also model a hypothetical transmission blocking vaccine (TBV). This example shows 5 rounds of a TBV to 99% of the population aged 5 and 60.
-```{r}
-tbvparams <- simparams
+### Simulation
+```{r}
tbvparams <- set_tbv(
- tbvparams,
- timesteps = round(c(1, 1.25, 1.5, 1.75, 2) * 365),
- coverages = rep(0.99, 5),
- ages = 5:60
+ simparams,
+ timesteps = round(c(1, 1.25, 1.5, 1.75, 2) * 365), # The TBV will be given at year 1, year 2, and every 3 months in between.
+ coverages = rep(0.99, 5), # 99% of the population will be covered.
+ ages = 5:60 # The age range in years of those receiving the vaccine.
)
-output <- run_simulation(sim_length, tbvparams)
-output$clinical_incidence <- 1000 * output$n_inc_0_1825 / output$n_0_1825
+output <- run_simulation(timesteps = sim_length, parameters = tbvparams)
+```
+
+### Visualisation
-ggplot(data = output, aes(x = timestep / 365, y = clinical_incidence)) +
- geom_line(col = "grey80") +
- stat_smooth(col = "darkblue", se = FALSE) +
- geom_vline(xintercept = 1, col = "red") +
- xlab("year") +
- ylab("Clinical incidence \n (per 1000 children aged 0-5)") +
- theme_bw()
+```{r, fig.align = 'center', out.width='100%'}
+# Plot clinical incidence
+plot_inci()
+```
+```{r, fig.align = 'center', out.width='100%'}
+# Plot prevalence
+plot_prev()
```
diff --git a/vignettes/Variation.Rmd b/vignettes/Variation.Rmd
index e8f39746..7146d47f 100644
--- a/vignettes/Variation.Rmd
+++ b/vignettes/Variation.Rmd
@@ -1,91 +1,201 @@
---
-title: "Variation"
-output: html_document
+title: "Stochastic Variation"
+output: rmarkdown::html_vignette
vignette: >
- %\VignetteIndexEntry{Variation}
+ %\VignetteIndexEntry{Stochastic Variation}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
-```{r setup, include=FALSE}
+```{r setup}
+# Load the requisite packages:
library(malariasimulation)
-library(cowplot)
-library(ggplot2)
+# Set colour palette:
+cols <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
+set.seed(555)
+knitr::opts_chunk$set(
+ collapse = TRUE,
+ comment = "#>",
+ dpi=300,
+ fig.width=7
+)
+```
+
+`malariasimulation` is a stochastic, individual-based model and, as such, simulations run with identical parameterisations will generate non-identical, sometimes highly variable, outputs. To illustrate this, we will compare the prevalence and incidence of malaria over a year in simulations with a small and a larger population. Then we will demonstrate how this variation can be estimated by running multiple simulations using the `run_simulation_with_repetitions` function.
+
+First, we will create a few plotting functions to visualise outputs.
+```{r}
+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,
+ type = "l", col = cols[3], ylim = ylim,
+ xlab = "Time (days)", ylab = ylab, lwd = 1,
+ xaxs = "i", yaxs = "i")
+ grid(lty = 2, col = "grey80", lwd = 0.5)
+}
+
+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,
+ type = "l", col = cols[5], ylim = ylim,
+ xlab = "Time (days)", ylab = ylab, lwd = 1,
+ xaxs = "i", yaxs = "i")
+ grid(lty = 2, col = "grey80", lwd = 0.5)
+}
+
+aggregate_function <- function(df){
+ tmp <- aggregate(
+ df$n_detect_730_3650,
+ by=list(df$timestep),
+ FUN = function(x) {
+ c(median = median(x),
+ lowq = unname(quantile(x, probs = .25)),
+ highq = unname(quantile(x, probs = .75)),
+ mean = mean(x),
+ lowci = mean(x) - 1.96*sd(x),
+ highci = mean(x) + 1.96*sd(x)
+ )
+ }
+ )
+ data.frame(cbind(t = tmp$Group.1, tmp$x))
+}
+
+plot_variation_function <- function(df, title_str){
+ plot(type="n", xlim=c(0,max(df$t)),
+ c(1,1),
+ ylim = c(-4, 14),
+ xaxs = "i", yaxs = "i",
+ xlab = 'timestep', ylab ='Light miscroscopy detectable infections', main = title_str,
+ font.main = 1)
+ grid(lty = 2, col = "grey80", lwd = 0.5)
+ polygon(x = c(df$t,rev(df$t)), y = c(df$highci, rev(df$lowci)), col = cols[2], border = cols[2])
+ polygon(x = c(df$t,rev(df$t)), y = c(df$highq, rev(df$lowq)), col = cols[5], border = cols[5])
+ points(x = df$t, y = df$median, type = "l", ylim = c(25,40), lwd = 2, col = "black")
+}
```
-## Variation in outputs
+## Variation and population size
-Malariasimulation is a stochastic model, so there will be be variation in model outputs. For example, we could look at detected malaria cases over a year...
+### Parameterisation
+We will use the `get_parameters()` function to generate a list of parameters, accepting the default values, for two different population sizes and use the `set_equilibrium()` function to initialise the model at a given entomological inoculation rate (EIR). The only parameter which changes between the two parameter sets is the argument for `human_population`.
```{r}
-# A small population
-p <- get_parameters(list(
+# A small population
+simparams_small <- get_parameters(list(
human_population = 1000,
+ clinical_incidence_rendering_min_ages = 0,
+ clinical_incidence_rendering_max_ages = 5 * 365,
individual_mosquitoes = FALSE
))
-p <- set_equilibrium(p, 2)
-small_o <- run_simulation(365, p)
-p <- get_parameters(list(
+
+simparams_small <- set_equilibrium(parameters = simparams_small, init_EIR = 50)
+
+# A larger population
+simparams_big <- get_parameters(list(
human_population = 10000,
+ clinical_incidence_rendering_min_ages = 0,
+ clinical_incidence_rendering_max_ages = 5 * 365,
individual_mosquitoes = FALSE
))
-p <- set_equilibrium(p, 2)
-big_o <- run_simulation(365, p)
-
-plot_grid(
- ggplot(small_o) + geom_line(aes(timestep, n_detect_730_3650)) + ggtitle('n_detect at n = 1,000'),
- ggplot(small_o) + geom_line(aes(timestep, p_detect_730_3650)) + ggtitle('p_detect at n = 1,000'),
- ggplot(big_o) + geom_line(aes(timestep, n_detect_730_3650)) + ggtitle('n_detect at n = 10,000'),
- ggplot(big_o) + geom_line(aes(timestep, p_detect_730_3650)) + ggtitle('p_detect at n = 10,000')
-)
+
+simparams_big <- set_equilibrium(parameters = simparams_big, init_EIR = 50)
```
-The n_detect output shows the result of sampling individuals who would be detected by microscopy.
-While the p_detect output shows the sum of probabilities of detection in the population.
+### Simulations
-Notice that the p_detect output is slightly smoother. That's because it forgoes the sampling step. At low population sizes, p_detect will be smoother than the n_detect counterpart.
+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.
-## Estimating variation
+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.
-We can estimate the variation in the number of detectable cases by repeating the simulation several times...
+```{r, fig.align = 'center', out.width='100%', fig.asp=1.15}
+# A small population
+output_small_pop <- run_simulation(timesteps = 365, parameters = simparams_small)
+
+# A larger population
+output_big_pop <- run_simulation(timesteps = 365, parameters = simparams_big)
+# Plotting
+par(mfrow = c(2,2))
+plot_prev(output_small_pop, ylim = c(0.5, 0.8)); title(expression(paste(italic(Pf),"PR"[2-10], " at n = 1,000")))
+plot_inci(output_small_pop, ylim = c(0, 25)); title("Incidence per 1000 children at n = 1,000", cex.main = 1, font.main = 1)
+plot_prev(output_big_pop, ylim = c(0.5, 0.8)); title(expression(paste(italic(Pf),"PR"[2-10], " at n = 10,000")))
+plot_inci(output_big_pop, ylim = c(0, 25)); title("Incidence per 1000 children at n = 10,000", cex.main = 1, font.main = 1)
+```
+
+## Stochastic elimination
+With stochastic models, random elimination of malaria in a small population with low transmisison may happen. In the example below, we run two simulations: one with a very small population, and one with a larger population. There is stochastic fade out (elimination) in the smaller population, while the larger population has stable transmission over time. For this reason, it is important to run models with large-enough populations to avoid stochastic elimination.
```{r}
-outputs <- run_simulation_with_repetitions(
+# A small population
+simparams_small <- get_parameters(list(
+ human_population = 50,
+ clinical_incidence_rendering_min_ages = 0,
+ clinical_incidence_rendering_max_ages = 5 * 365,
+ individual_mosquitoes = FALSE
+))
+
+simparams_small <- set_equilibrium(parameters = simparams_small, init_EIR = 1)
+
+# A larger population
+simparams_big <- get_parameters(list(
+ human_population = 1000,
+ clinical_incidence_rendering_min_ages = 0,
+ clinical_incidence_rendering_max_ages = 5 * 365,
+ individual_mosquitoes = FALSE
+))
+
+simparams_big <- set_equilibrium(parameters = simparams_big, init_EIR = 1)
+```
+
+### Simulations
+
+```{r, fig.align = 'center', out.width='100%', fig.asp=0.6}
+set.seed(444)
+# A small population
+output_small_pop <- run_simulation(timesteps = 365 * 2, parameters = simparams_small)
+
+# A larger population
+output_big_pop <- run_simulation(timesteps = 365 * 2, parameters = simparams_big)
+
+# Plotting
+par(mfrow = c(1, 2))
+plot_prev(output_small_pop, ylim = c(0, 0.2)); title(expression(paste(italic(Pf),"PR"[2-10], " at n = 50")))
+plot_prev(output_big_pop, ylab = FALSE, ylim = c(0, 0.2)); title(expression(paste(italic(Pf),"PR"[2-10], " at n = 1,000")))
+```
+
+
+## Estimating variation
+
+We can estimate the variation in the number of detectable cases by repeating the simulation several times using the `run_simulation_with_repetitions()` function. The functions requires arguments for `repetitions` (the number of repeat simulations) and the option of whether to run simulations in parallel (where available: `parallel = T`), in addition to the standard timesteps and parameter list.
+
+```{r, fig.align = 'center', out.width='100%', fig.asp=0.55}
+simparams <- get_parameters() |> set_equilibrium(init_EIR = 1)
+
+output_few_reps <- run_simulation_with_repetitions(
timesteps = 365,
- repetitions = 10,
- overrides = p,
+ repetitions = 5,
+ overrides = simparams,
parallel=TRUE
)
-df <- aggregate(
- outputs$n_detect_730_3650,
- by=list(outputs$timestep),
- FUN = function(x) {
- c(
- median = median(x),
- lowq = unname(quantile(x, probs = .25)),
- highq = unname(quantile(x, probs = .75)),
- mean = mean(x),
- lowci = mean(x) + 1.96*sd(x),
- highci = mean(x) - 1.96*sd(x)
- )
- }
+output_many_reps <- run_simulation_with_repetitions(
+ timesteps = 365,
+ repetitions = 50,
+ overrides = simparams,
+ parallel=TRUE
)
-df <- data.frame(cbind(t = df$Group.1, df$x))
-
-plot_grid(
- ggplot(df)
- + geom_line(aes(x = t, y = median, group = 1))
- + geom_ribbon(aes(x = t, ymin = lowq, ymax = highq), alpha = .2)
- + xlab('timestep') + ylab('n_detect') + ggtitle('IQR spread'),
- ggplot(df)
- + geom_line(aes(x = t, y = mean, group = 1))
- + geom_ribbon(aes(x = t, ymin = lowci, ymax = highci), alpha = .2)
- + xlab('timestep') + ylab('n_detect') + ggtitle('95% confidence interval')
-)
+# Aggregate the data
+df_few <- aggregate_function(output_few_reps)
+df_many <- aggregate_function(output_many_reps)
+par(mfrow = c(1,2))
+plot_variation_function(df = df_few, title_str = "Repetitions = 5")
+legend("topleft", legend = c("Median", "IQR", "95% CI"), ncol = 1,
+ fill = c("black", cols[5], cols[2]), cex = 0.8, bty = "n")
+plot_variation_function(df = df_many, title_str = "Repetitions = 50")
```
-
-These are useful techniques for comparing the expected variance from model outputs to outcomes from trials with lower population sizes.
\ No newline at end of file
diff --git a/vignettes/VectorControl.Rmd b/vignettes/VectorControl.Rmd
deleted file mode 100644
index 67e07881..00000000
--- a/vignettes/VectorControl.Rmd
+++ /dev/null
@@ -1,131 +0,0 @@
----
-title: "Vector Control"
-output: rmarkdown::html_vignette
-vignette: >
- %\VignetteIndexEntry{Vector Control}
- %\VignetteEngine{knitr::rmarkdown}
- %\VignetteEncoding{UTF-8}
----
-
-```{r, include = FALSE}
-knitr::opts_chunk$set(
- collapse = TRUE,
- comment = "#>"
-)
-```
-
-```{r setup}
-suppressPackageStartupMessages(library(ggplot2))
-library(malariasimulation)
-library(malariaEquilibrium)
-library(reshape2)
-```
-
-# Parameterisation
-
-We are going to set the default parameters to run the simulation from an equilibrium.
-
-```{r}
-year <- 365
-month <- 30
-sim_length <- 3 * year
-human_population <- 1000
-starting_EIR <- 50
-
-simparams <- get_parameters(
- list(
- human_population = human_population,
- model_seasonality = TRUE, # Let's try a bi-modal model
- g0 = 0.28605,
- g = c(0.20636, -0.0740318, -0.0009293),
- h = c(0.173743, -0.0730962, -0.116019),
- severe_incidence_rendering_min_ages = 2*year,
- severe_incidence_rendering_max_ages = 10*year
- )
-)
-
-simparams <- set_equilibrium(simparams, starting_EIR)
-
-# Plotting functions
-plot_prevalence <- function(output) {
- ggplot(output) + geom_line(
- aes(x = timestep, y = (n_inc_severe_730_3650 / n_730_3650))) +
- labs(x = "timestep", y = "Severe incidence")
-}
-
-add_intervention_lines <- function(plot, events) {
- plot + geom_vline(
- data = events,
- mapping = aes(xintercept=timestep),
- color="blue"
- ) + geom_text(
- data = events,
- mapping = aes(x = timestep, y = 0, label = name),
- size = 4,
- angle = 90,
- vjust = -0.4,
- hjust = 0
- )
-}
-```
-
-Then we can run the simulation for a variety of vector control strategies:
-
-## Bed nets
-
-We can distribute bed nets once a year for two years, changing the
-characteristics of the bed nets on each distribution...
-
-```{r}
-bednetparams <- simparams
-
-bednet_events = data.frame(
- timestep = c(1, 2) * year,
- name=c("Bednets 1", "Bednets 2")
-)
-
-bednetparams <- set_bednets(
- bednetparams,
- timesteps = bednet_events$timestep,
- coverages = c(.8, .8),
- retention = 5 * year,
- dn0 = matrix(c(.533, .45), nrow=2, ncol=1),
- rn = matrix(c(.56, .5), nrow=2, ncol=1),
- rnm = matrix(c(.24, .24), nrow=2, ncol=1),
- gamman = rep(2.64 * 365, 2)
-)
-
-output <- run_simulation(sim_length, bednetparams)
-
-add_intervention_lines(plot_prevalence(output), bednet_events)
-```
-
-## Indoor spraying
-
-We can do the same for IRS...
-
-```{r}
-sprayingparams <- simparams
-
-peak <- peak_season_offset(sprayingparams)
-spraying_events = data.frame(
- timestep = c(1, 2) * year + peak - 3 * month,
- name=c("Spraying 1", "Spraying 2")
-)
-
-sprayingparams <- set_spraying(
- sprayingparams,
- timesteps = spraying_events$timestep,
- coverages = rep(.8, 2),
- ls_theta = matrix(c(2.025, 2.025), nrow=2, ncol=1),
- ls_gamma = matrix(c(-0.009, -0.009), nrow=2, ncol=1),
- ks_theta = matrix(c(-2.222, -2.222), nrow=2, ncol=1),
- ks_gamma = matrix(c(0.008, 0.008), nrow=2, ncol=1),
- ms_theta = matrix(c(-1.232, -1.232), nrow=2, ncol=1),
- ms_gamma = matrix(c(-0.009, -0.009), nrow=2, ncol=1)
-)
-
-output <- run_simulation(sim_length, sprayingparams)
-
-add_intervention_lines(plot_prevalence(output), spraying_events)
-```
diff --git a/vignettes/VectorControl_Bednets.Rmd b/vignettes/VectorControl_Bednets.Rmd
new file mode 100644
index 00000000..ae6a62c4
--- /dev/null
+++ b/vignettes/VectorControl_Bednets.Rmd
@@ -0,0 +1,137 @@
+---
+title: "Vector Control: Bed nets"
+output:
+ rmarkdown::html_vignette:
+vignette: >
+ %\VignetteIndexEntry{Vector Control: Bed nets}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+ collapse = TRUE,
+ comment = "#>",
+ dpi=300,
+ fig.width=7
+)
+```
+
+```{r setup}
+# Load the requisite packages:
+library(malariasimulation)
+# Set colour palette:
+cols <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
+```
+
+Long-lasting insecticide-treated bed nets are a highly effective intervention to prevent malaria. The effects of insecticide-treated bed net distribution campaigns can be simulated using `malariasimulation`. The model provides the user with the flexibility to specify parameters that describe the net distribution campaign (e.g. timing, coverage, and target population) and the bed nets distributed (e.g. efficacy, longevity). We will illustrate this through an example with two bed net distributions, once per year.
+
+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,
+ 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,
+ 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)
+ grid(lty = 2, col = "grey80", lwd = 0.5)
+ legend("bottomleft", box.lty = 0, bg = "white",
+ legend = c("Prevalence for bed net scenario","Prevalence for control scenario"),
+ col = c(cols[3], cols[5]), lty = c(1,1), lwd = 2, cex = 0.8, y.intersp = 1.3)
+}
+```
+
+## Setting bed net parameters
+
+### Parameterisation
+
+Use the `get_parameters()` function to generate the list of parameters for a perennial profile, accepting the default values to run the simulation from an equilibrium starting point.
+
+```{r}
+year <- 365
+sim_length <- 6 * year
+human_population <- 1000
+starting_EIR <- 50
+
+simparams <- get_parameters(
+ list(human_population = human_population)
+)
+
+simparams <- set_equilibrium(parameters = simparams, init_EIR = starting_EIR)
+
+output_control <- run_simulation(timesteps = sim_length, parameters = simparams)
+```
+
+#### A note on mosquito species
+It is also possible to use the `set_species()` function to account for 3 different mosquito species in the simulation. In this case, the matrices would need to have additional column corresponding to each mosquito species. For example, if we specified that there were 3 species of mosquitoes in the model and nets were distributed at two timesteps, then the matrices would have 2 rows and 3 columns. If you are not already familiar with the `set_species()` function, see the [Mosquito Species](https://mrc-ide.github.io/malariasimulation/articles/SetSpecies.html) vignette.
+
+The default parameters are set to model *Anopheles gambiae*.
+```{r}
+simparams$species
+simparams$species_proportions
+```
+
+### Simulation
+
+Having established a base set of parameters, we can now create a copy of this parameter list and update it to specify a net distribution campaign. In the example below, we distribute bed nets to a random 50% of the population every three years. It is possible to change the characteristics of the bed nets for each distribution timestep if different types of bed nets are distributed that have different insecticides, different levels of insecticide resistance, etc. This can be done by modifying the matrices for `dn0`, `rn`, `rnm`, and `gamman`. Because we are using the default proportions of mosquito species and there are two timesteps when nets are distributed, the matrices for `dn0`, `rn`, and `rnm` have 1 column and 2 rows.
+
+The parameter values for pyrethroid-only and pyrethroid-PBO nets at various resistance levels can be found in Table S1.3 in the Supplementary Appendix 2 of [Sherrard-Smith, et al., 2022](https://doi.org/10.1016/S2542-5196(21)00296-5).
+
+
+```{r, fig.align = 'center', out.width='100%'}
+bednetstimesteps <- c(1, 4) * year # The bed nets will be distributed at the end of the first and the 4th year.
+
+bednetparams <- set_bednets(
+ simparams,
+ timesteps = bednetstimesteps,
+ coverages = c(.5, .5), # Each round is distributed to 50% of the population.
+ retention = 5 * year, # Nets are kept on average 5 years
+ dn0 = matrix(c(.533, .533), nrow = 2, ncol = 1), # Matrix of death probabilities for each mosquito species over time
+ rn = matrix(c(.56, .56), nrow = 2, ncol = 1), # Matrix of repelling probabilities for each mosquito species over time
+ rnm = matrix(c(.24, .24), nrow = 2, ncol = 1), # Matrix of minimum repelling probabilities for each mosquito species over time
+ gamman = rep(2.64 * 365, 2) # Vector of bed net half-lives for each distribution timestep
+)
+
+output <- run_simulation(timesteps = sim_length, parameters = bednetparams)
+```
+
+### Visualisation
+
+```{r, fig.align = 'center', out.width='100%'}
+# Plot prevalence
+plot_prev()
+```
+
+### Comparing coverage and population bed net usage
+
+It is important to understand the difference between the input `coverages` argument of `set_bednets()` and the resulting population bed net usage over time in the model. When we set coverages in the above example to 0.5, we are telling the model to distribute bed nets to a random 50% of the population at year one and to a random 50% of the population at year 4. However, the level of average bed net usage is not necessarily equal to 50%. Between these time points, bed net use will slowly decline over time (in reality this decline stems from things like disuse, holes in nets, lost nets, etc.).
+
+The average population bed net usage will be influenced by:
+
+* The size and frequency of distributions specified in `set_bednets()`
+* The assumed net retention half life (`gamman`)
+* Correlations in the recipients of nets between rounds
+
+The output from `malariasimulation::run_simulation()` has a variable `n_use_net` that shows the number of people using bed nets at any given timestep. We can visualise the proportion of the population using bed nets over time to understand how bed net usage changes.
+
+```{r, fig.align = 'center', out.width='100%'}
+output$prop_use_net <- output$n_use_net / human_population
+
+plot(x = output$timestep, y = output$prop_use_net, type = "l",
+ col = cols[3], lwd = 2.5, ylim = c(0,1),
+ xlab = "Timestep (days)", ylab = "Proportion of population using bed nets",
+ xaxs = "i", yaxs = "i")
+grid(lty = 2, col = "grey80", lwd = 0.5)
+axis(side = 1, lty = 1, col = "black", pos = 0); axis(side = 2, lty = 1, col = "black")
+```
+
+## Using the `netz` package
+
+The [`netz` package](https://mrc-ide.github.io/netz/index.html) is a useful tool to help set up bed nets in `malariasimulation`. `malariasimulation` takes as an input the proportion of the population who were distributed a bed net at specific time points, but net distribution or use data are now always available for a specific region or country. `netz` has functionality to estimate modelled population usage over time in the simulation for a given set of input distributions. It can also help to fit the input coverages to usage data.
+
+See [this vignette](https://mrc-ide.github.io/netz/articles/population_usage.html) from the `netz` package that demonstrates how to estimate population bed net usage from an input distribution.
+
diff --git a/vignettes/VectorControl_IRS.Rmd b/vignettes/VectorControl_IRS.Rmd
new file mode 100644
index 00000000..3cf8ab7e
--- /dev/null
+++ b/vignettes/VectorControl_IRS.Rmd
@@ -0,0 +1,121 @@
+---
+title: "Vector Control: Indoor Residual Spraying"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Vector Control: Indoor Residual Spraying}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+ collapse = TRUE,
+ comment = "#>",
+ dpi=300,
+ fig.width=7
+)
+```
+
+```{r setup}
+# Load the requisite packages:
+library(malariasimulation)
+library(malariaEquilibrium)
+# Set colour palette:
+cols <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
+```
+
+Indoor Residual Spraying (IRS) involves periodically treating indoor walls with insecticides to eliminate adult female mosquitoes that rest indoors. `malariasimulation` can be used to investigate the effect of malaria control strategies that deploy IRS. Users can set IRS in the model using the `set_spraying()` function to parameterise the time and coverage of spraying campaigns.
+
+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,
+ 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,
+ 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)
+ grid(lty = 2, col = "grey80", lwd = 0.5)
+ legend("bottomleft", box.lty = 0,
+ legend = c("Prevalence for IRS scenario","Prevalence for control scenario"),
+ col = c(cols[3], cols[5]), lty = c(1,1), lwd = 2, cex = 0.8, y.intersp = 1.3)
+}
+```
+
+## Setting IRS parameters
+
+### Parameterisation
+
+Use the `get_parameters()` function to generate a list of parameters, accepting most of the default values, but modifying seasonality values to model a seasonal setting. Then, we use the `set_equilibrium()` function to to initialise the model at a given entomological innoculation rate (EIR).
+
+```{r}
+year <- 365
+month <- 30
+sim_length <- 3 * year
+human_population <- 1000
+starting_EIR <- 50
+
+simparams <- get_parameters(
+ list(
+ human_population = human_population,
+ # seasonality parameters
+ model_seasonality = TRUE,
+ g0 = 0.285277,
+ g = c(-0.0248801, -0.0529426, -0.0168910),
+ h = c(-0.0216681, -0.0242904, -0.0073646)
+ )
+)
+
+simparams <- set_equilibrium(parameters = simparams, init_EIR = starting_EIR)
+
+# Running simulation with no IRS
+output_control <- run_simulation(timesteps = sim_length, parameters = simparams)
+```
+
+#### A note on mosquito species
+It is also possible to use the `set_species()` function to account for 3 different mosquito species in the simulation. In this case, the matrices would need to have additional column corresponding to each mosquito species. For example, if we specified that there were 3 species of mosquitoes in the model and nets were distributed at two timesteps, then the matrices would have 2 rows and 3 columns. If you are not already familiar with the `set_species()` function, see the [Mosquito Species](https://mrc-ide.github.io/malariasimulation/articles/SetSpecies.html) vignette.
+
+The default parameters are set to model *Anopheles gambiae*.
+```{r}
+simparams$species
+simparams$species_proportions
+```
+
+
+### Simulation
+
+Then we can run the simulations for a variety of IRS strategies. In the example below, there are two rounds of IRS, the first at 30% coverage and the second at 80% coverage, each 3 months prior to peak rainfall for that year. The function `peak_season_offset()` outputs a timestep when peak rainfall will be observed based on the seasonality profile we set above. Notice that the matrices specified for the parameters for `ls_theta`, `ls_gamma`, `ks_theta`, `ks_gamma`, `ms_theta`, and `ms_gamma` have two rows, one for each timestep where IRS is implemented, and a number of columns corresponding to mosquito species. In this example, we only have 1 column because the species is set to "gamb" as we saw above.
+
+The structure for the IRS model is documented in the supplementary information from Table 3 in the Supplementary Information of [Sherrard-Smith et al., 2018](https://doi.org/10.1038/s41467-018-07357-w). Table S2.1 in the Supplementary Appendix of [Sherrard-Smith et al., 2022](https://doi.org/10.1016/S2542-5196(21)00296-5) has parameter estimates for insecticide resistance for IRS.
+
+```{r, fig.align = 'center', out.width='100%'}
+peak <- peak_season_offset(simparams)
+
+sprayingtimesteps <- c(1, 2) * year + peak - 3 * month # A round of IRS is implemented in the 1st and second year 3 months prior to peak transmission.
+
+sprayingparams <- set_spraying(
+ simparams,
+ timesteps = sprayingtimesteps,
+ coverages = c(0.3, 0.8), # # The first round covers 30% of the population and the second covers 80%.
+ ls_theta = matrix(2.025, nrow=length(sprayingtimesteps), ncol=1), # Matrix of mortality parameters; nrows=length(timesteps), ncols=length(species)
+ ls_gamma = matrix(-0.009, nrow=length(sprayingtimesteps), ncol=1), # Matrix of mortality parameters per round of IRS and per species
+ ks_theta = matrix(-2.222, nrow=length(sprayingtimesteps), ncol=1), # Matrix of feeding success parameters per round of IRS and per species
+ ks_gamma = matrix(0.008, nrow=length(sprayingtimesteps), ncol=1), # Matrix of feeding success parameters per round of IRS and per species
+ ms_theta = matrix(-1.232, nrow=length(sprayingtimesteps), ncol=1), # Matrix of deterrence parameters per round of IRS and per species
+ ms_gamma = matrix(-0.009, nrow=length(sprayingtimesteps), ncol=1) # Matrix of deterrence parameters per round of IRS and per species
+)
+
+output <- run_simulation(timesteps = sim_length, parameters = sprayingparams)
+```
+
+
+#### Visualisation
+
+```{r, fig.align = 'center', out.width='100%'}
+# Plot prevalence
+plot_prev()
+```
+
+
+We can see that the `malariaEquilibrium` provides a reasonable approximation when the target *Pf*PR~2-10~ is low, but recommends slightly different initial EIR values for intermediate *Pf*PR~2-10~ values. However, in our example we only simulated clinical treatment covering 45% of the population. If we needed to identify the EIR to yield a target *Pf*PR~2-10~ value in a scenario in which additional interventions, such as bed nets or vaccines, had been deployed, the difference between the EIR value recommended by these methods would be likely to increase significantly.
+
+## Matching EIR to *Pf*PR~2-10~ values
-```{r table, warning=F}
-# Pre-intervention baseline PfPR2-10 starting at values 10, 25, 35, 55
-PfPR <- c(.10, .25, .35, .45)
+Using the fitted relationship between initial EIR and *Pf*PR~2-10~, we can create a function that returns the EIR value(s) estimated to yield a target *Pf*PR~2-10~ given the model parameters. The function works by finding the closest *Pf*PR~2-10~ value from the values generated when we fit the model to a target value input by the user, and then using that index to return the corresponding initial EIR value.
-# match via stat_smooth predictions
-match <- function(x){
+```{r, eval = F}
+# Store some target PfPR2-10 values to match to:
+PfPRs_to_match <- c(0.10, 0.25, 0.35, 0.45)
+
+# Create a function to match these baseline PfPR2-10 values to EIR values
+# using the model fit:
+match_EIR_to_PfPR <- function(x){
- m <- which.min(abs(fit$fit-x)) # index of closest prev match
- fit[m,2] # print match
+ m <- which.min(abs(malSim_fit$malSim_fit-x))
+ malSim_fit[m,2]
}
-eir <- unlist(lapply(PfPR, match))
+# Use the function to extract the EIR values for the specified
+# PfPR2-10 values:
+matched_EIRs <- unlist(lapply(PfPRs_to_match, match_EIR_to_PfPR))
+
+# Create a dataframe of matched PfPR2-10 and EIR values:
+cbind.data.frame(PfPR = PfPRs_to_match, Matched_EIR = matched_EIRs)
+```
+
+## Calibrating *Pf*PR~2-10~ using the cali package
+
+The third option is to use the `calibrate()` function from the `cali` package (for details see: https://github.com/mrc-ide/cali) to return the EIR required to yield a target *Pf*PR~2-10~. Rather than manually running a series of simulations with varied, user-defined EIRs, this package contains the `calibrate()` function, which calibrates `malariasimulation` simulation outputs to a target *Pf*PR~2-10~ value within a user-specified tolerance by trying a series of EIR values within a defined range.
+
+The `calibrate()` function accepts as inputs a list of `malariasimulation` parameters, a summary function that takes the `malariasimulation` output and returns a vector of the target variable (e.g. a function that returns the *Pf*PR~2-10~), and a tolerance within which to accept the output target variable value and terminate the routine. To reduce the time taken by the `calibrate()` function, the user can also specify upper and lower bounds for the EIR space the function will search. The function runs through a series of `malariasimulation` simulations, trying different EIRs and honing in on the target value of the target variable, terminating when the target value output falls within the tolerance specified.
+
+```{r, eval = F}
+library(cali)
+
+# Prepare a summary function that returns the mean PfPR2-10 from each simulation output:
+summary_mean_pfpr_2_10 <- function (x) {
+
+ # Calculate the PfPR2-10:
+ prev_2_10 <- mean(x$n_detect_730_3650/x$n_730_3650)
+
+ # Return the calculated PfPR2-10:
+ return(prev_2_10)
+}
+
+# Establish a target PfPR2-10 value:
+target_pfpr <- 0.3
-cbind.data.frame(PfPR, eir)
+# Add a parameter to the parameter list specifying the number of timesteps to
+# simulate over. Note, increasing the number of steps gives the simulation longer
+# to stablise/equilibrate, but will increase the runtime for calibrate().
+simparams$timesteps <- 3 * 365
+# Establish a tolerance value:
+pfpr_tolerance <- 0.01
+
+# Set upper and lower EIR bounds for the calibrate function to check (remembering EIR is
+# the variable that is used to tune to the target PfPR):
+lower_EIR <- 5; upper_EIR <- 8
+
+# Run the calibrate() function:
+cali_EIR <- calibrate(target = target_pfpr,
+ summary_function = summary_mean_pfpr_2_10,
+ parameters = simparams,
+ tolerance = pfpr_tolerance,
+ low = lower_EIR, high = upper_EIR)
+
+# Use the match_EIR_to_PfPR() function to return the EIR predicted to be required under the
+# malariasimulation method:
+malsim_EIR <- match_EIR_to_PfPR(x = target_pfpr)
```
+
+The `calibrate()` function is a useful tool, but be aware that it relies on the user selecting and accurately coding an effective summary function, providing reasonable bounds on the EIR space to explore, and selecting a population size sufficiently large to limit the influence of stochasticity.
+
+As a final exercise, let's compare graphically the `calibrate()` approach with the `malariasimulation` method when the same parameter set is used. The plot below shows the change in *Pf*PR~2-10~ over the duration of the simulation under the initial EIR values recommended by the a) `cali` and b) `malariasimulation` methods to achieve the target *Pf*PR~2-10~ value of 0.3. The blue horizontal line represents the target *Pf*PR~2-10~ and the black lines either side are the upper and lower tolerance limits specified for the `cali` method.
+
+```{r, eval = F}
+# Use the set_equilibrium() function to calibrate the simulation parameters to the EIR:
+simparams_cali <- set_equilibrium(simparams, init_EIR = cali_EIR)
+simparams_malsim <- set_equilibrium(simparams, init_EIR = malsim_EIR)
+
+# Run the simulation:
+cali_sim <- run_simulation(timesteps = (simparams_cali$timesteps),
+ parameters = simparams_cali)
+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
+
+# Store the PfPR2-10 in each time step for the two methods:
+df <- data.frame(timestep = seq(1, length(cali_pfpr2_10)),
+ cali_pfpr = cali_pfpr2_10,
+ malsim_pfpr = malsim_pfpr2_10)
+
+# Set the plotting window:
+par(mfrow = c(1, 2), mar = c(4, 4, 1, 1))
+
+# Plot the PfPR2-10 under the EIR recommended by the cali method:
+plot(x = df$timestep,
+ y = df$malsim_pfpr,
+ type = "b",
+ ylab = expression(paste(italic(Pf),"PR"[2-10])),
+ xlab = "Time (days)",
+ ylim = c(target_pfpr - 0.2, target_pfpr + 0.2),
+ #ylim = c(0, 1),
+ col = cols[3])
+
+# Add grid lines
+grid(lty = 2, col = "grey80", lwd = 0.5)
+
+# Add a textual identifier and lines indicating target PfPR2-10 with
+# tolerance bounds:
+text(x = 10, y = 0.47, pos = 4, cex = 0.9,
+ paste0("a) cali \n init_EIR = ", round(cali_EIR, digits = 3)))
+abline(h = target_pfpr, col = "dodgerblue", lwd = 2)
+abline(h = target_pfpr - pfpr_tolerance, lwd = 2)
+abline(h = target_pfpr + pfpr_tolerance, lwd = 2)
+
+# Plot the PfPR2-10 under the EIR recommended by the malariasimulation method:
+plot(x = df$timestep,
+ y = df$cali_pfpr,
+ type = "b",
+ xlab = "Time (days)",
+ ylab = "",
+ ylim = c(target_pfpr - 0.2, target_pfpr + 0.2),
+ #ylim = c(0, 1),
+ col = cols[1])
+
+# Add grid lines
+grid(lty = 2, col = "grey80", lwd = 0.5)
+
+# Add a textual identifier and lines indicating target PfPR2-10 with
+# tolerance bounds
+text(x = 10, y = 0.47, pos = 4, cex = 0.9,
+ paste0("b) malariasimulation \n init_EIR = ", round(malsim_EIR, digits = 3)))
+abline(h = target_pfpr, col = "dodgerblue", lwd = 2)
+abline(h = target_pfpr - pfpr_tolerance, lwd = 2)
+abline(h = target_pfpr + pfpr_tolerance, lwd = 2)
+```
+
+
diff --git a/vignettes/EIRprevmatch_Fig_1.png b/vignettes/EIRprevmatch_Fig_1.png
new file mode 100644
index 00000000..c205e827
Binary files /dev/null and b/vignettes/EIRprevmatch_Fig_1.png differ
diff --git a/vignettes/EIRprevmatch_Fig_2.png b/vignettes/EIRprevmatch_Fig_2.png
new file mode 100644
index 00000000..3d1b6ca9
Binary files /dev/null and b/vignettes/EIRprevmatch_Fig_2.png differ
diff --git a/vignettes/MDA.Rmd b/vignettes/MDA.Rmd
index 7ac3f20c..d464c533 100644
--- a/vignettes/MDA.Rmd
+++ b/vignettes/MDA.Rmd
@@ -1,8 +1,8 @@
---
-title: "Mass Drug Administration"
+title: "Mass Drug Administriation and Chemoprevention"
output: rmarkdown::html_vignette
vignette: >
- %\VignetteIndexEntry{Mass Drug Administration}
+ %\VignetteIndexEntry{Mass Drug Administriation and Chemoprevention}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
@@ -10,149 +10,299 @@ vignette: >
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
- comment = "#>"
+ comment = "#>",
+ dpi=300,
+ fig.width=7
)
```
```{r setup}
-suppressPackageStartupMessages(library(ggplot2))
+# Load the requisite packages:
library(malariasimulation)
-library(malariaEquilibrium)
-library(reshape2)
+# Set colour palette:
+cols <- c("#E69F00", "#56B4E9", "#009E73", "#CC79A7","#F0E442", "#0072B2", "#D55E00")
```
-# Parameterisation
+Malaria chemoprevention encompasses a suite of strategies for reducing malaria morbidity, mortality, and transmission through the treatment of at-risk populations with antimalarial drugs. Three such strategies are mass drug administration (MDA), seasonal malaria chemoprevention (SMC), and perennial malaria chemoprevention (PMC). MDA attempts to simultaneously treat an entire population, irrespective of their infection risk or status. SMC targets children aged 3-59 months with a course of an antimalarial through the peak malaria transmission season. PMC is designed for settings with perennially high transmission and seeks to administer a full antimalarial course at defined intervals irrespective of age or disease status.
-We are going to set the default parameters to run the simulation from an equilibrium.
+`malariasimulation` enables users to simulate the effects of chemoprevention strategies on malaria transmission, and provides the flexibility to design and simulate a range of MDA/SMC/PMC campaigns for a suite of antimalarial drugs. Specifically, users are able to load or specify parameters describing both the characteristics of the antimalarial(s) (e.g. drug efficacy, prophylactic profile) and their distribution (e.g. coverage, distribution timing, and the section of the population to treat). This vignette provides simple, illustrative demonstrations of how MDA and SMC campaigns can be set-up and simulated using `malariasimulation`. The functionality to simulate PMC campaigns is also built into `malariasimulation` via the `set_pmc()` function, but we do not demonstrate the use of PMC in this vignette (for further information on their use, see [set_pmc](https://mrc-ide.github.io/malariasimulation/reference/set_pmc.html)).
+
+## Mass Drug Administration
+
+To illustrate how MDA can be simulated using `malariasimulation`, we will implement a campaign that distributes a single dose of sulphadoxine-pyrimethamine amodiaquine (SP-AQ) to 80% of the entire population once a year over a two year period, initiated at the end of the first year.
+
+### Parameterisation
+
+The first step is to generate the list of `malariasimulation` parameters using the `get_parameters()` function. Here, we'll use the default `malariasimulation` parameter set (run `?get_parameters()` to view), but specify the seasonality parameters to simulate a highly seasonal, unimodal rainfall pattern (illustrated in the plot of total adult female mosquito population dynamics below). To do this, we set `model_seasonality` to `TRUE` within `get_parameters()`, and then tune the rainfall pattern using the `g0`, `g`, and `h` parameters (which represent fourier coefficients). In the `malariasimulation` model, rainfall governs the time-varying mosquito population carrying capacity through density-dependent regulation of the larval population and, therefore, annual patterns of malaria transmission. Next, we use the `set_equilibrium()` function to tune the initial human and mosquito populations to those required to observe the specified initial EIR.
```{r}
-year <- 365
-sim_length <- 3 * year
+# Establish the length of time, in daily time steps, over which to simulate:
+year <- 365; years <- 3
+sim_length <- years * year
+
+# Set the size of the human population and an initial entomological inoculation rate (EIR)
human_population <- 1000
starting_EIR <- 50
+# Use the simparams() function to build the list of simulation parameters and then specify
+# a seasonal profile with a single peak using the g0, g, and h parameters.
simparams <- get_parameters(
list(
human_population = human_population,
- model_seasonality = TRUE, # Let's try a bi-modal model
- g0 = 0.28605,
- g = c(0.20636, -0.0740318, -0.0009293),
- h = c(0.173743, -0.0730962, -0.116019)
+ model_seasonality = TRUE,
+ g0 = 0.284596,
+ g = c(-0.317878,-0.0017527,0.116455),
+ h = c(-0.331361,0.293128,-0.0617547)
)
)
-simparams <- set_equilibrium(simparams, starting_EIR)
-simparams <- set_drugs(simparams, list(SP_AQ_params))
-
-# Plotting functions
-plot_prevalence <- function(output) {
- ggplot(output) + geom_line(
- aes(x = timestep, y = (n_detect_730_3650/n_730_3650))) +
- labs(x = "timestep", y = "PfPR2-10")
-}
-
-plot_state_counts <- function(output) {
- ggplot(
- melt(
- output[c(
- 'timestep',
- 'S_count',
- 'D_count',
- 'A_count',
- 'U_count',
- 'Tr_count'
- )],
- id.vars='timestep'
- )
- ) + geom_line(
- aes(
- x = timestep,
- y = value,
- group = variable,
- color = variable
- )
- )
-}
-add_mda_lines <- function(plot, events) {
- plot + geom_vline(
- data = events,
- mapping = aes(xintercept=timestep),
- color="blue"
- ) + geom_text(
- data = events,
- mapping = aes(x = timestep, y = 0, label = name),
- size = 4,
- angle = 90,
- vjust = -0.4,
- hjust = 0
- )
-}
+# Use the set_equilibrium() function to update the individual-based model parameters to those
+# required to match the specified initial EIR (starting_EIR) at equilibrium:
+simparams <- set_equilibrium(simparams, starting_EIR)
```
-Then we can run the simulation for a variety of MDA strategies:
+### Interventions
-## MDA
+Having established a base set of parameters (`simparams`), the next step is to add the parameters specifying the MDA campaign. We first use the `set_drugs()` function to update the parameter list (`simparams`) with the parameter values for the drug(s) we wish to simulate, in this case using the in-built parameter set for SP-AQ (`SP_AQ_params`). Note that the `malariasimulation` package also contains in-built parameter sets for dihydroartemisinin-piperaquine (`DHA_PQP_params`) and artemether lumefantrine (`AL_params`), and users can also define their own drug parameters.
-This is a dose of SP-AQ to 80% of the population once a year.
+We then define the time steps on which we want the MDA to occur (stored here in the vector `mda_events` for legibility), and use the `set_mda()` function to update the parameter list with our MDA campaign parameters. `set_mda()` takes as its first two arguments the base parameter list and the time steps on which to schedule MDA events. This function also requires the user to specify the proportion of the population they want to treat using `coverages`, as well as the age-range of the population we want to treat using `min_ages` and `max_ages`, *for each timestep on which MDA is scheduled*. Note that this enables users to specify individual events to have different drug, coverage, and human-target properties. The `drug` argument refers to the index of the drug we want to distribute in the MDA in the list of parameters (in this demonstration we have only added a single drug, SP-AQ, using `set_drugs()`, but we could have specified additional drugs).
```{r}
+# Make a copy of the base simulation parameters to which we can add the MDA campaign parameters:
mdaparams <- simparams
-# Add MDA strategy
-mda_events = data.frame(
- timestep = c(1, 2) * 365,
- name=c("MDA 1", "MDA 2")
-)
+# Update the parameter list with the default parameters for sulphadoxine-pyrimethamine
+# amodiaquine (SP-AQ)
+mdaparams <- set_drugs(mdaparams, list(SP_AQ_params))
-mdaparams <- set_mda(
- mdaparams,
- drug = 1,
- timesteps = mda_events$timestep,
- coverages = rep(.8, 2),
- min_ages = rep(0, length(mda_events$timestep)),
- max_ages = rep(200 * 365, length(mda_events$timestep))
-)
+# Specify the days on which to administer the SP-AQ
+mda_events <- (c(1, 2) * 365)
-output <- run_simulation(sim_length, mdaparams)
+# Use set_mda() function to set the proportion of the population that the MDA reaches and the age
+# ranges which can receive treatment.
+mdaparams <- set_mda(mdaparams,
+ drug = 1,
+ timesteps = mda_events,
+ coverages = rep(.8, 2),
+ min_ages = rep(0, length(mda_events)),
+ max_ages = rep(200 * 365, length(mda_events)))
```
+Having generated a base, no-intervention parameter set (`simparams`) and a version updated to define an MDA campaign (`mdaparams`), we can now use the `run_simulation()` function to run simulations for scenarios without interventions and with our MDA campaign.
+
+### Simulation
+
```{r}
-add_mda_lines(plot_state_counts(output), mda_events)
+# Run the simulation in the absence of any interventions:
+noint_output <- run_simulation(sim_length, simparams)
+
+# Run the simulation with the prescribed MDA campaign
+mda_output <- run_simulation(sim_length, mdaparams)
```
-```{r}
-add_mda_lines(plot_prevalence(output), mda_events)
+### Visualisation
+
+The `run_simulation()` function returns a dataframe containing time series for a range of variables, including the number of human individuals in each infectious state, and the number of people and detected cases in children aged 2-10. The plots below illustrate how the effect of an MDA campaign on the malaria transmission dynamics can be visualised. The first presents the distribution of people among the infectious states in the MDA simulation. The second compares the prevalence of malaria in children aged 2-10 years old (*Pf*PR~2-10~) between the no-intervention and MDA scenarios simulated.
+
+```{r, fig.align = 'center', out.width='100%'}
+# Store the state names, and labels and colours with which to plot them:
+states <- c("S_Count", "D_count", "Tr_count", "A_count", "U_count")
+state_labels <- c("S", "D", "Tr", "A", "U")
+
+# Open a new plotting window:
+plot.new(); par(mar = c(4, 4, 1, 1), new = TRUE)
+
+# Plot the time series
+plot(x = mda_output$timestep, y = mda_output$S_count,
+ type = "l", col = cols[1], lwd = 2,
+ ylim = c(0, 950), ylab = "Individuals", xlab = "Time (days)",
+ xaxs = "i", yaxs = "i", cex = 0.8)
+
+# Overlay the time-series for other states
+for(i in 1:(length(states)-1)) {
+ lines(mda_output[,states[i+1]], col = cols[i+1], lwd = 2)
+}
+
+# Add vlines to show when SP-AQ was administered:
+abline(v = mda_events, lty = "dashed", lwd = 1.5)
+text(x = mda_events+10, y = 900, labels = "MDA int.", adj = 0, cex = 0.8)
+
+# Add gridlines:
+grid(lty = 2, col = "grey80", nx = NULL, ny = NULL, lwd = 0.5); box()
+
+# Add a legend:
+legend("topleft",
+ legend = c(state_labels),
+ col = c(cols[1:5]), lty = c(rep(1, 5)),
+ lwd = 1, cex = 0.8, box.col = "white", ncol = 2, x.intersp = 0.5)
```
-## SMC
+```{r, fig.align = 'center', out.width='100%'}
+# Open a new plotting window and add a grid:
+plot.new(); par(mar = c(4, 4, 1, 1), new = TRUE)
-This is a dose of SP-AQ to 90% of 2 - 11 year olds once a year a month before the peak season for mosquitoes.
+# 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,
+ 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])
-```{r}
+# Add the dynamics for no-intervention simulation
+lines(x = noint_output$timestep,
+ y = noint_output$n_detect_730_3650/noint_output$n_730_3650,
+ col = cols[4])
+
+# Add vlines to indicate when SP-AQ were administered:
+abline(v = mda_events, lty = "dashed", lwd = 1)
+text(x = mda_events+10, y = 0.95, labels = "MDA int.", adj = 0, cex = 0.8)
+
+# 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("MDA", "No-Int"),
+ col= c(cols[3:4]), box.col = "white",
+ lwd = 1, lty = c(1, 1), cex = 0.8)
+```
+
+## Seasonal Malaria Chemoprevention
+
+To demonstrate how to simulate SMC in `malariasimulation` , in the following section we'll set-up and simulate a campaign that treats 90% of children aged 3-59 months old with four doses of SP-AQ per year. We will set the SMC campaign to begin in the second year, run for two years, and specify the four SMC events to occur at monthly intervals, starting two months prior to the peak malaria season.
+
+### Interventions
+
+While the first step would typically be to establish the base set of parameters, we can use those stored earlier in `simparams`. We first store a copy of these base parameters and then use `set_drugs()` to store the preset parameters for SP-AQ in the parameter list. As SMC is conducted during the peak malaria season, we need to use the `peak_season_offset()` function to determine when the peak malaria season occurs given our specified seasonal profile. This function reads in the parameter list, uses `g0`, `g`, `h`, and `rainfall_floor` to generate the rainfall profile for a single year, and returns the day on which the maximum rainfall value occurs. We can then take this calculated seasonal peak and time SMC events around it. Here, we've specified four monthly drug administration days per year starting two months before the seasonal peak. To illustrate this, we can plot the total adult mosquito population size through time which, in the absence of interventions targeting mosquitoes, will closely match the rainfall pattern, and overlay both the annual seasonal peak and planned SMC events. Once we're happy with our SMC campaign, we use the `set_smc()` function to update the parameter list with our `drug`, `timesteps`, `coverages` and target age group (`min_ages` and `max_ages`).
+
+```{r, fig.align = 'center', out.width='100%'}
+# Copy the original simulation parameters
smcparams <- simparams
-# Add SMC strategy
+# Append the parameters for SP-AQ using set_drugs
+smcparams <- set_drugs(smcparams, list(SP_AQ_params))
+
+# Use the peak_season_offset() to calculate the yearly offset (in daily timesteps) for the peak mosq.
+# season
peak <- peak_season_offset(smcparams)
-smc_events = data.frame(
- timestep = c(1, 2) * 365 + peak - 30,
- name=c("SMC 1", "SMC 2")
-)
+
+# Create a variable for total mosquito population through time:
+noint_output$mosq_total = noint_output$Sm_gamb_count +
+ noint_output$Im_gamb_count +
+ noint_output$Pm_gamb_count
+
+# Schedule drug administration times (in daily time steps) before, during and after the seasonal peak:
+admin_days <- c(-60, -30, 0, 30)
+
+# Use the peak-offset, number of simulation years and number of drug admin. days to calculate the days
+# on which to administer drugs in each year
+smc_days <- rep((365 * seq(1, years-1, by = 1)), each = length(admin_days)) + peak + rep(admin_days, 2)
+
+# Turn off scientific notation for the plot:
+options(scipen = 666)
+
+# Open a new plotting window,set the margins and plot the total adult female mosquito population
+# through time:
+plot.new(); par(new = TRUE, mar = c(4, 4, 1, 1))
+plot(x = noint_output$timestep, noint_output$mosq_total,
+ xlab = "Time (days)", ylab = "Adult Female Mosquitos",
+ ylim = c(0, max(noint_output$mosq_total)*1.1),
+ type = "l", lwd = 2, cex = 0.8,
+ xaxs = "i", yaxs = "i",
+ col = cols[3])
+
+# Add gridlines
+grid(lty = 2, col = "grey80", nx = 11, ny = NULL, lwd = 0.5); box()
+
+# Overlay the SMC days and the calculated seasonal peak
+abline(v = smc_days, lty = "dashed", lwd = 2)
+abline(v = c(0, 1, 2) * 365 + peak, lty = 2, lwd = 2, col = cols[4])
+
+# Add a legend:
+legend("topleft",
+ legend = c(expression("M"["Tot"]), "SMC", "Peak"),
+ col= c(cols[3], "black", cols[4]), box.col = "white",
+ lty = c(1, 2, 2), lwd = 2, cex = 0.9)
+
+# Update the SMC parameters list:
smcparams <- set_smc(
smcparams,
drug = 1,
- timesteps = smc_events$timestep,
- coverages = rep(.9, 2),
- min_ages = rep(2 * 365 - 1, length(smc_events$timestep)),
- max_ages = rep(11 * 365, length(smc_events$timestep))
+ timesteps = smc_days,
+ coverages = rep(0.9, length(smc_days)),
+ min_ages = rep(3 * 30, length(smc_days)),
+ max_ages = rep(59 * 30, length(smc_days))
)
-
-output <- run_simulation(sim_length, smcparams)
```
+### Simulations
+
+Having generated our SMC parameter list, we can run the simulation using the `run_simulation()` function.
+
```{r}
-add_mda_lines(plot_state_counts(output), smc_events)
+# Run the SMC simulation
+smc_output <- run_simulation(sim_length, smcparams)
```
-```{r}
-add_mda_lines(plot_prevalence(output), smc_events)
+### Visualisation
+
+We can now plot the simulation output to visualise the effect of our SMC campaign on malaria transmission dynamics, again focusing on the distribution of people in each of the infectious states and on malaria prevalence in children aged 2-10 (*Pf*PR~2-10~).
+
+```{r, fig.align = 'center', out.width='100%'}
+# Open a new plotting window and add a grid:
+plot.new(); par(new = TRUE, mar = c(4, 4, 1, 1))
+
+# Plot the time series of human infectious states through time under the SMC campaign
+plot(x = smc_output$timestep, y = smc_output$S_count,
+ type = "l", col = cols[1], lwd = 2,
+ ylim = c(0, 950), ylab = "Individuals", xlab = "Time (days)",
+ xaxs = "i", yaxs = "i", cex = 0.8)
+
+# Overlay the time-series for other human infection states
+for(i in 1:(length(states)-1)) {
+ lines(smc_output[,states[i+1]], col = cols[i+1], lwd = 2)
+}
+
+# Add vlines to indicate when SMC drugs were administered:
+abline(v = smc_days, lty = "dashed", lwd = 1)
+text(x = smc_days[c(4,8)]+10, y = 900, labels = "SMC\nint.", adj = 0, cex = 0.8)
+
+# Add gridlines:
+grid(lty = 2, col = "grey80", nx = NULL, ny = NULL, lwd = 0.5)
+
+# Add a legend:
+legend("topleft",
+ legend = c(state_labels),
+ col = c(cols[1:5]), lty = c(rep(1, 5)),
+ box.col = "white", lwd = 2, cex = 0.8, ncol = 2, x.intersp = 0.5)
```
+
+```{r, fig.align = 'center', out.width='100%'}
+# Open a new plotting window and add a grid:
+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,
+ 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 = noint_output$timestep,
+ y = noint_output$n_detect_730_3650/noint_output$n_730_3650,
+ col = cols[4])
+
+# Add lines to indicate SMC events:
+abline(v = smc_days, lty = "dashed", lwd = 1)
+text(x = smc_days[c(4,8)]+10, y = 0.95, labels = "SMC\nint.", adj = 0, cex = 0.8)
+
+# Add gridlines:
+grid(lty = 2, col = "grey80", nx = 11, ny = 10, lwd = 0.5)
+
+# Add a legend:
+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 1cbb433d..bece7840 100644
--- a/vignettes/Metapopulation.Rmd
+++ b/vignettes/Metapopulation.Rmd
@@ -10,22 +10,28 @@ vignette: >
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
- comment = "#>"
+ comment = "#>",
+ dpi=300,
+ fig.width=7
)
```
```{r setup}
-suppressPackageStartupMessages(library(ggplot2))
+# Load the requisite packages:
library(malariasimulation)
library(malariaEquilibrium)
+# Set colour palette:
+cols <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
```
-# Parameterisation
-
The metapopulation model runs the individual-based model for multiple parameterized units (countries, regions, admins, etc.) simultaneously. The inputted mixing matrix allows for the transmission of one unit to affect the transmission of another unit. 'Mixing' in the model occurs through the variables `foim_m` and `EIR`.
Here we will set up a case study of three distinct units and compare output with various transmission mixing patterns.
+## Run metapopulation simulation
+
+### Parameterisation
+
```{r}
# set variables
year <- 365
@@ -52,10 +58,9 @@ ms_parameterize <- function(x){ # index of EIR
# creating a list of three parameter lists
paramslist <- lapply(seq(1, length(EIR_vector), 1), ms_parameterize)
-
```
-# Modelling
+### Simulation
Our parameters for the three distinct units are stored in the object `paramslist`. Next we will run the metapopulation model with these parameters. We will plug in three mixing matrices - A) isolated, B) semi-mixed, C) perfectly mixed.
@@ -106,19 +111,56 @@ output$prev2to10 = output$p_detect_730_3650 / output$n_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)
-
```
+### Visualisation
+
Now let's visualize the results of mixing on PfPR2-10:
-```{r}
-# plot
-ggplot(data = output) +
- geom_line(aes(x = year, y = prev2to10, color = factor(EIR))) +
- facet_wrap(~ mix) +
- scale_y_continuous(limits = c(0, 0.35)) +
- labs(x = 'time (years)',
- y = 'PfPR 2-10 (month)',
- color = 'EIR') +
- theme_classic()
+```{r, fig.align = 'center', out.width='100%', fig.asp = 0.4}
+Panel_spec <- rbind(c(0,0.37,0,1),
+ c(0.37,0.635,0,1),
+ c(0.635,0.9,0,1),
+ c(0.9,1,0,1))
+
+Margin_spec <- rbind(c(0.8,0.8,0.3,0.1),
+ c(0.8,0.1,0.3,0.1),
+ c(0.8,0.1,0.3,0.1))
+
+
+Mix_vec <- unique(output$mix)
+EIR_vec <- unique(output$EIR)
+
+Xlab_vec <- c("","Time (years)","")
+Ylab_vec <- c(expression(paste(italic(Pf),"PR"[2-10])),"","")
+New_vec <- c(F,T,T)
+
+Plot_Mixing <- function(output){
+ for(i in 1:3){
+ par(fig=Panel_spec[i,], cex = 0.8, mai = Margin_spec[i,], new = New_vec[i])
+ with(subset(output,output$mix == Mix_vec[i] & output$EIR == EIR_vec[1]),{
+ plot(x = year, y = prev2to10, type = "l", col = cols[1], lwd = 2,
+ ylim = c(0,0.36), yaxt = "n",
+ xaxs = "i", yaxs = "i",
+ ylab = Ylab_vec[i], xlab = Xlab_vec[i])
+ abline(h = seq(0.05,0.25, by = 0.05), lty = 2, col = "grey80", lwd = 0.5)
+ sapply(2:4, function(x){segments(x0 = x, x1 = x, y0 = 0, y1 = 0.3,
+ lty = 2, col = "grey80",lwd = 0.5)})
+ # grid(lty = 2, col = "grey80", lwd = 0.5)
+ if(i ==1){axis(side = 2, at = seq(0,0.4,by=0.1))}
+ title(gsub("(^[[:alpha:]])", "\\U\\1", Mix_vec[i], perl=TRUE), line = -1.4, cex.main = 0.9)
+ abline(h = 0.3)
+
+ })
+ for(j in 2:3){
+ with(subset(output,output$mix == Mix_vec[i] & output$EIR == EIR_vec[j]),
+ points(x = year, y = prev2to10, type = "l", col = cols[j], lwd = 2))
+ }
+ }
+ par(fig=c(0.9,1,0,1), cex = 0.8, new = T, xpd = T, mai = c(0,0,0,0))
+ legend("left", legend = EIR_vec, col = cols[1:3], lwd = 2,
+ bty = "n", lty = 1, title = "EIR", y.intersp = 2)
+}
+
+Plot_Mixing(output)
```
diff --git a/vignettes/Model.Rmd b/vignettes/Model.Rmd
index f83e48ac..c09932c2 100644
--- a/vignettes/Model.Rmd
+++ b/vignettes/Model.Rmd
@@ -1,8 +1,8 @@
---
-title: "Model Structure"
+title: "Model Introduction"
output: rmarkdown::html_vignette
vignette: >
- %\VignetteIndexEntry{Model Structure}
+ %\VignetteIndexEntry{Model Introduction}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
@@ -10,90 +10,346 @@ vignette: >
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
- comment = "#>"
+ comment = "#>",
+ dpi=300,
+ fig.width=7
)
```
-```{r setup}
-library(DiagrammeR)
+```{r, output.lines=6}
+# Load the requisite packages:
+library(malariasimulation)
+# Set colour palette:
+cols <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
```
-This is an individual based model for P. Falciparum and malaria interventions.
+This vignette gives a high-level overview of the individual-based malariasimulation model. It then gives a basic example of how the model can be used, how to initiate the model with equilibrium conditions, and demonstrates how to change named parameter inputs, including setting seasonality parameters. Finally, it lists and broadly describes the content of the remaining vignettes, summarising parameter and intervention setting functions.
-# Human Biology
+## Model structure
-The human variables are documented in "R/variables.R".
+### Human Biology
-The human biological processes are spread out between the following files:
+The human variables are documented in [R/variables.R](https://github.com/mrc-ide/malariasimulation/blob/master/R/variables.R).
- 1. 'human_infection.R' (orange)
- 2. 'disease_progression.R' (green)
- 3. 'mortality_processes.R'(red)
+The functions governing the human flow of infection and immunity processes are described in the following files:
-```{r echo=FALSE}
-DiagrammeR::grViz("digraph {
- graph [layout = dot, rankdir = LR]
-
- node [shape = rectangle]
- S
- D
- A
- U
- Tr
-
- node [shape = circle]
- i [label = '']
-
- # edge definitions with the node IDs
- S -> i [color='orange']
- i -> D [color='orange']
- i -> A [color='orange']
- i -> Tr [color='orange']
- D -> A -> U -> S [color='green']
- Tr -> s [color='green']
- A -> i [color='orange']
- U -> i [color='orange']
- U -> S [color='red']
- A -> S [color='red']
- D -> S [color='red']
- }")
+1. [R/human_infection.R](https://github.com/mrc-ide/malariasimulation/blob/master/R/human_infection.R)
+2. [R/disease_progression.R](https://github.com/mrc-ide/malariasimulation/blob/master/R/disease_progression.R)
+3. [R/mortality_processes.R](https://github.com/mrc-ide/malariasimulation/blob/master/R/mortality_processes.R)
+
+
+
+#### States
+
+Modelled human states are Susceptible (*S*), Treated (*Tr*), Clinical disease (*D*), Asymptomatic infection (*A*) and Sub-patent infection (*U*).
+
+#### Parameters
+
+Parameters shown on the infographic include:
+
+- $\Lambda_i$: the age-specific (*i*) force of infection
+- $\phi_i$: the age-specific (*i*) probability of clinical disease
+- $f_T$: the probability of receiving treatment (or force of treatment)
+
+with the rates of recovery:
+
+- $r_D$: from clinical disease to asymptomatic infection
+- $r_A$: from asymptomatic infection to sub-patent infection
+- $r_U$: from sub-patent infection to complete recovery
+- $r_T$: from treated clinical disease to complete recovery
+
+Superinfection may occur in individuals with asymptomatic or sub-patent infections at the same rates as standard infection (dashed arrows).
+
+The force of infection ($\Lambda_i$) is impacted by pre-erythrocytic immunity, mosquito biting rate and population size and level of infectivity (specific details can be found in the references below). All default parameters can be found in the documentation for the function `get_parameters()`. Please also note that while the infographic above displays rate parameters, the parameter list uses delay durations, e.g. the rate $r_D$ is the inverse of the delay from state *D* to *A* (`dr` in the model):
+
+$$r_D=dr^{-1}$$
+
+To maintain a constant population size during simulations, the birth rate of new susceptible individuals is set to be equal to the overall death rate.
+
+### Mosquito Biology
+
+The functions governing mosquito biological processes and dynamics are spread out between the following files:
+
+1. [R/mosquito_biology.R](https://github.com/mrc-ide/malariasimulation/blob/master/R/mosquito_biology.R)
+2. [R/biting_process.R](https://github.com/mrc-ide/malariasimulation/blob/master/R/biting_process.R)
+3. [R/compartmental.R](https://github.com/mrc-ide/malariasimulation/blob/master/R/compartmental.R)
+
+
+
+#### States
+
+Modelled mosquito states are separated into three juvenile stages: early (*E*) and late (*L*) larval stages, the pupal stage (*P*), and three adult states: susceptible (*S*M), incubating (*P*M) and infectious individuals (*I*M). Mosquitoes in any state may die, where they enter the NonExistent state. The model tracks both male and female juvenile mosquitoes, but only female adult mosquitoes.
+
+#### Parameters
+
+Parameters shown on the infographic include mosquito developmental rates:
+
+- $r_{EL}$: from early to late larval stage
+
+- $r_{L}$: from late larval stage to pupal stage
+
+- $r_P$: from pupal stage to adult stage
+
+Mosquito infection and incubation rates:
+
+- $\Lambda_M$: the force of infection on mosquitos (FOIM, i.e. from human to mosquito)
+
+- $r_{EM}$: extrinsic incubation period
+
+And mortality rates:
+
+- $\mu_E(t)$: the early larval stage death rate
+
+- $\mu_L(t)$: the late larval stage death rate
+
+- $\mu_P$: the pupal death rate
+
+- $\mu_M$: the adult mosquito death rate
+
+Larval mosquitoes experience density dependent mortality due to a carrying capacity, $K(t)$, which may change seasonally with rainfall and where $\gamma$ is the effect of density-dependence on late stage larvae compared with early stage larvae as follows:
+
+$$
+\mu_E = \mu_E^0(1+\frac{E(t)+L(t)}{K(t)}) \\
+\mu_L = \mu_L^0(1+\gamma\frac{E(t)+L(t)}{K(t)})
+$$
+
+### Key Model References (structure and dynamics)
+
+Griffin JT, Hollingsworth TD, Okell LC, Churcher TS, White M, et al. (2010) Reducing *Plasmodium falciparum* Malaria Transmission in Africa: A Model-Based Evaluation of Intervention Strategies. PLOS Medicine 7(8): e1000324.