From b339b7a66b1ffc472511e9ad0381d0651a0d250c Mon Sep 17 00:00:00 2001
From: Paul Lietar <pl2113@ic.ac.uk>
Date: Fri, 12 Jul 2024 13:45:58 +0100
Subject: [PATCH] Add tests

---
 tests/testthat/test-competing-hazards.R | 124 +++++++++++++++++-------
 1 file changed, 88 insertions(+), 36 deletions(-)

diff --git a/tests/testthat/test-competing-hazards.R b/tests/testthat/test-competing-hazards.R
index 8d12a176..f7ada3fc 100644
--- a/tests/testthat/test-competing-hazards.R
+++ b/tests/testthat/test-competing-hazards.R
@@ -29,18 +29,10 @@ test_that("hazard resolves two disjoint outcomes", {
   
   hazard$resolve(0)
    
-  mockery::expect_args(
-   outcome_1_process,
-    1,
-    0,
-    individual::Bitset$new(size)$insert(c(1, 3))
-  )
-  mockery::expect_args(
-    outcome_2_process,
-    1,
-    0,
-    individual::Bitset$new(size)$insert(c(2, 4))
-  )
+  mockery::expect_args(outcome_1_process, 1, 0,
+                       individual::Bitset$new(size)$insert(c(1, 3)))
+  mockery::expect_args(outcome_2_process, 1, 0,
+                       individual::Bitset$new(size)$insert(c(2, 4)))
 })
 
 test_that("hazard resolves two competing outcomes", {
@@ -69,21 +61,13 @@ 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))
-  )
-  mockery::expect_args(
-    outcome_2_process,
-    1,
-    0,
-    individual::Bitset$new(size)$insert(c(1, 4))
-  )
+  mockery::expect_args(outcome_1_process, 1, 0,
+                       individual::Bitset$new(size)$insert(c(2, 3)))
+  mockery::expect_args(outcome_2_process, 1, 0,
+                       individual::Bitset$new(size)$insert(c(1, 4)))
 })
 
-test_that("hazard resolves partial outcomes", {
+test_that("hazard may resolve to neither outcome", {
   size <- 4
   population <- individual::Bitset$new(size)$not()
 
@@ -109,16 +93,84 @@ test_that("hazard resolves partial outcomes", {
   
   hazard$resolve(0)
    
-  mockery::expect_args(
-   outcome_1_process,
-    1,
-    0,
-    individual::Bitset$new(size)$insert(c(3))
-  )
-  mockery::expect_args(
-    outcome_2_process,
-    1,
-    0,
-    individual::Bitset$new(size)$insert(c(2, 4))
+  mockery::expect_args(outcome_1_process, 1, 0,
+                       individual::Bitset$new(size)$insert(c(3)))
+  mockery::expect_args(outcome_2_process, 1, 0,
+                       individual::Bitset$new(size)$insert(c(2, 4)))
+})
+
+test_that("outcomes can define a partial set of rates", {
+  size <- 4
+  population <- individual::Bitset$new(size)$not()
+
+  outcome_1_process <- mockery::mock()
+  outcome_1 <- CompetingOutcome$new(
+    targeted_process = outcome_1_process,
+    size = size
+  )
+  outcome_2_process <- mockery::mock()
+  outcome_2 <- CompetingOutcome$new(
+    targeted_process = outcome_2_process,
+    size = size
+  )
+
+  hazard <- CompetingHazard$new(
+    size = size,
+    outcomes = list(outcome_1, outcome_2),
+
+    # Only individuals 1, 3 and 4 get sampled
+    rng = mockery::mock(c(.2, .3, .6))
+  )
+  
+  outcome_1$set_rates(individual::Bitset$new(size)$insert(c(1,3)), c(5, 5))
+  outcome_2$set_rates(individual::Bitset$new(size)$insert(c(1,4)), c(5, 5))
+  
+  hazard$resolve(0)
+   
+  mockery::expect_args(outcome_1_process, 1, 0,
+                       individual::Bitset$new(size)$insert(c(1, 3)))
+  mockery::expect_args(outcome_2_process, 1, 0,
+                       individual::Bitset$new(size)$insert(c(4))
   )
 })
+
+test_that("hazard resolves three competing outcomes", {
+  size <- 4
+  population <- individual::Bitset$new(size)$not()
+
+  outcome_1_process <- mockery::mock()
+  outcome_1 <- CompetingOutcome$new(
+    targeted_process = outcome_1_process,
+    size = size
+  )
+  outcome_2_process <- mockery::mock()
+  outcome_2 <- CompetingOutcome$new(
+    targeted_process = outcome_2_process,
+    size = size
+  )
+  outcome_3_process <- mockery::mock()
+  outcome_3 <- CompetingOutcome$new(
+    targeted_process = outcome_3_process,
+    size = size
+  )
+
+  hazard <- CompetingHazard$new(
+    size = size,
+    outcomes = list(outcome_1, outcome_2, outcome_3),
+    rng = mockery::mock(c(.1, .5, .8, .8))
+  )
+  
+  outcome_1$set_rates(population, c(5, 5, 5, 5))
+  outcome_2$set_rates(population, c(5, 5, 5, 5))
+  outcome_3$set_rates(population, c(5, 5, 5, 5))
+  
+  hazard$resolve(0)
+   
+  mockery::expect_args(outcome_1_process, 1, 0,
+                       individual::Bitset$new(size)$insert(c(1)))
+  mockery::expect_args(outcome_2_process, 1, 0,
+                       individual::Bitset$new(size)$insert(c(2)))
+  mockery::expect_args(outcome_3_process, 1, 0,
+                       individual::Bitset$new(size)$insert(c(3, 4)))
+})
+