Fix WeibSurvOS (#80)

<!--- Replace `#nnn` with your issue link for reference. -->

Fixes #78

---------

Signed-off-by: Daniel Sabanes Bove <danielinteractive@users.noreply.github.com>
Co-authored-by: Daniel Sabanes Bove <danielinteractive@users.noreply.github.com>

NEWS.md

@@ -3,6 +3,7 @@
 ### Bug Fixes
 
 - `ExpSurvOS` now returns 0 instead of NaN for large values of t.
+- `WeibSurvOS` now does not return an error for large values of t.
 - `getSimulatedData` now also works when there are no transitions from progression to death, similarly for `getOneClinicalTrial` (which now warns if there are no such transitions at all).
 
 

R/survivalFunctions.R

@@ -89,9 +89,9 @@ integrateVector <- function(integrand, upper, ...) {
 #' @export
 #'
 #' @examples
-#' WeibOSInteg(1:5, 0.2, 0.5, 2.1, 1.2, 0.9, 1)
-WeibOSInteg <- function(x, h01, h02, h12, p01, p02, p12) {
-  x^(p01 - 1) * exp(-h01 * x^p01 - h02 * x^p02 + h12 * x^p12)
+#' WeibOSInteg(1:5, 2:6, 0.2, 0.5, 2.1, 1.2, 0.9, 1)
+WeibOSInteg <- function(x, t, h01, h02, h12, p01, p02, p12) {
+  x^(p01 - 1) * exp(-h01 * x^p01 - h02 * x^p02 - h12 * (t^p12 - x^p12))
 }
 
 #' OS Survival Function from Weibull Transition Hazards
@@ -118,14 +118,21 @@ WeibSurvOS <- function(t, h01, h02, h12, p01, p02, p12) {
   assert_positive_number(p12)
 
   WeibSurvPFS(t, h01, h02, p01, p02) +
-    h01 * p01 * exp(-h12 * t^p12) *
-      integrateVector(WeibOSInteg,
-        upper = t,
-        h01 = h01, h02 = h02, h12 = h12, p01 = p01, p02 = p02, p12 = p12
-      )
+    h01 * p01 *
+      sapply(t, function(t) {
+        integrateVector(WeibOSInteg,
+          upper = t,
+          t = t,
+          h01 = h01,
+          h02 = h02,
+          h12 = h12,
+          p01 = p01,
+          p02 = p02,
+          p12 = p12
+        )
+      })
 }
 
-
 #' Cumulative Hazard for Piecewise Constant Hazards
 #'
 #' @param t (`numeric`)\cr  study time-points.

tests/testthat/test-survivalFunctions.R

@@ -51,6 +51,9 @@ test_that("WeibSurvOS works as expected", {
 
   actual2 <- WeibSurvOS(0, 0.7, 0.5, 0.8, 1.2, 1, 0.9)
   expect_equal(actual2, 1)
+
+  actual3 <- WeibSurvOS(1000, 1, 1.1, 1.2, 1.3, 0.8, 1.4)
+  expect_equal(actual3, 0)
 })
 
 # pwA ----