From 4bebd42761763ad7113ef9bba390c0c0888f74c9 Mon Sep 17 00:00:00 2001 From: RJSheppard Date: Tue, 10 Sep 2024 10:04:16 +0100 Subject: [PATCH 1/2] recovery_rates variable has been renamed as (disease) progression_rates. I've created two new functions to standardise drug and resistance calculations across treatment and mass treatments: calculate_successful_treatments and update_mass_drug_admin calculate_successful_treatments handles the durg efficacy and antimalarial resistance, generating key outputs for each intervention type and returning a bitset of those treated, a vector of the drugs used to treat those individuals and a vector of treated delays for those individual if resistance (SPC) is switched on. This function is called during calculate_treated, create_mda_listeners and create_pmc_process. update_mass_drug_admin calls update_infection twice,assigning D and LM-detectable A infections to Tr, while non-LM detectable A infections, U and Tr infections to S. Those assigned to S have 0 infectivity and 0 dt, while those who are assigned to Tr are assigned a fraction of their infectivity in the current timestep and dt from the parameter set or calculated using antimalarial resistance. --- R/disease_progression.R | 36 +++-- R/human_infection.R | 123 ++++++++++----- R/mda_processes.R | 164 +++++++++++++------- R/mortality_processes.R | 2 +- R/pmc.R | 66 ++++---- R/processes.R | 12 +- R/variables.R | 20 +-- tests/testthat/test-infection-integration.R | 35 ++--- tests/testthat/test-mda.R | 87 ++++++++--- tests/testthat/test-pmc.R | 10 +- 10 files changed, 340 insertions(+), 215 deletions(-) diff --git a/R/disease_progression.R b/R/disease_progression.R index dde88bb2..98710c44 100644 --- a/R/disease_progression.R +++ b/R/disease_progression.R @@ -1,34 +1,34 @@ -#' @title Calculate recovery rates -#' @description Calculates recovery rates for each individual in the population +#' @title Calculate disease progression rates +#' @description Calculates disease progression rates for each individual in the population #' for storage in competing hazards object and subsequent resolution #' #' @param variables the available human variables -#' @param recovery_outcome competing hazards object for recovery rates +#' @param progression_outcome competing hazards object for disease progression rates #' @noRd -create_recovery_rates_process <- function( +create_progression_rates_process <- function( variables, - recovery_outcome + progression_outcome ) { function(timestep){ target <- variables$state$get_index_of("S")$not() - recovery_outcome$set_rates( + progression_outcome$set_rates( target, - variables$recovery_rates$get_values(target)) + variables$progression_rates$get_values(target)) } } -#' @title Disease progression outcomes (recovery) +#' @title Disease progression outcomes #' @description Following resolution of competing hazards, update state and #' infectivity of sampled individuals #' #' @param timestep the current timestep -#' @param target the sampled recovering individuals +#' @param target the sampled progressing individuals #' @param variables the available human variables #' @param parameters model parameters -#' @param renderer competing hazards object for recovery rates +#' @param renderer competing hazards object for disease progression rates #' @noRd -recovery_outcome_process <- function( +progression_outcome_process <- function( timestep, target, variables, @@ -48,7 +48,7 @@ recovery_outcome_process <- function( "U", variables$infectivity, parameters$cu, - variables$recovery_rates, + variables$progression_rates, 1/parameters$du, variables$state$get_index_of("A")$and(target) ) @@ -58,7 +58,7 @@ recovery_outcome_process <- function( "S", variables$infectivity, 0, - variables$recovery_rates, + variables$progression_rates, 0, variables$state$get_index_of(c("U","Tr"))$and(target) ) @@ -73,19 +73,21 @@ recovery_outcome_process <- function( #' @param to_state the destination disease state #' @param infectivity the handle for the infectivity variable #' @param new_infectivity the new infectivity of the progressed individuals +#' @param progression_rates the handle for the progression_rates variable +#' @param new_progression the new disease progression rate of the progressed individuals #' @noRd update_infection <- function( state, to_state, infectivity, new_infectivity, - recovery_rates, - new_recovery_rate, + progression_rates, + new_progression_rate, to_move ) { state$queue_update(to_state, to_move) infectivity$queue_update(new_infectivity, to_move) - recovery_rates$queue_update(new_recovery_rate, to_move) + progression_rates$queue_update(new_progression_rate, to_move) } #' @title Modelling the progression to asymptomatic disease @@ -115,7 +117,7 @@ update_to_asymptomatic_infection <- function( new_infectivity, to_move ) - variables$recovery_rates$queue_update( + variables$progression_rates$queue_update( 1/parameters$da, to_move ) diff --git a/R/human_infection.R b/R/human_infection.R index 6f16a7bb..a39d4ba9 100644 --- a/R/human_infection.R +++ b/R/human_infection.R @@ -347,13 +347,72 @@ calculate_treated <- function( ) ]) + successfully_treated <- calculate_successful_treatments( + parameters, + seek_treatment, + drugs, + timestep, + renderer, + "" + ) + + if (successfully_treated$successfully_treated$size() > 0) { + + if(parameters$antimalarial_resistance) { + dt_update_vector <- successfully_treated$dt_spc_combined + } else { + dt_update_vector <- parameters$dt + } + + update_infection( + variables$state, + 'Tr', + variables$infectivity, + parameters$cd * parameters$drug_rel_c[successfully_treated$drugs], + variables$progression_rates, + 1/dt_update_vector, + successfully_treated$successfully_treated + ) + + variables$drug$queue_update( + successfully_treated$drugs, + successfully_treated$successfully_treated + ) + variables$drug_time$queue_update( + timestep, + successfully_treated$successfully_treated + ) + } + + successfully_treated$successfully_treated + +} + + +#' @title Calculate successfully treated humans +#' @description +#' Sample successful treatments based on drug efficacy and antimalarial resistance +#' @param parameters model parameters +#' @param target bitset of treated humans +#' @param drugs drug index +#' @param timestep the current timestep +#' @param renderer simulation renderer +#' @noRd +calculate_successful_treatments <- function( + parameters, + target, + drugs, + timestep, + renderer, + int_name){ + #+++ DRUG EFFICACY +++# #+++++++++++++++++++++# effectively_treated_index <- bernoulli_multi_p(parameters$drug_efficacy[drugs]) - effectively_treated <- bitset_at(seek_treatment, effectively_treated_index) + effectively_treated <- bitset_at(target, 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) + n_drug_efficacy_failures <- target$size() - effectively_treated$size() + renderer$render(paste0('n_', int_name, 'drug_efficacy_failures'), n_drug_efficacy_failures, timestep) #+++ ANTIMALARIAL RESISTANCE +++# #+++++++++++++++++++++++++++++++# @@ -370,7 +429,7 @@ calculate_treated <- function( 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) + renderer$render(paste0('n_', int_name, 'early_treatment_failure'), n_early_treatment_failure, timestep) drugs <- drugs[successfully_treated_indices] dt_slow_parasite_clearance <- resistance_parameters$dt_slow_parasite_clearance[successfully_treated_indices] @@ -380,51 +439,30 @@ calculate_treated <- function( 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) + renderer$render(paste0('n_', int_name, 'slow_parasite_clearance'), slow_parasite_clearance_individuals$size(), timestep) non_slow_parasite_clearance_individuals <- successfully_treated$copy()$set_difference(slow_parasite_clearance_individuals) - renderer$render('n_successfully_treated', successfully_treated$size(), timestep) + renderer$render(paste0('n_', int_name, 'successfully_treated'), successfully_treated$size(), timestep) dt_slow_parasite_clearance <- dt_slow_parasite_clearance[slow_parasite_clearance_indices] + dt_spc_combined <- rep(parameters$dt, length(successfully_treated_indices)) + dt_spc_combined[slow_parasite_clearance_indices] <- dt_slow_parasite_clearance + + successfully_treated_list <- list( + drugs = drugs, + successfully_treated = successfully_treated, + dt_spc_combined = dt_spc_combined) + } else { successfully_treated <- effectively_treated - renderer$render('n_successfully_treated', successfully_treated$size(), timestep) + renderer$render(paste0('n_', int_name, 'successfully_treated'), successfully_treated$size(), timestep) + + successfully_treated_list <- list( + drugs = drugs, + successfully_treated = successfully_treated) } - - if (successfully_treated$size() > 0) { - variables$state$queue_update("Tr", successfully_treated) - variables$infectivity$queue_update( - parameters$cd * parameters$drug_rel_c[drugs], - successfully_treated - ) - variables$drug$queue_update( - drugs, - successfully_treated - ) - variables$drug_time$queue_update( - timestep, - successfully_treated - ) - if(parameters$antimalarial_resistance) { - variables$recovery_rates$queue_update( - 1/parameters$dt, - non_slow_parasite_clearance_individuals - ) - variables$recovery_rates$queue_update( - 1/dt_slow_parasite_clearance, - slow_parasite_clearance_individuals - ) - } else { - variables$recovery_rates$queue_update( - 1/parameters$dt, - successfully_treated - ) - } - } - - successfully_treated - + successfully_treated_list } #' @title Schedule infections @@ -444,6 +482,7 @@ schedule_infections <- function( parameters, timestep ) { + included <- treated$not(TRUE) to_infect <- clinical_infections$and(included) @@ -457,7 +496,7 @@ schedule_infections <- function( 'D', variables$infectivity, parameters$cd, - variables$recovery_rates, + variables$progression_rates, 1/parameters$dd, to_infect ) diff --git a/R/mda_processes.R b/R/mda_processes.R index 72cbe779..de0f494c 100644 --- a/R/mda_processes.R +++ b/R/mda_processes.R @@ -12,70 +12,128 @@ #' @description will create a listener for administering each round of drugs #' @noRd create_mda_listeners <- function( - variables, - drug, - timesteps, - coverages, - min_ages, - max_ages, - correlations, - int_name, - parameters, - renderer - ) { + variables, + drug, + timesteps, + coverages, + min_ages, + max_ages, + correlations, + int_name, + parameters, + renderer +) { + renderer$set_default(paste0('n_', int_name, '_treated'), 0) + renderer$set_default(paste0('n_', int_name, '_drug_efficacy_failures'), 0) + renderer$set_default(paste0('n_', int_name, '_successfully_treated'), 0) + + if(parameters$antimalarial_resistance){ + renderer$set_default(paste0('n_', int_name, '_early_treatment_failure'), 0) + renderer$set_default(paste0('n_', int_name, '_slow_parasite_clearance'), 0) + } + function(timestep) { time_index = which(timesteps == timestep) + if(time_index == 0){ + return() + } coverage <- coverages[[time_index]] - age <- get_age(variables$birth$get_values(), timestep) - - in_age <- which((age > min_ages[[time_index]]) & (age < max_ages[[time_index]])) + if(coverage == 0){ + return() + } + in_age <- variables$birth$get_index_of( + a = timestep - max_ages[[time_index]], + b = timestep - min_ages[[time_index]] + )$to_vector() target <- in_age[sample_intervention(in_age, int_name, coverage, correlations)] - + renderer$render(paste0('n_', int_name, '_treated'), length(target), timestep) + treated <- bitset_at(individual::Bitset$new(parameters$human_population)$not(), target) - successful_treatments <- bernoulli( - length(target), - parameters$drug_efficacy[[drug]] + to_move <- calculate_successful_treatments( + parameters, + treated, + rep(drug, treated$size()), + timestep, + renderer, + paste0(int_name,"_") + ) + + update_mass_drug_admin( + to_move, + variables, + parameters, + timestep, + drug ) - to_move <- individual::Bitset$new(parameters$human_population) - to_move$insert(target[successful_treatments]) + + } +} - if (to_move$size() > 0) { - # Move detectable - clinical <- variables$state$get_index_of('D') - asymptomatic <- variables$state$get_index_of('A') - detectable <- calculate_asymptomatic_detectable( +#' @title Update individuals during MDA/PMC +#' @description Updates individuals disease states, infectivity, dt and drug variables +#' @param target bitset for individuals who have been successfully treated +#' @param variables the variables available in the model +#' @param parameters the model parameters +#' @param timestep the current timestep +#' @param drug the drug to administer +#' @noRd +update_mass_drug_admin <- function( + target, + variables, + parameters, + timestep, + drug +){ + + if (target$successfully_treated$size() > 0) { + # Move clinical and detectable asymptomatic into treated + clinical <- variables$state$get_index_of('D') + asymptomatic <- variables$state$get_index_of('A') + detectable <- calculate_asymptomatic_detectable( + variables$state, + variables$birth, + variables$id, + parameters, + timestep + ) + to_treated <- clinical$or(asymptomatic$and(detectable))$and(target$successfully_treated) + + if(parameters$antimalarial_resistance) { + dt_update_vector <- target$dt_spc_combined[target$successfully_treated$to_vector() %in% to_treated$to_vector()] + } else { + dt_update_vector <- parameters$dt + } + + update_infection( + variables$state, + 'Tr', + variables$infectivity, + variables$infectivity$get_values(to_treated) * parameters$drug_rel_c[[drug]], + variables$progression_rates, + 1/dt_update_vector, + to_treated + ) + + # Move everyone else (susceptible, subpatent, non-detected asymptomatic and treated) to susceptible + other <- target$successfully_treated$copy()$and(to_treated$not(TRUE)) + if (other$size() > 0) { + update_infection( variables$state, - variables$birth, - variables$id, - parameters, - timestep + "S", + variables$infectivity, + 0, + variables$progression_rates, + 0, + other ) - to_treat <- clinical$or(asymptomatic$and(detectable)) - variables$state$queue_update( - 'Tr', - to_treat$copy()$and(to_move) - ) - - # Move everyone else - other <- to_move$copy()$and(to_treat$not(TRUE)) - if (other$size() > 0) { - variables$state$queue_update('S', other) - } - - # Update infectivity - variables$infectivity$queue_update( - variables$infectivity$get_values( - to_move - ) * parameters$drug_rel_c[[drug]], - to_move - ) - - # Update drug - variables$drug$queue_update(drug, to_move) - variables$drug_time$queue_update(timestep, to_move) } + + # Update drug + variables$drug$queue_update(drug, target$successfully_treated) + variables$drug_time$queue_update(timestep, target$successfully_treated) + } } @@ -96,7 +154,7 @@ calculate_asymptomatic_detectable <- function( immunity, parameters, timestep - ) { +) { asymptomatic <- state$get_index_of('A') prob <- probability_of_detection( get_age(birth$get_values(asymptomatic), timestep), diff --git a/R/mortality_processes.R b/R/mortality_processes.R index e67baf0e..b68f5ee7 100644 --- a/R/mortality_processes.R +++ b/R/mortality_processes.R @@ -113,7 +113,7 @@ reset_target <- function(variables, events, target, state, parameters, timestep) # onwards infectiousness variables$infectivity$queue_update(0, target) - variables$recovery_rates$queue_update(0, target) + variables$progression_rates$queue_update(0, target) # zeta and zeta group and vector controls survive rebirth } diff --git a/R/pmc.R b/R/pmc.R index 429bf7d2..1d5f6d7c 100644 --- a/R/pmc.R +++ b/R/pmc.R @@ -23,54 +23,46 @@ create_pmc_process <- function( drug ){ renderer$set_default('n_pmc_treated', 0) + renderer$set_default(paste0('n_pmc_drug_efficacy_failures'), 0) + renderer$set_default(paste0('n_pmc_successfully_treated'), 0) + + if(parameters$antimalarial_resistance){ + renderer$set_default(paste0('n_pmc_early_treatment_failure'), 0) + renderer$set_default(paste0('n_pmc_slow_parasite_clearance'), 0) + } + function(timestep) { - timestep_index <- match_timestep(ts = timesteps, t = timestep) - if(timestep_index == 0){ + time_index <- match_timestep(ts = timesteps, t = timestep) + if(time_index == 0){ return() } - coverage <- coverages[timestep_index] + coverage <- coverages[time_index] if(coverage == 0){ return() } - - age <- get_age(variables$birth$get_values(), timestep) - - in_age <- which(age %in% parameters$pmc_ages) + in_age <- variables$birth$get_index_of( + timesteps[time_index] - parameters$pmc_ages + )$to_vector() target <- in_age[sample_intervention(in_age, 'pmc', coverage, correlations)] renderer$render('n_pmc_treated', length(target), timestep) + treated <- bitset_at(individual::Bitset$new(parameters$human_population)$not(), target) - successful_treatments <- bernoulli( - length(target), - parameters$drug_efficacy[[drug]] + to_move <- calculate_successful_treatments( + parameters, + treated, + rep(drug, treated$size()), + timestep, + renderer, + "pmc_") + + update_mass_drug_admin( + to_move, + variables, + parameters, + timestep, + drug ) - to_move <- individual::Bitset$new(parameters$human_population) - to_move$insert(target[successful_treatments]) - if (to_move$size() > 0) { - # Move Diseased - diseased <- variables$state$get_index_of(c('D', 'A'))$and(to_move) - if (diseased$size() > 0) { - variables$state$queue_update('Tr', diseased) - } - - # Move everyone else - other <- to_move$copy()$and(diseased$not(TRUE)) - if (other$size() > 0) { - variables$state$queue_update('S', other) - } - - # Update infectivity - variables$infectivity$queue_update( - variables$infectivity$get_values( - to_move - ) * parameters$drug_rel_c[[drug]], - to_move - ) - - # Update drug - variables$drug$queue_update(drug, to_move) - variables$drug_time$queue_update(timestep, to_move) - } } } \ No newline at end of file diff --git a/R/processes.R b/R/processes.R index 9f71948d..12ee3528 100644 --- a/R/processes.R +++ b/R/processes.R @@ -71,7 +71,7 @@ create_processes <- function( } # ===================================================== - # Competing Hazard Outcomes (Infections and Recoveries) + # Competing Hazard Outcomes (infections and disease progression) # ===================================================== infection_outcome <- CompetingOutcome$new( @@ -83,9 +83,9 @@ create_processes <- function( size = parameters$human_population ) - recovery_outcome <- CompetingOutcome$new( + progression_outcome <- CompetingOutcome$new( targeted_process = function(timestep, target){ - recovery_outcome_process(timestep, target, variables, parameters, renderer) + progression_outcome_process(timestep, target, variables, parameters, renderer) }, size = parameters$human_population ) @@ -119,14 +119,14 @@ create_processes <- function( processes <- c( processes, - progression_process = create_recovery_rates_process( + progression_process = create_progression_rates_process( variables, - recovery_outcome + progression_outcome ), # Resolve competing hazards of infection with disease progression hazard_resolution_process = CompetingHazard$new( - outcomes = list(infection_outcome, recovery_outcome), + outcomes = list(infection_outcome, progression_outcome), size = parameters$human_population )$resolve ) diff --git a/R/variables.R b/R/variables.R index 5a6dc749..66f0ce4f 100644 --- a/R/variables.R +++ b/R/variables.R @@ -192,15 +192,15 @@ create_variables <- function(parameters) { # Initialise the infectivity variable infectivity <- individual::DoubleVariable$new(infectivity_values) - # Set recovery rate for each individual - recovery_values <- rep(0, get_human_population(parameters, 0)) - recovery_values[diseased] <- 1/parameters$dd - recovery_values[asymptomatic] <- 1/parameters$da - recovery_values[subpatent] <- 1/parameters$du - recovery_values[treated] <- 1/parameters$dt - - # Initialise the recovery rate variable - recovery_rates <- individual::DoubleVariable$new(recovery_values) + # Set disease progression rates for each individual + progression_rate_values <- rep(0, get_human_population(parameters, 0)) + progression_rate_values[diseased] <- 1/parameters$dd + progression_rate_values[asymptomatic] <- 1/parameters$da + progression_rate_values[subpatent] <- 1/parameters$du + progression_rate_values[treated] <- 1/parameters$dt + + # Initialise the disease progression rate variable + progression_rates <- individual::DoubleVariable$new(progression_rate_values) drug <- individual::IntegerVariable$new(rep(0, size)) drug_time <- individual::IntegerVariable$new(rep(-1, size)) @@ -231,7 +231,7 @@ create_variables <- function(parameters) { zeta = zeta, zeta_group = zeta_group, infectivity = infectivity, - recovery_rates = recovery_rates, + progression_rates = progression_rates, drug = drug, drug_time = drug_time, last_pev_timestep = last_pev_timestep, diff --git a/tests/testthat/test-infection-integration.R b/tests/testthat/test-infection-integration.R index 17972b6a..eb4eabb6 100644 --- a/tests/testthat/test-infection-integration.R +++ b/tests/testthat/test-infection-integration.R @@ -320,7 +320,7 @@ test_that('calculate_treated correctly samples treated and updates the drug stat variables <- list( state = list(queue_update = mockery::mock()), infectivity = list(queue_update = mockery::mock()), - recovery_rates = list(queue_update = mockery::mock()), + progression_rates = list(queue_update = mockery::mock()), drug = list(queue_update = mockery::mock()), drug_time = list(queue_update = mockery::mock()) ) @@ -336,8 +336,9 @@ test_that('calculate_treated correctly samples treated and updates the drug stat ) sample_mock <- mockery::mock(c(2, 1, 1, 1)) mockery::stub(calculate_treated, 'sample.int', sample_mock) + bernoulli_mock <- mockery::mock(c(1, 3)) - mockery::stub(calculate_treated, 'bernoulli_multi_p', bernoulli_mock) + local_mocked_bindings(bernoulli_multi_p = bernoulli_mock) mockery::stub(calculate_treated, 'log_uniform', mockery::mock(c(3, 4))) clinical_infections <- individual::Bitset$new(4) @@ -410,7 +411,7 @@ test_that('calculate_treated correctly samples treated and updates the drug stat variables <- list( state = list(queue_update = mockery::mock()), infectivity = list(queue_update = mockery::mock()), - recovery_rates = list(queue_update = mockery::mock()), + progression_rates = list(queue_update = mockery::mock()), drug = list(queue_update = mockery::mock()), drug_time = list(queue_update = mockery::mock()) ) @@ -429,7 +430,7 @@ test_that('calculate_treated correctly samples treated and updates the drug stat 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) + local_mocked_bindings(bernoulli_multi_p = bernoulli_mock) calculate_treated( variables, @@ -487,8 +488,7 @@ test_that('calculate_treated correctly samples treated and updates the drug stat ) 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$recovery_rates$queue_update, 1/5, c(2, 3, 4, 5, 6, 7), 1) - expect_bitset_update(variables$recovery_rates$queue_update, 1/15, c(1), 2) + expect_bitset_update(variables$progression_rates$queue_update, c(1/15,rep(1/5,6)), c(1, 2, 3, 4, 5, 6, 7), 1) }) test_that('calculate_treated correctly samples treated and updates the drug state when resistance not set for all drugs', { @@ -523,7 +523,7 @@ test_that('calculate_treated correctly samples treated and updates the drug stat variables <- list( state = list(queue_update = mockery::mock()), infectivity = list(queue_update = mockery::mock()), - recovery_rates = list(queue_update = mockery::mock()), + progression_rates = list(queue_update = mockery::mock()), drug = list(queue_update = mockery::mock()), drug_time = list(queue_update = mockery::mock()) ) @@ -549,7 +549,7 @@ test_that('calculate_treated correctly samples treated and updates the drug stat 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) + local_mocked_bindings(bernoulli_multi_p = bernoulli_mock) # Run the calculate_treated() function now the mocks and stubs are established: calculate_treated( @@ -559,7 +559,7 @@ test_that('calculate_treated correctly samples treated and updates the drug stat 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( @@ -627,20 +627,13 @@ test_that('calculate_treated correctly samples treated and updates the drug stat c(1, 2, 3, 4, 5, 6, 7) ) - # Check that update queued for dt for the non-slow parasite clearance individuals is correct: + # Check that update queued for dt for the slow and non-slow parasite clearance individuals is correct: expect_bitset_update( - variables$recovery_rates$queue_update, - 1/parameters$dt, - c(2, 3, 4, 5, 6, 7), + variables$progression_rates$queue_update, + c(1/unlist(parameters$dt_slow_parasite_clearance), rep(1/parameters$dt, 6)), + c(1, 2, 3, 4, 5, 6, 7), 1) - # Check that update queued for dt for the slow parasite clearance individuals is correct: - expect_bitset_update( - variables$recovery_rates$queue_update, - 1/unlist(parameters$dt_slow_parasite_clearance), - c(1), - 2) - }) test_that('schedule_infections correctly schedules new infections', { @@ -1053,7 +1046,7 @@ test_that('calculate_treated() successfully adds additional resistance columns t variables <- list( state = list(queue_update = mockery::mock()), infectivity = list(queue_update = mockery::mock()), - recovery_rates = list(queue_update = mockery::mock()), + progression_rates = list(queue_update = mockery::mock()), drug = list(queue_update = mockery::mock()), drug_time = list(queue_update = mockery::mock()) ) diff --git a/tests/testthat/test-mda.R b/tests/testthat/test-mda.R index 1ee440f6..e2db7f67 100644 --- a/tests/testthat/test-mda.R +++ b/tests/testthat/test-mda.R @@ -76,6 +76,7 @@ test_that('MDA moves the diseased and non-diseased population correctly', { ), birth = mock_double(-365 * c(2, 20, 5, 7)), infectivity = mock_double(c(.1, .2, .3, .4)), + progression_rates = mock_double(c(.1, .2, .3, .4)), id = mock_double(c(.1, .2, .3, .4)), drug_time = mock_double(c(1, 2, 3, 4)), drug = mock_double(c(1, 2, 1, 2)) @@ -94,15 +95,12 @@ test_that('MDA moves the diseased and non-diseased population correctly', { renderer ) - mockery::stub(listener, 'bernoulli', mockery::mock(c(TRUE, TRUE))) mock_correlation <- mockery::mock(c(TRUE, TRUE)) mockery::stub(listener, 'sample_intervention', mock_correlation) + local_mocked_bindings(bernoulli_multi_p = mockery::mock(1:2)) + local_mocked_bindings(calculate_asymptomatic_detectable = mockery::mock(individual::Bitset$new(4)$insert(3))) + listener(timestep) - mockery::stub( - listener, - 'calculate_asymptomatic_detectable', - mockery::mock(individual::Bitset$new(4)$insert(3)) - ) expect_equal( mockery::mock_args(mock_correlation)[[1]][[1]], @@ -123,8 +121,14 @@ test_that('MDA moves the diseased and non-diseased population correctly', { expect_bitset_update( variables$infectivity$queue_update_mock(), - c(.3, .4) * SP_AQ_params[[2]], - c(3, 4) + c(.3) * SP_AQ_params[[2]], + c(3) + ) + + expect_bitset_update( + variables$progression_rates$queue_update_mock(), + 1/parameters$dt, + c(3) ) expect_bitset_update( @@ -162,6 +166,7 @@ test_that('MDA moves the diseased and non-diseased population correctly - second ), birth = mock_double(-365 * c(2, 20, 5, 7)), infectivity = mock_double(c(.1, .2, .3, .4)), + progression_rates = mock_double(c(.1, .2, .3, .4)), id = mock_double(c(.1, .2, .3, .4)), drug_time = mock_double(c(1, 2, 3, 4)), drug = mock_double(c(1, 2, 1, 2)) @@ -180,14 +185,11 @@ test_that('MDA moves the diseased and non-diseased population correctly - second renderer ) - mockery::stub(listener, 'bernoulli', mockery::mock(c(TRUE, TRUE, TRUE, TRUE))) mock_correlation <- mockery::mock(c(TRUE, TRUE, TRUE, TRUE)) mockery::stub(listener, 'sample_intervention', mock_correlation) - mockery::stub( - listener, - 'calculate_asymptomatic_detectable', - mockery::mock(individual::Bitset$new(4)$insert(3)) - ) + local_mocked_bindings(bernoulli_multi_p = mockery::mock(1:4)) + local_mocked_bindings(calculate_asymptomatic_detectable = mockery::mock(individual::Bitset$new(4)$insert(3))) + listener(timestep) expect_equal( @@ -209,8 +211,28 @@ test_that('MDA moves the diseased and non-diseased population correctly - second expect_bitset_update( variables$infectivity$queue_update_mock(), - c(.1, .2, .3, .4) * SP_AQ_params[[2]], - c(1, 2, 3, 4) + c(.1, .3) * SP_AQ_params[[2]], + c(1, 3) + ) + + expect_bitset_update( + variables$infectivity$queue_update_mock(), + 0, + c(2, 4), + call = 2 + ) + + expect_bitset_update( + variables$progression_rates$queue_update_mock(), + 1/parameters$dt, + c(1, 3) + ) + + expect_bitset_update( + variables$progression_rates$queue_update_mock(), + 0, + c(2, 4), + call = 2 ) expect_bitset_update( @@ -248,6 +270,7 @@ test_that('MDA ignores non-detectable asymptomatics', { ), birth = mock_double(-365 * c(2, 20, 5, 7)), infectivity = mock_double(c(.1, .2, .3, .4)), + progression_rates = mock_double(c(.1, .2, .3, .4)), id = mock_double(c(.1, .2, .3, .4)), drug_time = mock_double(c(1, 2, 3, 4)), drug = mock_double(c(1, 2, 1, 2)) @@ -266,14 +289,10 @@ test_that('MDA ignores non-detectable asymptomatics', { renderer ) - mockery::stub(listener, 'bernoulli', mockery::mock(c(TRUE, TRUE, TRUE, TRUE))) mock_correlation <- mockery::mock(c(TRUE, TRUE, TRUE, TRUE)) mockery::stub(listener, 'sample_intervention', mock_correlation) - mockery::stub( - listener, - 'calculate_asymptomatic_detectable', - mockery::mock(individual::Bitset$new(4)) - ) + local_mocked_bindings(calculate_asymptomatic_detectable = mockery::mock(individual::Bitset$new(4))) + listener(timestep) expect_bitset_update( @@ -291,8 +310,28 @@ test_that('MDA ignores non-detectable asymptomatics', { expect_bitset_update( variables$infectivity$queue_update_mock(), - c(.1, .2, .3, .4) * SP_AQ_params[[2]], - c(1, 2, 3, 4) + c(.1) * SP_AQ_params[[2]], + c(1) + ) + + expect_bitset_update( + variables$infectivity$queue_update_mock(), + 0, + c(2, 3, 4), + call = 2 + ) + + expect_bitset_update( + variables$progression_rates$queue_update_mock(), + 1/parameters$dt, + c(1) + ) + + expect_bitset_update( + variables$progression_rates$queue_update_mock(), + 0, + c(2, 3, 4), + call = 2 ) expect_bitset_update( diff --git a/tests/testthat/test-pmc.R b/tests/testthat/test-pmc.R index ff7e8c56..8622f16f 100644 --- a/tests/testthat/test-pmc.R +++ b/tests/testthat/test-pmc.R @@ -45,7 +45,6 @@ test_that("pmc parameterisation works", { expect_equal(p$pmc_drug, 1) }) - test_that("pmc gives drugs to correct ages", { p <- get_parameters(list(human_population = 6)) @@ -74,6 +73,8 @@ test_that("pmc gives drugs to correct ages", { variables$drug <- mock_integer(rep(0, 6)) variables$drug_time <- mock_integer(rep(-1, 6)) mockery::stub(sample_intervention, 'bernoulli', mockery::mock(c(TRUE, TRUE, TRUE))) + local_mocked_bindings(bernoulli_multi_p = mockery::mock(1:3)) + local_mocked_bindings(calculate_asymptomatic_detectable = mockery::mock(individual::Bitset$new(6)$insert(3))) process <- create_pmc_process( variables = variables, @@ -85,14 +86,15 @@ test_that("pmc gives drugs to correct ages", { timesteps = p$pmc_timesteps, drug = p$pmc_drug ) - # mock the treatment success - mockery::stub(process, 'bernoulli', mockery::mock(c(TRUE, TRUE, TRUE))) + process(timestep) # Three treatments given expect_equal(renderer$to_dataframe(), data.frame(timestep = 1:10, - n_pmc_treated = c(rep(0, 9), 3))) + n_pmc_treated = c(rep(0, 9), 3), + n_pmc_drug_efficacy_failures = c(rep(0, 10)), + n_pmc_successfully_treated = c(rep(0, 9), 3))) # Individuals 3 and 5, are correct age and in D or A states expect_bitset_update( From 2556bd6d0859b2aa67bb49d562a4157b5887e430 Mon Sep 17 00:00:00 2001 From: RJSheppard Date: Tue, 10 Sep 2024 12:46:35 +0100 Subject: [PATCH 2/2] Minor documentation and performance fixed. --- R/human_infection.R | 1 + R/mda_processes.R | 8 +++++--- R/pmc.R | 2 +- 3 files changed, 7 insertions(+), 4 deletions(-) diff --git a/R/human_infection.R b/R/human_infection.R index a39d4ba9..ae2cfe97 100644 --- a/R/human_infection.R +++ b/R/human_infection.R @@ -397,6 +397,7 @@ calculate_treated <- function( #' @param drugs drug index #' @param timestep the current timestep #' @param renderer simulation renderer +#' @param int_name the intervention name to use for rendering, use "" for frontline treatment #' @noRd calculate_successful_treatments <- function( parameters, diff --git a/R/mda_processes.R b/R/mda_processes.R index de0f494c..81ba0b7e 100644 --- a/R/mda_processes.R +++ b/R/mda_processes.R @@ -49,7 +49,7 @@ create_mda_listeners <- function( target <- in_age[sample_intervention(in_age, int_name, coverage, correlations)] renderer$render(paste0('n_', int_name, '_treated'), length(target), timestep) - treated <- bitset_at(individual::Bitset$new(parameters$human_population)$not(), target) + treated <- individual::Bitset$new(parameters$human_population)$insert(target) to_move <- calculate_successful_treatments( parameters, @@ -73,7 +73,7 @@ create_mda_listeners <- function( #' @title Update individuals during MDA/PMC #' @description Updates individuals disease states, infectivity, dt and drug variables -#' @param target bitset for individuals who have been successfully treated +#' @param target a list containing the successfully treated, the drug used and resistance parameters #' @param variables the variables available in the model #' @param parameters the model parameters #' @param timestep the current timestep @@ -101,7 +101,9 @@ update_mass_drug_admin <- function( to_treated <- clinical$or(asymptomatic$and(detectable))$and(target$successfully_treated) if(parameters$antimalarial_resistance) { - dt_update_vector <- target$dt_spc_combined[target$successfully_treated$to_vector() %in% to_treated$to_vector()] + dt_update_vector <- target$dt_spc_combined[ + target$successfully_treated$copy()$and(to_treated)$to_vector() + ] } else { dt_update_vector <- parameters$dt } diff --git a/R/pmc.R b/R/pmc.R index 1d5f6d7c..6397c681 100644 --- a/R/pmc.R +++ b/R/pmc.R @@ -46,7 +46,7 @@ create_pmc_process <- function( target <- in_age[sample_intervention(in_age, 'pmc', coverage, correlations)] renderer$render('n_pmc_treated', length(target), timestep) - treated <- bitset_at(individual::Bitset$new(parameters$human_population)$not(), target) + treated <- individual::Bitset$new(parameters$human_population)$insert(target) to_move <- calculate_successful_treatments( parameters,