#169 tests corrected for probability exact calcs

R/simulate_serosurvey.R

@@ -8,7 +8,7 @@
 create_exposure_matrix <- function(ages) {
 
   n_ages <- length(ages)
-  exposure_matrix <- matrix(NA, n_ages, n_ages)
+  exposure_matrix <- matrix(0, n_ages, n_ages)
   exposure_matrix <- lower.tri(exposure_matrix, diag = TRUE)
   exposure_matrix[exposure_matrix==TRUE] <- 1
 
@@ -32,7 +32,7 @@ probability_exact_time_varying <- function(
 
   exposure_matrix <- create_exposure_matrix(ages)
   probabilities <-
-    (fois / (fois + seroreversion_rate)) * (1 - exp(-drop(exposure_matrix %*% (fois + seroreversion_rate))))
+    (fois / (fois + seroreversion_rate)) * (1 - exp(-exposure_matrix %*% (fois + seroreversion_rate)))
   return(probabilities)
 }
 

tests/testthat/test-simulate_serosurvey.R

@@ -1,4 +1,38 @@
 
+test_that("create_exposure_matrix generates correct exposure matrix", {
+
+  # Test with multiple age groups
+  ages <- c(1, 2, 3)
+  expected <- matrix(0, length(ages), length(ages))
+  expected[lower.tri(expected, diag = TRUE)] <- 1
+  expect_equal(create_exposure_matrix(ages), expected)
+})
+
+test_that("probability_exact_time_varying calculates probabilities correctly", {
+  # Test with simple input
+  ages <- c(1, 2, 3)
+  foi <- 0.1
+  fois <- rep(foi, length(ages))
+  probabilities <- probability_exact_time_varying(ages, fois)
+
+  exact_probability_constant <- function(age, foi) {
+    1 - exp(-age * foi)
+  }
+  expected <- purrr::map_dbl(ages, ~exact_probability_constant(., foi))
+  expect_equal(probabilities, expected, tolerance = 1e-6)
+
+  # Test with seroreversion
+  seroreversion_rate <- 0.05
+  probabilities <- probability_exact_time_varying(ages, fois, seroreversion_rate)
+
+  exact_probability_constant_seroreversion <- function(age, foi, seroreversion) {
+    foi / (foi + seroreversion_rate) * (1 - exp(-(foi + seroreversion_rate) * age))
+  }
+  expected <- purrr::map_dbl(ages, ~exact_probability_constant_seroreversion(., foi, seroreversion))
+
+  expect_equal(probabilities, expected, tolerance = 1e-6)
+})
+
 test_that("probability_exact_age_varying calculates probabilities correctly", {
   # Test with simple input
   ages <- c(1, 2, 3)
@@ -17,7 +51,7 @@ test_that("probability_exact_age_varying calculates probabilities correctly", {
   probabilities <- probability_exact_age_varying(ages, fois, seroreversion_rate)
 
   exact_probability_constant_seroreversion <- function(age, foi, seroreversion) {
-    foi / (foi + seroreversion) * (1 - exp(-(foi + seroreversion) * age))
+    foi / (foi + seroreversion_rate) * (1 - exp(-(foi + seroreversion_rate) * age))
   }
   expected <- purrr::map_dbl(ages, ~exact_probability_constant_seroreversion(., foi, seroreversion))