Skip to content

Commit

Permalink
Merge pull request #187 from mrc-ide/dev
Browse files Browse the repository at this point in the history
Dev
  • Loading branch information
giovannic authored Aug 8, 2022
2 parents aace0c5 + 9b8ebf6 commit 0b4968e
Show file tree
Hide file tree
Showing 48 changed files with 1,386 additions and 611 deletions.
2 changes: 1 addition & 1 deletion .github/workflows/R-CMD-check.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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: |
Expand Down
14 changes: 7 additions & 7 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: malariasimulation
Title: An individual based model for malaria
Version: 1.3.0
Version: 1.4.1
Authors@R: c(
person(
given = "Giovanni",
Expand All @@ -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",
Expand Down Expand Up @@ -66,7 +66,7 @@ Suggests:
ggplot2,
covr,
mgcv
RoxygenNote: 7.1.2
RoxygenNote: 7.2.1
Roxygen: list(markdown = TRUE)
LinkingTo:
Rcpp,
Expand Down
3 changes: 2 additions & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -4,14 +4,14 @@ export(AL_params)
export(DHA_PQP_params)
export(SP_AQ_params)
export(arab_params)
export(find_birthrates)
export(fun_params)
export(gamb_params)
export(get_correlation_parameters)
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)
Expand All @@ -21,6 +21,7 @@ export(set_drugs)
export(set_equilibrium)
export(set_mass_rtss)
export(set_mda)
export(set_pmc)
export(set_rtss_epi)
export(set_smc)
export(set_species)
Expand Down
52 changes: 40 additions & 12 deletions R/biting_process.R
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand All @@ -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
Expand All @@ -35,7 +42,9 @@ create_biting_process <- function(
parameters,
timestep,
lagged_infectivity,
lagged_eir
lagged_eir,
mixing,
mixing_index
)

simulate_infection(
Expand All @@ -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)

Expand Down Expand Up @@ -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)
Expand All @@ -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)
Expand Down Expand Up @@ -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)
}
2 changes: 1 addition & 1 deletion R/compatibility.R
Original file line number Diff line number Diff line change
Expand Up @@ -184,7 +184,7 @@ remove_unused_equilibrium <- function(params) {
#' equilibrium parameters and set up the initial human and mosquito population
#' to acheive init_EIR
#' @param parameters model parameters to update
#' @param init_EIR the desired initial EIR (infectious bites per day over the entire human
#' @param init_EIR the desired initial EIR (infectious bites per person per day over the entire human
#' population)
#' @param eq_params parameters from the malariaEquilibrium package, if null.
#' The default malariaEquilibrium parameters will be used
Expand Down
1 change: 1 addition & 0 deletions R/correlation.R
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
INTS <- c(
'pmc',
'rtss',
'mda',
'smc',
Expand Down
93 changes: 58 additions & 35 deletions R/disease_progression.R
Original file line number Diff line number Diff line change
Expand Up @@ -7,30 +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) {
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
)
}
}
Expand All @@ -42,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
)
}
}
Loading

0 comments on commit 0b4968e

Please sign in to comment.