Merge pull request #205 from mrc-ide/dev

Dev

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: malariasimulation
 Title: An individual based model for malaria
-Version: 1.4.1
+Version: 1.4.3
 Authors@R: c(
   person(
     given = "Giovanni",

NEWS.md

@@ -1,3 +1,10 @@
+# malariasimulation 1.4.0
+
+  * Treatment number rendering for all treatments not just effective
+  * Default rendering for drug-based interventions
+  * Bed nets and IRS continue post individual's death
+  * ITN scheduling does not overwrite on receipt of >1 net
+
 # malariasimulation 1.3.0
 
   * Custom demography

R/human_infection.R

@@ -78,7 +78,6 @@ simulate_infection <- function(
     renderer
   )
 
-  renderer$render('n_treated', treated$size(), timestep)
   renderer$render('n_infections', infected_humans$size(), timestep)
 
   schedule_infections(
@@ -276,6 +275,9 @@ calculate_treated <- function(
   renderer$render('ft', ft, timestep)
   seek_treatment <- sample_bitset(clinical_infections, ft)
   n_treat <- seek_treatment$size()
+
+  renderer$render('n_treated', n_treat, timestep)
+
   drugs <- as.numeric(parameters$clinical_treatment_drugs[
     sample.int(
       length(parameters$clinical_treatment_drugs),

R/mda_processes.R

@@ -25,6 +25,7 @@ create_mda_listeners <- function(
   parameters,
   renderer
   ) {
+  renderer$set_default(paste0('n_', int_name, '_treated'), 0)
   function(timestep) {
     time_index = which(timesteps == timestep)
     coverage <- coverages[[time_index]]
@@ -33,15 +34,15 @@ create_mda_listeners <- function(
     in_age <- which((age > min_ages[[time_index]]) & (age < max_ages[[time_index]]))
     target <- in_age[sample_intervention(in_age, int_name, coverage, correlations)]
 
+    renderer$render(paste0('n_', int_name, '_treated'), length(target), timestep)
+
     successful_treatments <- bernoulli(
       length(target),
       parameters$drug_efficacy[[drug]]
     )
     to_move <- individual::Bitset$new(parameters$human_population)
     to_move$insert(target[successful_treatments])
 
-    renderer$render('n_mda_treated', to_move$size(), timestep)
-
     if (to_move$size() > 0) {
       # Move Diseased
       diseased <- variables$state$get_index_of(c('D', 'A'))$and(to_move)

R/mortality_processes.R

@@ -78,7 +78,6 @@ reset_target <- function(variables, events, target, state, timestep) {
   if (target$size() > 0) {
     # clear events
     to_clear <- c(
-      'throw_away_net',
       'rtss_mass_doses',
       'rtss_mass_booster',
       'rtss_epi_doses',
@@ -114,9 +113,6 @@ reset_target <- function(variables, events, target, state, timestep) {
     # onwards infectiousness
     variables$infectivity$queue_update(0, target)
 
-    # vector control
-    variables$net_time$queue_update(-1, target)
-    variables$spray_time$queue_update(-1, target)
-    # zeta and zeta group survive rebirth
+    # zeta and zeta group and vector controls survive rebirth
   }
 }

R/pmc.R

@@ -21,7 +21,8 @@ create_pmc_process <- function(
     coverages,
     timesteps,
     drug
-) {
+){
+  renderer$set_default('n_pmc_treated', 0)
   function(timestep) {
     timestep_index <- match_timestep(ts = timesteps, t = timestep)
     if(timestep_index == 0){
@@ -37,13 +38,14 @@ create_pmc_process <- function(
     in_age <- which(age %in% parameters$pmc_ages)
     target <- in_age[sample_intervention(in_age, 'pmc', coverage, correlations)]
 
+    renderer$render('n_pmc_treated', length(target), timestep)
+
     successful_treatments <- bernoulli(
       length(target),
       parameters$drug_efficacy[[drug]]
     )
     to_move <- individual::Bitset$new(parameters$human_population)
     to_move$insert(target[successful_treatments])
-    renderer$render('n_pmc_treated', to_move$size(), timestep)
 
     if (to_move$size() > 0) {
       # Move Diseased

R/vector_control.R

@@ -141,6 +141,7 @@ distribute_nets <- function(variables, throw_away_net, parameters, correlations)
         correlations
       ))
       variables$net_time$queue_update(timestep, target)
+      throw_away_net$clear_schedule(target)
       throw_away_net$schedule(
         target,
         log_uniform(length(target), parameters$bednet_retention)

tests/testthat/test-mortality-integration.R

@@ -26,6 +26,8 @@ test_that('mortality_process resets humans correctly', {
   variables$ivm <- mock_double(c(1, 2, 3, 4))
   variables$ica <- mock_double(c(1, 2, 3, 4))
   variables$iva <- mock_double(c(1, 2, 3, 4))
+  variables$net_time <- mock_integer(c(1, 2, 3, 4))
+  variables$spray_time <- mock_integer(c(1, 2, 3, 4))
   renderer <- individual::Render$new(timestep)
 
   mortality_process <- create_mortality_process(
@@ -44,6 +46,10 @@ test_that('mortality_process resets humans correctly', {
   mortality_process(timestep)
 
   expect_bitset_update(variables$state$queue_update_mock(), 'S', c(2, 4))
+
+  # vector controls are not touched
+  mockery::expect_called(variables$net_time$queue_update_mock(), 0)
+  mockery::expect_called(variables$spray_time$queue_update_mock(), 0)
 })
 
 test_that('mortality_process samples deaths from a custom demography', {

tests/testthat/test-pmc.R

@@ -72,7 +72,7 @@ test_that("pmc gives drugs to correct ages", {
   # Three treatments given
   expect_equal(renderer$to_dataframe(),
                data.frame(timestep = 1:10,
-                          n_pmc_treated = c(rep(NA, 9), 3)))
+                          n_pmc_treated = c(rep(0, 9), 3)))
 
   # Individuals 3 and 5, are correct age and in D or A states
   expect_bitset_update(

tests/testthat/test-vector-control.R

@@ -122,6 +122,7 @@ test_that('distribute_bednets process sets net_time correctly', {
     50,
     c(3, 4)
   )
+  mockery::expect_called(events$throw_away_net$clear_schedule, 1)
   mockery::expect_args(
     events$throw_away_net$schedule,
     1,