Bug/spraying

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)

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)
     )
   }
 

R/vector_control.R

@@ -102,10 +102,12 @@ 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
-indoor_spraying <- function(spray_time, parameters, correlations) {
+indoor_spraying <- function(spray_time, renderer, parameters, correlations) {
+  renderer$set_default('n_spray', 0)
   function(timestep) {
     matches <- timestep == parameters$spraying_timesteps
     if (any(matches)) {
@@ -116,6 +118,7 @@ indoor_spraying <- function(spray_time, parameters, correlations) {
         correlations
       ))
       spray_time$queue_update(timestep, target)
+      renderer$render('n_spray', length(target), timestep)
     }
   }
 }

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,
@@ -201,18 +201,20 @@ 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,
+    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 +230,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 +259,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 +286,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 +334,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 +348,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 +367,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 +377,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",