Rewrite ExpSurvOS to prevent NaNs (#73)

Fixes #72
insightsengineering · Oct 2, 2023 · c7783a2 · c7783a2
1 parent d5dad04
commit c7783a2
Show file tree

Hide file tree

Showing 4 changed files with 10 additions and 1 deletion.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,9 @@
 # simIDM 0.0.5.9011
 
+- ExpSurvOS now returns 0 instead of NaN for large values of t (#73, @holgstr)
+
+# simIDM 0.0.5.9011
+
 - First CRAN version of the package.
 - The package simulates illness-death models with constant, Weibull or piecewise constant transition hazards.
 

diff --git a/R/survivalFunctions.R b/R/survivalFunctions.R
@@ -30,7 +30,7 @@ ExpSurvOS <- function(t, h01, h02, h12) {
   assert_positive_number(h12, zero_ok = TRUE)
 
   h012 <- h12 - h01 - h02
-  ExpSurvPFS(t, h01, h02) / h012 * (h12 - h02 - h01 * exp(-h012 * t))
+  ExpSurvPFS(t, h01, h02) + h01 * h012^-1 * (ExpSurvPFS(t, h01, h02) - exp(-h12 * t))
 }
 
 #' PFS Survival Function from Weibull Transition Hazards

diff --git a/inst/WORDLIST b/inst/WORDLIST
@@ -2,8 +2,10 @@ Beyersmann
 Bove
 CensoredOS
 CensoredPFS
+ExpSurvOS
 Hoffmann
 Meller
+NaN
 OSevent
 OStime
 OStimeCal

diff --git a/tests/testthat/test-survivalFunctions.R b/tests/testthat/test-survivalFunctions.R
@@ -22,6 +22,9 @@ test_that("ExpSurvOS works as expected", {
 
   actual2 <- ExpSurvOS(0, 0.7, 0.5, 0.8)
   expect_equal(actual2, 1)
+
+  actual3 <- ExpSurvOS(1000, 1.2, 1.5, 1.6)
+  expect_equal(actual3, 0)
 })
 
 test_that("ExpSurvOS works also with vector of times t", {