diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 4b6a405e..b0d19a8d 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -35,7 +35,7 @@ jobs: with: r-version: ${{ matrix.config.r }} - - uses: r-lib/actions/setup-pandoc@v1 + - uses: r-lib/actions/setup-pandoc@v2 - name: Query dependencies run: | diff --git a/DESCRIPTION b/DESCRIPTION index 49cc359f..e60e26c9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: malariasimulation Title: An individual based model for malaria -Version: 1.3.0 +Version: 1.4.0 Authors@R: c( person( given = "Giovanni", @@ -10,27 +10,27 @@ Authors@R: c( ), person( given = "Peter", - family = "Windskill", + family = "Winskill", role = c('aut'), - email = 'p.windskill@ic.ac.uk' + email = 'p.winskill@ic.ac.uk' ), person( given = "Hillary", family = "Topazian", role = c('aut'), - email = 'h.topazian@ic.ac.uk' + email = 'h.topazian@imperial.ac.uk' ), person( given = "Joseph", family = "Challenger", role = c('aut'), - email = 'j.challenger@ic.ac.uk' + email = 'j.challenger@imperial.ac.uk' ), person( given = "Richard", family = "Fitzjohn", role = c('aut'), - email = 'r.fitzjohn@ic.ac.uk' + email = 'r.fitzjohn@imperial.ac.uk' ), person( given = "Imperial College of Science, Technology and Medicine", @@ -66,7 +66,7 @@ Suggests: ggplot2, covr, mgcv -RoxygenNote: 7.1.2 +RoxygenNote: 7.2.1 Roxygen: list(markdown = TRUE) LinkingTo: Rcpp, diff --git a/NAMESPACE b/NAMESPACE index e8f26fc0..c0d7331a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,6 +12,7 @@ export(get_parameters) export(parameterise_mosquito_equilibrium) export(parameterise_total_M) export(peak_season_offset) +export(run_metapop_simulation) export(run_simulation) export(run_simulation_with_repetitions) export(set_bednets) diff --git a/R/biting_process.R b/R/biting_process.R index 97d801f0..9dbb2d41 100644 --- a/R/biting_process.R +++ b/R/biting_process.R @@ -8,8 +8,13 @@ #' @param variables a list of all of the model variables #' @param events a list of all of the model events #' @param parameters model pararmeters -#' @param lagged_infectivity a LaggedValue class with historical sums of infectivity +#' @param lagged_infectivity a list of LaggedValue objects with historical sums +#' of infectivity, one for every metapopulation #' @param lagged_eir a LaggedValue class with historical EIRs +#' @param mixing a vector of mixing coefficients for the lagged_infectivity +#' values (default: 1) +#' @param mixing_index an index for this population's position in the +#' lagged_infectivity list (default: 1) #' @noRd create_biting_process <- function( renderer, @@ -19,7 +24,9 @@ create_biting_process <- function( events, parameters, lagged_infectivity, - lagged_eir + lagged_eir, + mixing = 1, + mixing_index = 1 ) { function(timestep) { # Calculate combined EIR @@ -35,7 +42,9 @@ create_biting_process <- function( parameters, timestep, lagged_infectivity, - lagged_eir + lagged_eir, + mixing, + mixing_index ) simulate_infection( @@ -61,7 +70,9 @@ simulate_bites <- function( parameters, timestep, lagged_infectivity, - lagged_eir + lagged_eir, + mixing = 1, + mixing_index = 1 ) { bitten_humans <- individual::Bitset$new(parameters$human_population) @@ -117,8 +128,17 @@ simulate_bites <- function( n_infectious <- calculate_infectious_compartmental(solver_states) } - lagged_eir[[s_i]]$save(n_infectious * a, timestep) - species_eir <- lagged_eir[[s_i]]$get(timestep - parameters$de) + # store the current population's EIR for later + lagged_eir[[mixing_index]][[s_i]]$save(n_infectious * a, timestep) + + # calculated the EIR for this timestep after mixing + species_eir <- sum( + vnapply( + lagged_eir, + function(l) l[[s_i]]$get(timestep - parameters$de) + ) * mixing + ) + renderer$render(paste0('EIR_', species_name), species_eir, timestep) EIR <- EIR + species_eir expected_bites <- species_eir * mean(psi) @@ -131,9 +151,15 @@ simulate_bites <- function( } } - infectivity <- lagged_infectivity$get(timestep - parameters$delay_gam) - lagged_infectivity$save(sum(human_infectivity * .pi), timestep) - foim <- calculate_foim(a, infectivity) + infectivity <- vnapply( + lagged_infectivity, + function(l) l$get(timestep - parameters$delay_gam) + ) + lagged_infectivity[[mixing_index]]$save( + sum(human_infectivity * .pi), + timestep + ) + foim <- calculate_foim(a, infectivity, mixing) renderer$render(paste0('FOIM_', species_name), foim, timestep) mu <- death_rate(f, W, Z, s_i, parameters) renderer$render(paste0('mu_', species_name), mu, timestep) @@ -276,8 +302,10 @@ unique_biting_rate <- function(age, parameters) { #' @title Calculate the force of infection towards mosquitoes #' #' @param a human blood meal rate -#' @param infectivity_sum a sum of infectivity weighted by relative biting rate +#' @param infectivity_sum a vector of sums of infectivity weighted by relative +#' biting rate for each population +#' @param mixing a vector of mixing coefficients for each population #' @noRd -calculate_foim <- function(a, infectivity_sum) { - a * infectivity_sum +calculate_foim <- function(a, infectivity_sum, mixing) { + a * sum(infectivity_sum * mixing) } diff --git a/R/disease_progression.R b/R/disease_progression.R index e7d8a654..05367252 100644 --- a/R/disease_progression.R +++ b/R/disease_progression.R @@ -7,31 +7,50 @@ #' @param infectivity the handle for the infectivity variable #' @param new_infectivity the new infectivity of the progressed individuals #' @noRd -create_infection_update_listener <- function( - state, - to_state, - infectivity, - new_infectivity - ) { - function(timestep, to_move) { - state$queue_update(to_state, to_move) - infectivity$queue_update(new_infectivity, to_move) - } +update_infection <- function( + state, + to_state, + infectivity, + new_infectivity, + to_move + ) { + state$queue_update(to_state, to_move) + infectivity$queue_update(new_infectivity, to_move) } -create_progression_process <- function(event, state, from_state, rate) { +create_progression_process <- function( + state, + from_state, + to_state, + rate, + infectivity, + new_infectivity + ) { function(timestep) { - event$schedule(state$get_index_of(from_state)$sample(1/rate), 0) + to_move <- state$get_index_of(from_state)$sample(1/rate) + update_infection( + state, + to_state, + infectivity, + new_infectivity, + to_move + ) } } -create_rate_listener <- function(from_state, to_state, renderer) { - renderer$set_default(paste0('rate_', from_state, '_', to_state), 0) - function(timestep, target) { - renderer$render( - paste0('rate_', from_state, '_', to_state), - target$size(), - timestep +create_asymptomatic_progression_process <- function( + state, + rate, + variables, + parameters + ) { + function(timestep) { + to_move <- state$get_index_of('D')$sample(1/rate) + update_to_asymptomatic_infection( + variables, + parameters, + timestep, + to_move ) } } @@ -43,22 +62,25 @@ create_rate_listener <- function(from_state, to_state, renderer) { #' @param variables the available human variables #' @param parameters model parameters #' @noRd -create_asymptomatic_update_listener <- function(variables, parameters) { - function(timestep, to_move) { - if (to_move$size() > 0) { - variables$state$queue_update('A', to_move) - new_infectivity <- asymptomatic_infectivity( - get_age( - variables$birth$get_values(to_move), - timestep - ), - variables$id$get_values(to_move), - parameters - ) - variables$infectivity$queue_update( - new_infectivity, - to_move - ) - } +update_to_asymptomatic_infection <- function( + variables, + parameters, + timestep, + to_move + ) { + if (to_move$size() > 0) { + variables$state$queue_update('A', to_move) + new_infectivity <- asymptomatic_infectivity( + get_age( + variables$birth$get_values(to_move), + timestep + ), + variables$id$get_values(to_move), + parameters + ) + variables$infectivity$queue_update( + new_infectivity, + to_move + ) } } diff --git a/R/events.R b/R/events.R index e8e5704c..2c17e30d 100644 --- a/R/events.R +++ b/R/events.R @@ -1,14 +1,5 @@ create_events <- function(parameters) { events <- list( - # Disease progression events - asymptomatic_progression = individual::TargetedEvent$new(parameters$human_population), - subpatent_progression = individual::TargetedEvent$new(parameters$human_population), - recovery = individual::TargetedEvent$new(parameters$human_population), - - # Human infection events - clinical_infection = individual::TargetedEvent$new(parameters$human_population), - asymptomatic_infection = individual::TargetedEvent$new(parameters$human_population), - # MDA events mda_administer = individual::Event$new(), smc_administer = individual::Event$new(), @@ -100,65 +91,6 @@ attach_event_listeners <- function( correlations, renderer ) { - - # ============= - # State updates - # ============= - # When infection events fire, update the corresponding states and infectivity - # variables - - # Infection events - events$clinical_infection$add_listener( - create_infection_update_listener( - variables$state, - 'D', - variables$infectivity, - parameters$cd - ) - ) - - events$asymptomatic_progression$add_listener( - create_asymptomatic_update_listener( - variables, - parameters - ) - ) - events$asymptomatic_progression$add_listener( - create_rate_listener('D', 'A', renderer) - ) - events$asymptomatic_infection$add_listener( - create_asymptomatic_update_listener( - variables, - parameters - ) - ) - - # Recovery events - events$subpatent_progression$add_listener( - create_infection_update_listener( - variables$state, - 'U', - variables$infectivity, - parameters$cu - ) - ) - - events$subpatent_progression$add_listener( - create_rate_listener('A', 'U', renderer) - ) - - events$recovery$add_listener( - create_infection_update_listener( - variables$state, - 'S', - variables$infectivity, - 0 - ) - ) - events$recovery$add_listener( - create_rate_listener('U', 'S', renderer) - ) - # =========== # Progression # =========== @@ -226,8 +158,8 @@ attach_event_listeners <- function( parameters$mda_drug, parameters$mda_timesteps, parameters$mda_coverages, - parameters$mda_min_age, - parameters$mda_max_age, + parameters$mda_min_ages, + parameters$mda_max_ages, correlations, 'mda', parameters, @@ -242,8 +174,8 @@ attach_event_listeners <- function( parameters$smc_drug, parameters$smc_timesteps, parameters$smc_coverages, - parameters$smc_min_age, - parameters$smc_max_age, + parameters$smc_min_ages, + parameters$smc_max_ages, correlations, 'smc', parameters, diff --git a/R/human_infection.R b/R/human_infection.R index bd76ac97..a7474382 100644 --- a/R/human_infection.R +++ b/R/human_infection.R @@ -73,7 +73,6 @@ simulate_infection <- function( treated <- calculate_treated( variables, clinical_infections, - events$recovery, parameters, timestep, renderer @@ -83,11 +82,12 @@ simulate_infection <- function( renderer$render('n_infections', infected_humans$size(), timestep) schedule_infections( - events, + variables, clinical_infections, treated, infected_humans, - parameters + parameters, + timestep ) } @@ -255,7 +255,6 @@ update_severe_disease <- function( #' Sample treated humans from the clinically infected #' @param variables a list of all of the model variables #' @param clinical_infections a bitset of clinically infected humans -#' @param recovery the recovery event #' @param parameters model parameters #' @param timestep the current timestep #' @param renderer simulation renderer @@ -263,7 +262,6 @@ update_severe_disease <- function( calculate_treated <- function( variables, clinical_infections, - recovery, parameters, timestep, renderer @@ -319,12 +317,12 @@ calculate_treated <- function( #' @param parameters model parameters #' @noRd schedule_infections <- function( - events, + variables, clinical_infections, treated, infections, parameters, - asymptomatics + timestep ) { included <- treated$not(TRUE) @@ -334,13 +332,22 @@ schedule_infections <- function( ) if(to_infect$size() > 0) { - infection_times <- log_uniform(to_infect$size(), parameters$de) - events$clinical_infection$schedule(to_infect, 0) + update_infection( + variables$state, + 'D', + variables$infectivity, + parameters$cd, + to_infect + ) } if(to_infect_asym$size() > 0) { - infection_times <- log_uniform(to_infect_asym$size(), parameters$de) - events$asymptomatic_infection$schedule(to_infect_asym, 0) + update_to_asymptomatic_infection( + variables, + parameters, + timestep, + to_infect_asym + ) } } diff --git a/R/mda_parameters.R b/R/mda_parameters.R index 166f8a1c..287ab61b 100644 --- a/R/mda_parameters.R +++ b/R/mda_parameters.R @@ -2,10 +2,10 @@ #' @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 mda -#' @param coverages the proportion of the target population who recieve each +#' @param coverages a vector of the proportion of the target population who receive each #' round -#' @param min_age the minimum age of the target population exclusive (in timesteps) -#' @param max_age the maximum age of the target population exclusive (in timesteps) +#' @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( @@ -13,15 +13,26 @@ set_mda <- function( drug, timesteps, coverages, - min_age, - max_age + min_ages, + max_ages ) { + + if(length(coverages) != length(timesteps)){ + stop("coverages and timesteps do no align") + } + if(length(min_ages) != length(timesteps)){ + stop("minimum ages and timesteps do no align") + } + if(length(max_ages) != length(timesteps)){ + stop("maximum ages and timesteps do no align") + } + parameters$mda <- TRUE parameters$mda_drug <- drug parameters$mda_timesteps <- timesteps parameters$mda_coverages <- coverages - parameters$mda_min_age <- min_age - parameters$mda_max_age <- max_age + parameters$mda_min_ages <- min_ages + parameters$mda_max_ages <- max_ages parameters } @@ -29,10 +40,10 @@ set_mda <- function( #' @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 smc -#' @param coverages the proportion of the target population who recieve each +#' @param coverages a vector of the proportion of the target population who receive each #' round -#' @param min_age the minimum age of the target population exclusive (in timesteps) -#' @param max_age the maximum age of the target population exclusive (in timesteps) +#' @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_smc <- function( @@ -40,14 +51,25 @@ set_smc <- function( drug, timesteps, coverages, - min_age, - max_age + min_ages, + max_ages ) { + + if(length(coverages) != length(timesteps)){ + stop("coverages and timesteps do no align") + } + if(length(min_ages) != length(timesteps)){ + stop("minimum ages and timesteps do no align") + } + if(length(max_ages) != length(timesteps)){ + stop("maximum ages and timesteps do no align") + } + parameters$smc <- TRUE parameters$smc_drug <- drug parameters$smc_timesteps <- timesteps parameters$smc_coverages <- coverages - parameters$smc_min_age <- min_age - parameters$smc_max_age <- max_age + parameters$smc_min_ages <- min_ages + parameters$smc_max_ages <- max_ages parameters } diff --git a/R/mda_processes.R b/R/mda_processes.R index 3833a152..348e224b 100644 --- a/R/mda_processes.R +++ b/R/mda_processes.R @@ -4,8 +4,8 @@ #' @param drug the drug to administer #' @param timesteps timesteps for each round #' @param coverages the coverage for each round -#' @param min_age minimum age for the target population -#' @param max_age maximum age for the target population +#' @param min_ages minimum age for the target population for each round +#' @param max_ages maximum age for the target population for each round #' @param correlations correlation parameters #' @param int_name the name of this intervention (either 'smc' or 'mda') #' @param parameters the model parameters @@ -18,8 +18,8 @@ create_mda_listeners <- function( drug, timesteps, coverages, - min_age, - max_age, + min_ages, + max_ages, correlations, int_name, parameters, @@ -30,7 +30,7 @@ create_mda_listeners <- function( coverage <- coverages[[time_index]] age <- get_age(variables$birth$get_values(), timestep) - in_age <- which((age > min_age) & (age < max_age)) + in_age <- which((age > min_ages[[time_index]]) & (age < max_ages[[time_index]])) target <- in_age[sample_intervention(in_age, int_name, coverage, correlations)] successful_treatments <- bernoulli( diff --git a/R/model.R b/R/model.R index 6c88e551..86262e49 100644 --- a/R/model.R +++ b/R/model.R @@ -71,6 +71,7 @@ #' subpatent #' * rate_U_S: rate that humans transition from subpatent to #' susceptible +#' * net_usage: the number people protected by a bed net #' * mosquito_deaths: number of adult female mosquitoes who die this timestep #' #' @param timesteps the number of timesteps to run the simulation for (in days) @@ -111,7 +112,9 @@ run_simulation <- function( parameters, vector_models, solvers, - correlations + correlations, + list(create_lagged_eir(variables, solvers, parameters)), + list(create_lagged_infectivity(variables, parameters)) ), variables = variables, events = unlist(events), @@ -120,6 +123,102 @@ run_simulation <- function( renderer$to_dataframe() } +#' @title Run a metapopulation model +#' +#' @param timesteps the number of timesteps to run the simulation for (in days) +#' @param parameters a list of model parameter lists for each population +#' @param correlations a list of correlation parameters for each population +#' (default: NULL) +#' @param mixing matrix of mixing coefficients for infectivity towards +#' mosquitoes. Each element must be between 0 and 1 and all rows and columns must sum to 1. +#' @return a list of dataframe of results +#' @export +run_metapop_simulation <- function( + timesteps, + parameters, + correlations = NULL, + mixing + ) { + random_seed(ceiling(runif(1) * .Machine$integer.max)) + if (nrow(mixing) != ncol(mixing)) { + stop('mixing matrix must be square') + } + if (nrow(mixing) != length(parameters)) { + stop('mixing matrix rows must match length of parameters') + } + if (!all(round(rowSums(mixing), 1) == 1)) { + stop('all mixing matrix rows must sum to 1') + } + if (!all(round(colSums(mixing), 1) == 1)) { + stop('all mixing matrix columns must sum to 1') + } + if (is.null(correlations)) { + correlations <- lapply(parameters, get_correlation_parameters) + } + variables <- lapply(parameters, create_variables) + events <- lapply(parameters, create_events) + renderer <- lapply(parameters, function(.) individual::Render$new(timesteps)) + for (i in seq_along(parameters)) { + # NOTE: forceAndCall is necessary here to make sure i refers to the current + # iteration + forceAndCall( + 3, + initialise_events, + events[[i]], + variables[[i]], + parameters[[i]] + ) + forceAndCall( + 5, + attach_event_listeners, + events[[i]], + variables[[i]], + parameters[[i]], + correlations[[i]], + renderer[[i]] + ) + } + vector_models <- lapply(parameters, parameterise_mosquito_models) + solvers <- lapply( + seq_along(parameters), + function(i) parameterise_solvers(vector_models[[i]], parameters[[i]]) + ) + lagged_eir <- lapply( + seq_along(parameters), + function(i) create_lagged_eir(variables[[i]], solvers[[i]], parameters[[i]]) + ) + lagged_infectivity <- lapply( + seq_along(parameters), + function(i) create_lagged_infectivity(variables[[i]], parameters[[i]]) + ) + processes <- lapply( + seq_along(parameters), + function(i) { + create_processes( + renderer[[i]], + variables[[i]], + events[[i]], + parameters[[i]], + vector_models[[i]], + solvers[[i]], + correlations[[i]], + lagged_eir, + lagged_infectivity, + mixing[i,], + i + ) + } + ) + individual::simulation_loop( + processes = unlist(processes), + variables = unlist(variables), + events = unlist(events), + timesteps = timesteps + ) + + lapply(renderer, function(r) r$to_dataframe()) +} + #' @title Run the simulation with repetitions #' #' @param timesteps the number of timesteps to run the simulation for diff --git a/R/mortality_processes.R b/R/mortality_processes.R index 4abc2053..5884c928 100644 --- a/R/mortality_processes.R +++ b/R/mortality_processes.R @@ -78,12 +78,6 @@ reset_target <- function(variables, events, target, state, timestep) { if (target$size() > 0) { # clear events to_clear <- c( - 'asymptomatic_progression', - 'subpatent_progression', - 'recovery', - 'clinical_infection', - 'asymptomatic_infection', - 'detection', 'throw_away_net', 'rtss_mass_doses', 'rtss_mass_booster', diff --git a/R/parameters.R b/R/parameters.R index 44b4a512..309b0265 100644 --- a/R/parameters.R +++ b/R/parameters.R @@ -364,14 +364,14 @@ get_parameters <- function(overrides = list()) { mda_drug = 0, mda_timesteps = NULL, mda_coverages = NULL, - mda_min_age = -1, - mda_max_age = -1, + mda_min_ages = -1, + mda_max_ages = -1, smc = FALSE, smc_drug = 0, smc_timesteps = NULL, smc_coverages = NULL, - smc_min_age = -1, - smc_max_age = -1, + smc_min_ages = -1, + smc_max_ages = -1, # tbv tbv = FALSE, tbv_mt = 35, diff --git a/R/processes.R b/R/processes.R index fc7749ee..beedff6c 100644 --- a/R/processes.R +++ b/R/processes.R @@ -10,6 +10,14 @@ #' @param models a list of vector models, one for each species #' @param solvers a list of ode solvers, one for each species #' @param correlations the intervention correlations object +#' @param lagged_eir a list of list of LaggedValue objects for EIR for each +#' population and species in the simulation +#' @param lagged_infectivity a list of LaggedValue objects for FOIM for each population +#' in the simulation +#' @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 +#' lagged transmission lists (default: 1) #' @noRd create_processes <- function( renderer, @@ -18,7 +26,11 @@ create_processes <- function( parameters, models, solvers, - correlations + correlations, + lagged_eir, + lagged_infectivity, + mixing = 1, + mixing_index = 1 ) { # ======== # Immunity @@ -54,31 +66,6 @@ create_processes <- function( # schedule infections for humans and set last_boosted_* # move mosquitoes into incubating state # kill mosquitoes caught in vector control - lagged_eir <- lapply( - seq_along(parameters$species), - function(species) { - LaggedValue$new( - max_lag = parameters$de + 1, - default = calculate_eir( - species, - solvers, - variables, - parameters, - 0 - ) - ) - } - ) - - age <- get_age(variables$birth$get_values(), 0) - psi <- unique_biting_rate(age, parameters) - .pi <- human_pi(psi, variables$zeta$get_values()) - init_infectivity <- sum(.pi * variables$infectivity$get_values()) - lagged_infectivity <- LaggedValue$new( - max_lag = parameters$delay_gam + 2, - default = init_infectivity - ) - processes <- c( processes, create_biting_process( @@ -89,32 +76,40 @@ create_processes <- function( events, parameters, lagged_infectivity, - lagged_eir + lagged_eir, + mixing, + mixing_index ), create_mortality_process(variables, events, renderer, parameters), - create_progression_process( - events$asymptomatic_progression, + create_asymptomatic_progression_process( variables$state, - 'D', - parameters$dd + parameters$dd, + variables, + parameters ), create_progression_process( - events$subpatent_progression, variables$state, 'A', - parameters$da + 'U', + parameters$da, + variables$infectivity, + parameters$cu ), create_progression_process( - events$recovery, variables$state, 'U', - parameters$du + 'S', + parameters$du, + variables$infectivity, + 0 ), create_progression_process( - events$recovery, variables$state, 'Tr', - parameters$dt + 'S', + parameters$dt, + variables$infectivity, + 0 ) ) @@ -231,3 +226,43 @@ create_exponential_decay_process <- function(variable, rate) { decay_rate <- exp(-1/rate) function(timestep) variable$queue_update(variable$get_values() * decay_rate) } + +#' @title Create and initialise lagged_infectivity object +#' +#' @param variables model variables for initialisation +#' @param parameters model parameters +#' @noRd +create_lagged_infectivity <- function(variables, parameters) { + age <- get_age(variables$birth$get_values(), 0) + psi <- unique_biting_rate(age, parameters) + .pi <- human_pi(psi, variables$zeta$get_values()) + init_infectivity <- sum(.pi * variables$infectivity$get_values()) + LaggedValue$new( + max_lag = parameters$delay_gam + 2, + default = init_infectivity + ) +} + +#' @title Create and initialise a list of lagged_eir objects per species +#' +#' @param variables model variables for initialisation +#' @param solvers model differential equation solvers +#' @param parameters model parameters +#' @noRd +create_lagged_eir <- function(variables, solvers, parameters) { + lapply( + seq_along(parameters$species), + function(species) { + LaggedValue$new( + max_lag = parameters$de + 1, + default = calculate_eir( + species, + solvers, + variables, + parameters, + 0 + ) + ) + } + ) +} diff --git a/R/variables.R b/R/variables.R index 09d4f56e..95acb018 100644 --- a/R/variables.R +++ b/R/variables.R @@ -307,6 +307,11 @@ create_variables <- function(parameters) { variables } + +create_export_variable <- function(metapop_params) { + individual::DoubleVariable$new(rep(0, length(metapop_params$x))) +} + # ========= # Utilities # ========= diff --git a/man/CorrelationParameters.Rd b/man/CorrelationParameters.Rd index b1d22578..c2e6ada7 100644 --- a/man/CorrelationParameters.Rd +++ b/man/CorrelationParameters.Rd @@ -14,17 +14,17 @@ Describes an event in the simulation \section{Methods}{ \subsection{Public methods}{ \itemize{ -\item \href{#method-new}{\code{CorrelationParameters$new()}} -\item \href{#method-inter_round_rho}{\code{CorrelationParameters$inter_round_rho()}} -\item \href{#method-inter_intervention_rho}{\code{CorrelationParameters$inter_intervention_rho()}} -\item \href{#method-sigma}{\code{CorrelationParameters$sigma()}} -\item \href{#method-mvnorm}{\code{CorrelationParameters$mvnorm()}} -\item \href{#method-clone}{\code{CorrelationParameters$clone()}} +\item \href{#method-CorrelationParameters-new}{\code{CorrelationParameters$new()}} +\item \href{#method-CorrelationParameters-inter_round_rho}{\code{CorrelationParameters$inter_round_rho()}} +\item \href{#method-CorrelationParameters-inter_intervention_rho}{\code{CorrelationParameters$inter_intervention_rho()}} +\item \href{#method-CorrelationParameters-sigma}{\code{CorrelationParameters$sigma()}} +\item \href{#method-CorrelationParameters-mvnorm}{\code{CorrelationParameters$mvnorm()}} +\item \href{#method-CorrelationParameters-clone}{\code{CorrelationParameters$clone()}} } } \if{html}{\out{