From 6008a8a894c5364f44c322dd2caf2508e9fab2fa Mon Sep 17 00:00:00 2001 From: Hillary Topazian <80535782+htopazian@users.noreply.github.com> Date: Tue, 21 May 2024 14:23:32 +0100 Subject: [PATCH 1/4] adding in n_spray output - adding spraying to mortality processes - renaming process from RTS,S to PEV --- R/mortality_processes.R | 5 ++++- R/processes.R | 16 ++++++++-------- R/vector_control.R | 4 +++- 3 files changed, 15 insertions(+), 10 deletions(-) diff --git a/R/mortality_processes.R b/R/mortality_processes.R index 37792f6c..1e7446d9 100644 --- a/R/mortality_processes.R +++ b/R/mortality_processes.R @@ -111,9 +111,12 @@ reset_target <- function(variables, events, target, state, parameters, timestep) variables$pev_profile$queue_update(-1, target) variables$tbv_vaccinated$queue_update(-1, target) + # spraying + variables$spray_time$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) diff --git a/R/processes.R b/R/processes.R index 12f8c3db..1a7b2ebb 100644 --- a/R/processes.R +++ b/R/processes.R @@ -30,7 +30,7 @@ create_processes <- function( correlations, lagged_eir, lagged_infectivity, - timesteps, + timesteps, mixing = 1, mixing_index = 1 ) { @@ -105,22 +105,22 @@ create_processes <- function( 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 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, @@ -143,7 +143,7 @@ create_processes <- function( ) # ========= - # RTS,S EPI + # PEV EPI # ========= if (!is.null(parameters$pev_epi_coverage)) { processes <- c( @@ -250,7 +250,7 @@ create_processes <- function( if (parameters$spraying) { processes <- c( processes, - indoor_spraying(variables$spray_time, parameters, correlations) + indoor_spraying(variables$spray_time, renderer, parameters, correlations) ) } diff --git a/R/vector_control.R b/R/vector_control.R index 29c92d35..10d90c90 100644 --- a/R/vector_control.R +++ b/R/vector_control.R @@ -105,7 +105,8 @@ prob_bitten <- function( #' @param parameters the model parameters #' @param correlations correlation parameters #' @noRd -indoor_spraying <- function(spray_time, parameters, correlations) { +indoor_spraying <- function(spray_time, render, parameters, correlations) { + renderer$set_default('n_spray', 0) function(timestep) { matches <- timestep == parameters$spraying_timesteps if (any(matches)) { @@ -116,6 +117,7 @@ indoor_spraying <- function(spray_time, parameters, correlations) { correlations )) spray_time$queue_update(timestep, target) + renderer$render('n_spray', length(target), timestep) } } } From 75ab41c484219aeb85b62dfa0a11067b28285d62 Mon Sep 17 00:00:00 2001 From: Hillary Topazian <80535782+htopazian@users.noreply.github.com> Date: Tue, 21 May 2024 14:33:23 +0100 Subject: [PATCH 2/4] typo renderer --- R/vector_control.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/vector_control.R b/R/vector_control.R index 10d90c90..64405972 100644 --- a/R/vector_control.R +++ b/R/vector_control.R @@ -105,7 +105,7 @@ prob_bitten <- function( #' @param parameters the model parameters #' @param correlations correlation parameters #' @noRd -indoor_spraying <- function(spray_time, render, parameters, correlations) { +indoor_spraying <- function(spray_time, renderer, parameters, correlations) { renderer$set_default('n_spray', 0) function(timestep) { matches <- timestep == parameters$spraying_timesteps From 0594bd60bd4dfa8dd9ba00a73805f737ba384615 Mon Sep 17 00:00:00 2001 From: Hillary Topazian <80535782+htopazian@users.noreply.github.com> Date: Tue, 21 May 2024 15:18:10 +0100 Subject: [PATCH 3/4] fix tests and documentation --- R/vector_control.R | 1 + tests/testthat/test-vector-control.R | 41 ++++++++++++++-------------- 2 files changed, 22 insertions(+), 20 deletions(-) diff --git a/R/vector_control.R b/R/vector_control.R index 64405972..5223c3bc 100644 --- a/R/vector_control.R +++ b/R/vector_control.R @@ -102,6 +102,7 @@ prob_bitten <- function( #' `get_correlation_parameters` #' #' @param spray_time the variable for the time of spraying +#' @param renderer the model renderer object #' @param parameters the model parameters #' @param correlations correlation parameters #' @noRd diff --git a/tests/testthat/test-vector-control.R b/tests/testthat/test-vector-control.R index 8c2e2d49..35c2e317 100644 --- a/tests/testthat/test-vector-control.R +++ b/tests/testthat/test-vector-control.R @@ -12,7 +12,7 @@ test_that('set_bednets validates coverages', { gamman = c(963.6, 963.6) ) ) - + expect_error( set_bednets( parameters, @@ -26,7 +26,7 @@ test_that('set_bednets validates coverages', { ), "all(coverages >= 0) && all(coverages <= 1) is not TRUE", fixed = TRUE ) - + expect_error( set_bednets( parameters, @@ -136,13 +136,13 @@ test_that('distribute_bednets process sets net_time correctly', { parameters, correlations ) - + target_mock <- mockery::mock(c(FALSE, FALSE, TRUE, TRUE)) mockery::stub(process, 'sample_intervention', target_mock) mockery::stub(process, 'log_uniform', mockery::mock(c(3, 4))) - + process(timestep) - + mockery::expect_args(target_mock, 1, seq(4), 'bednets', .9, correlations) mockery::expect_args( variables$net_time$queue_update_mock(), @@ -176,9 +176,9 @@ test_that('throw_away_bednets process resets net_time correctly', { variables <- create_variables(parameters) variables$net_time <- mock_double(rep(0, 4)) listener <- throw_away_nets(variables) - + listener(timestep, individual::Bitset$new(4)$insert(c(2, 3))) - + expect_bitset_update( variables$net_time$queue_update_mock(), -1, @@ -204,15 +204,16 @@ test_that('indoor_spraying process sets spray_time correctly', { correlations <- get_correlation_parameters(parameters) process <- indoor_spraying( spray_time, + renderer, parameters, correlations ) - + target_mock <- mockery::mock(c(FALSE, FALSE, TRUE, TRUE)) mockery::stub(process, 'sample_intervention', target_mock) - + process(timestep) - + mockery::expect_args(target_mock, 1, seq(4), 'spraying', .9, correlations) mockery::expect_args( spray_time$queue_update_mock(), @@ -228,7 +229,7 @@ test_that('prob_bitten defaults to 1 with no protection', { variables <- create_variables(parameters) variables$net_time <- individual::DoubleVariable$new(rep(-1, 4)) variables$spray_time <- individual::DoubleVariable$new(rep(-1, 4)) - + expect_equal( prob_bitten(timestep, variables, 1, parameters), list( @@ -257,7 +258,7 @@ test_that('prob_bitten correctly calculates net only probabilities', { c(-1, 5, 50, 100) ) variables$spray_time <- individual::DoubleVariable$new(rep(-1, 4)) - + expect_equal( prob_bitten(timestep, variables, 1, parameters), list( @@ -284,12 +285,12 @@ test_that('prob_bitten correctly calculates spraying only probabilities', { ms_gamma = matrix(rep(-0.009, 3), nrow=3, ncol=1) ) variables <- create_variables(parameters) - + variables$net_time <- individual::IntegerVariable$new(rep(-1, 4)) variables$spray_time <- individual::IntegerVariable$new( c(-1, 5, 50, 100) ) - + expect_equal( prob_bitten(timestep, variables, 1, parameters), list( @@ -332,7 +333,7 @@ test_that('prob_bitten correctly combines spraying and net probabilities', { variables$spray_time <- individual::IntegerVariable$new( c(-1, 5, 50, 100) ) - + expect_equal( prob_bitten(timestep, variables, 1, parameters), list( @@ -346,16 +347,16 @@ test_that('prob_bitten correctly combines spraying and net probabilities', { test_that('usage renderer outputs correct values', { timestep <- 150 - + all <- individual::IntegerVariable$new(c(100, 50, 5, 50)) half <- individual::IntegerVariable$new(c(100, 50, -1, -1)) none <- individual::IntegerVariable$new(rep(-1, 4)) - + renderer <- list(render = mockery::mock()) net_usage_renderer(all, renderer)(timestep) net_usage_renderer(half, renderer)(timestep) net_usage_renderer(none, renderer)(timestep) - + mockery::expect_args(renderer$render, 1, 'n_use_net', 4, timestep) mockery::expect_args(renderer$render, 2, 'n_use_net', 2, timestep) mockery::expect_args(renderer$render, 3, 'n_use_net', 0, timestep) @@ -365,7 +366,7 @@ test_that('set_carrying_capacity works',{ p <- list() p$species <- "gamb" p_out <- set_carrying_capacity(p, 1, matrix(0.1)) - + expect_equal( p_out, list( @@ -375,7 +376,7 @@ test_that('set_carrying_capacity works',{ carrying_capacity_scalers = matrix(0.1) ) ) - + expect_error( set_carrying_capacity(p, 1, matrix(c(0.1, 0.1), nrow = 2)), "nrow(carrying_capacity_scalers) == length(timesteps) is not TRUE", From a6d9134a8b68f6e7f117ffaf8bdee87752ac50d6 Mon Sep 17 00:00:00 2001 From: Hillary Topazian <80535782+htopazian@users.noreply.github.com> Date: Tue, 21 May 2024 15:28:03 +0100 Subject: [PATCH 4/4] fix test --- tests/testthat/test-vector-control.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-vector-control.R b/tests/testthat/test-vector-control.R index 35c2e317..84c95e88 100644 --- a/tests/testthat/test-vector-control.R +++ b/tests/testthat/test-vector-control.R @@ -201,6 +201,7 @@ test_that('indoor_spraying process sets spray_time correctly', { ms_gamma = matrix(c(-0.009, -0.009), nrow=2, ncol=1) ) spray_time <- mock_double(rep(0, 4)) + renderer <- list(render = mockery::mock()) correlations <- get_correlation_parameters(parameters) process <- indoor_spraying( spray_time,