87: Add additional unit tests for survival helper functions

NAMESPACE

@@ -24,7 +24,6 @@ export(ExpSurvPFS)
 export(PCWInversionMethod)
 export(PWCsurvOS)
 export(PWCsurvPFS)
-export(WeibOSInteg)
 export(WeibSurvOS)
 export(WeibSurvPFS)
 export(addStaggeredEntry)
@@ -57,7 +56,6 @@ export(getTarget)
 export(getTimePoint)
 export(getWaitTimeSum)
 export(haz)
-export(integrateVector)
 export(logRankTest)
 export(log_p11)
 export(negLogLik)

NEWS.md

@@ -16,7 +16,7 @@
 ### Miscellaneous
 
 -   Renamed piecewise constant hazards function to `getPWCHazard` (previously `getPCWHazard`).
--   `PwcOSInt` is no longer exported, and only used for internal tests.
+-   `PwcOSInt`, `integrateVector`, `WeibOSInteg` are no longer exported, and only used internally.
 
 # simIDM 0.0.5
 

R/corPFSOS.R

@@ -301,7 +301,10 @@ corTrans <- function(transition) {
 #'   transitionByArm = list(transition), dropout = list(rate = 0.5, time = 12),
 #'   accrual = list(param = "intensity", value = 7)
 #' )[[1]]
-#' corPFSOS(data, transition = exponential_transition())
+#' corPFSOS(data, transition = exponential_transition(), bootstrap = FALSE)
+#' \dontrun{
+#' corPFSOS(data, transition = exponential_transition(), bootstrap = TRUE)
+#' }
 corPFSOS <- function(data, transition, bootstrap = TRUE, bootstrap_n = 100, conf_level = 0.95) {
   assert_data_frame(data)
   assert_flag(bootstrap)

R/survivalFunctions.R

@@ -59,12 +59,7 @@ WeibSurvPFS <- function(t, h01, h02, p01, p02) {
 #' @param ...  additional arguments to be passed to `integrand`.
 #'
 #' @return This function returns for each upper limit the estimates of the integral.
-#' @export
-#'
-#' @examples
-#' integrand <- function(x) x^2
-#' upper <- c(0, 1, 0.4, 2, 5, 2, 0.3, 0.4, 1)
-#' integrateVector(integrand, upper = upper)
+#' @keywords internal
 integrateVector <- function(integrand, upper, ...) {
   assert_true(all(upper >= 0))
   boundaries <- sort(unique(upper))
@@ -86,11 +81,19 @@ integrateVector <- function(integrand, upper, ...) {
 #'
 #' @return Numeric results of the integrand used to calculate
 #' the OS survival function for Weibull transition hazards, see  `WeibSurvOS()`.
-#' @export
 #'
-#' @examples
-#' WeibOSInteg(1:5, 2:6, 0.2, 0.5, 2.1, 1.2, 0.9, 1)
+#' @keywords internal
 WeibOSInteg <- function(x, t, h01, h02, h12, p01, p02, p12) {
+  assert_numeric(x, finite = TRUE, any.missing = FALSE)
+  assert_numeric(t, finite = TRUE, any.missing = FALSE)
+  assert_true(test_scalar(x) || identical(length(x), length(t)) || test_scalar(t))
+  assert_positive_number(h01, zero_ok = TRUE)
+  assert_positive_number(h02, zero_ok = TRUE)
+  assert_positive_number(h12, zero_ok = TRUE)
+  assert_positive_number(p01)
+  assert_positive_number(p02)
+  assert_positive_number(p12)
+
   x^(p01 - 1) * exp(-h01 * x^p01 - h02 * x^p02 - h12 * (t^p12 - x^p12))
 }
 
@@ -111,11 +114,7 @@ WeibOSInteg <- function(x, t, h01, h02, h12, p01, p02, p12) {
 WeibSurvOS <- function(t, h01, h02, h12, p01, p02, p12) {
   assert_numeric(t, lower = 0, any.missing = FALSE)
   assert_positive_number(h01, zero_ok = TRUE)
-  assert_positive_number(h02, zero_ok = TRUE)
-  assert_positive_number(h12, zero_ok = TRUE)
   assert_positive_number(p01)
-  assert_positive_number(p02)
-  assert_positive_number(p12)
 
   WeibSurvPFS(t, h01, h02, p01, p02) +
     h01 * p01 *

_pkgdown.yaml

@@ -67,8 +67,6 @@ reference:
       - ExpSurvOS
       - ExpQuantOS
       - WeibSurvPFS
-      - integrateVector
-      - WeibOSInteg
       - WeibSurvOS
       - pwA
       - PWCsurvPFS

tests/testthat/test-survivalFunctions.R

@@ -43,6 +43,41 @@ test_that("WeibSurvPFS works as expected", {
   expect_equal(actual2, 1)
 })
 
+# integrateVector ----
+
+test_that("integrateVector works as expected", {
+  integrand <- function(x) x^2
+  upper <- c(1, 0.4, 1)
+
+  actual <- integrateVector(integrand, upper = upper)
+  expected <- c(
+    integrate(integrand, 0, 1)$value,
+    integrate(integrand, 0, 0.4)$value,
+    integrate(integrand, 0, 1)$value
+  )
+  expect_equal(actual, expected)
+})
+
+# WeibOSInteg ----
+
+test_that("WeibOSInteg works as expected with scalar x", {
+  result <- expect_silent(WeibOSInteg(4, 2:6, 0.2, 0.5, 2.1, 1.2, 0.9, 1))
+  expected <- c(5.368515, 0.657409, 0.080504, 0.009858, 0.001207)
+  expect_equal(result, expected, tolerance = 1e-4)
+})
+
+test_that("WeibOSInteg works as expected with vector x", {
+  result <- expect_silent(WeibOSInteg(1:5, 2:6, 0.2, 0.5, 2.1, 1.2, 0.9, 1))
+  expected <- c(0.06081, 0.034948, 0.018842, 0.009858, 0.005061)
+  expect_equal(result, expected, tolerance = 1e-4)
+})
+
+test_that("WeibOSInteg works as expected with scalar t", {
+  result <- expect_silent(WeibOSInteg(2:6, 4, 0.2, 0.5, 2.1, 1.2, 0.9, 1))
+  expected <- c(0.00428, 0.018842, 0.080504, 0.337499, 1.395583)
+  expect_equal(result, expected, tolerance = 1e-4)
+})
+
 # WeibSurvOS ----
 
 test_that("WeibSurvOS works as expected", {
@@ -144,21 +179,6 @@ test_that("PwcOSInt works as expected", {
   expect_equal(actual3, 0, tolerance = 1e-6)
 })
 
-# integrateVector ----
-
-test_that("integrateVector works as expected", {
-  integrand <- function(x) x^2
-  upper <- c(1, 0.4, 1)
-
-  actual <- integrateVector(integrand, upper = upper)
-  expected <- c(
-    integrate(integrand, 0, 1)$value,
-    integrate(integrand, 0, 0.4)$value,
-    integrate(integrand, 0, 1)$value
-  )
-  expect_equal(actual, expected)
-})
-
 # singleExpQuantOS ----
 
 test_that("singleExpQuantOS works as expected", {