From 7166cba8e54dd77db84bc0cef8d8b18ffb6df578 Mon Sep 17 00:00:00 2001 From: RJSheppard Date: Tue, 15 Oct 2024 12:15:32 +0100 Subject: [PATCH] Removed code redundancies. Adjusted extra arguments inputted into competing hazards object and reverting to previous competing hazard tests. --- R/competing_hazards.R | 2 +- R/human_infection.R | 5 +--- R/processes.R | 8 +++--- tests/testthat/test-competing-hazards.R | 38 ++++++++++--------------- 4 files changed, 21 insertions(+), 32 deletions(-) diff --git a/R/competing_hazards.R b/R/competing_hazards.R index 0ef30e0d..ea7ffd97 100644 --- a/R/competing_hazards.R +++ b/R/competing_hazards.R @@ -25,7 +25,7 @@ CompetingOutcome <- R6::R6Class( self$args <- list(...) }, execute = function(t, target){ - do.call(private$targeted_process, list(t, target, self$args)) + do.call(private$targeted_process, c(t, list(target), self$args)) }, reset = function() { self$target$clear() diff --git a/R/human_infection.R b/R/human_infection.R index c779efc7..36aa7b2a 100644 --- a/R/human_infection.R +++ b/R/human_infection.R @@ -181,9 +181,6 @@ calculate_vivax_infections <- function( infection_rates[hyp_source_index] <- infection_rates[hyp_source_index] + relapse_rates # Get and store relative rates for bite/relapse competing hazards resolution relative_rates <- relapse_rates/infection_rates[hyp_source_index] - # infection_outcome$set_relative_rates( - # hypnozoites_humans, - # relative_rates) } prob <- rate_to_prob(infection_rates) * (1 - prophylaxis) * (1 - vaccine_efficacy) @@ -944,7 +941,7 @@ severe_immunity <- function(age, acquired_immunity, maternal_immunity, parameter parameters$theta0 * (parameters$theta1 + (1 - parameters$theta1) / ( 1 + fv * ( (acquired_immunity + maternal_immunity) / parameters$iv0) ** parameters$kv - ) + ) ) } diff --git a/R/processes.R b/R/processes.R index 6ac4f290..3048ba6e 100644 --- a/R/processes.R +++ b/R/processes.R @@ -96,7 +96,7 @@ create_processes <- function( if(parameters$parasite == "falciparum"){ infection_outcome <- CompetingOutcome$new( - targeted_process = function(timestep, target, args){ + targeted_process = function(timestep, target){ falciparum_infection_outcome_process(timestep, target, variables, renderer, parameters ) @@ -106,10 +106,10 @@ create_processes <- function( } else if (parameters$parasite == "vivax"){ infection_outcome <- CompetingOutcome$new( - targeted_process = function(timestep, target, args){ + targeted_process = function(timestep, target, relative_rates){ vivax_infection_outcome_process(timestep, target, variables, renderer, parameters, - args$relative_rates + relative_rates ) }, size = parameters$human_population @@ -117,7 +117,7 @@ create_processes <- function( } progression_outcome <- CompetingOutcome$new( - targeted_process = function(timestep, target, ...){ + targeted_process = function(timestep, target){ progression_outcome_process(timestep, target, variables, parameters, renderer) }, size = parameters$human_population diff --git a/tests/testthat/test-competing-hazards.R b/tests/testthat/test-competing-hazards.R index fc817499..21ddefcb 100644 --- a/tests/testthat/test-competing-hazards.R +++ b/tests/testthat/test-competing-hazards.R @@ -26,14 +26,15 @@ test_that("hazard resolves two disjoint outcomes", { outcome_1$set_rates(population, c(10, 0, 10, 0)) outcome_2$set_rates(population, c(0, 10, 0, 10)) - + hazard$resolve(0) + mockery::expect_args(outcome_1_process, 1, 0, - individual::Bitset$new(size)$insert(c(1, 3)), - list()) + individual::Bitset$new(size)$insert(c(1, 3))) + mockery::expect_args(outcome_2_process, 1, 0, - individual::Bitset$new(size)$insert(c(2, 4)), - list()) + individual::Bitset$new(size)$insert(c(2, 4))) + }) test_that("hazard resolves two competing outcomes", { @@ -63,11 +64,9 @@ test_that("hazard resolves two competing outcomes", { hazard$resolve(0) mockery::expect_args(outcome_1_process, 1, 0, - individual::Bitset$new(size)$insert(c(2, 3)), - list()) + individual::Bitset$new(size)$insert(c(2, 3))) mockery::expect_args(outcome_2_process, 1, 0, - individual::Bitset$new(size)$insert(c(1, 4)), - list()) + individual::Bitset$new(size)$insert(c(1, 4))) }) test_that("hazard may resolve to neither outcome", { @@ -97,11 +96,9 @@ test_that("hazard may resolve to neither outcome", { hazard$resolve(0) mockery::expect_args(outcome_1_process, 1, 0, - individual::Bitset$new(size)$insert(c(3)), - list()) + individual::Bitset$new(size)$insert(c(3))) mockery::expect_args(outcome_2_process, 1, 0, - individual::Bitset$new(size)$insert(c(2, 4)), - list()) + individual::Bitset$new(size)$insert(c(2, 4))) }) test_that("outcomes can define a partial set of rates", { @@ -133,11 +130,9 @@ test_that("outcomes can define a partial set of rates", { hazard$resolve(0) mockery::expect_args(outcome_1_process, 1, 0, - individual::Bitset$new(size)$insert(c(1, 3)), - list()) + individual::Bitset$new(size)$insert(c(1, 3))) mockery::expect_args(outcome_2_process, 1, 0, - individual::Bitset$new(size)$insert(c(4)), - list()) + individual::Bitset$new(size)$insert(c(4))) }) test_that("hazard resolves three competing outcomes", { @@ -173,12 +168,9 @@ test_that("hazard resolves three competing outcomes", { hazard$resolve(0) mockery::expect_args(outcome_1_process, 1, 0, - individual::Bitset$new(size)$insert(c(1)), - list()) + individual::Bitset$new(size)$insert(c(1))) mockery::expect_args(outcome_2_process, 1, 0, - individual::Bitset$new(size)$insert(c(2)), - list()) + individual::Bitset$new(size)$insert(c(2))) mockery::expect_args(outcome_3_process, 1, 0, - individual::Bitset$new(size)$insert(c(3, 4)), - list()) + individual::Bitset$new(size)$insert(c(3, 4))) })