From 8e924531095ecf76a3b9911610f5a35e78d94ebf Mon Sep 17 00:00:00 2001 From: Daniel Sabanes Bove Date: Thu, 7 Dec 2023 20:56:47 +0100 Subject: [PATCH] 87: Add additional unit tests for survival helper functions (#99) --- NAMESPACE | 2 - NEWS.md | 2 +- R/corPFSOS.R | 5 ++- R/survivalFunctions.R | 25 ++++++------- _pkgdown.yaml | 2 - man/WeibOSInteg.Rd | 4 +- man/corPFSOS.Rd | 5 ++- man/integrateVector.Rd | 6 +-- tests/testthat/test-survivalFunctions.R | 50 +++++++++++++++++-------- 9 files changed, 58 insertions(+), 43 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index a6a6da85..2c6e0553 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index 229aba29..9691e2e8 100644 --- a/NEWS.md +++ b/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 diff --git a/R/corPFSOS.R b/R/corPFSOS.R index 44d1b5d3..25e16974 100644 --- a/R/corPFSOS.R +++ b/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) diff --git a/R/survivalFunctions.R b/R/survivalFunctions.R index 19208c83..09b3118d 100644 --- a/R/survivalFunctions.R +++ b/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 * diff --git a/_pkgdown.yaml b/_pkgdown.yaml index 0b5b67d9..1bbfb2fc 100644 --- a/_pkgdown.yaml +++ b/_pkgdown.yaml @@ -67,8 +67,6 @@ reference: - ExpSurvOS - ExpQuantOS - WeibSurvPFS - - integrateVector - - WeibOSInteg - WeibSurvOS - pwA - PWCsurvPFS diff --git a/man/WeibOSInteg.Rd b/man/WeibOSInteg.Rd index 75568184..1db94eab 100644 --- a/man/WeibOSInteg.Rd +++ b/man/WeibOSInteg.Rd @@ -30,6 +30,4 @@ the OS survival function for Weibull transition hazards, see \code{WeibSurvOS() \description{ Helper Function for \code{WeibSurvOS()} } -\examples{ -WeibOSInteg(1:5, 2:6, 0.2, 0.5, 2.1, 1.2, 0.9, 1) -} +\keyword{internal} diff --git a/man/corPFSOS.Rd b/man/corPFSOS.Rd index 7b746348..6b738ae5 100644 --- a/man/corPFSOS.Rd +++ b/man/corPFSOS.Rd @@ -38,5 +38,8 @@ data <- getClinicalTrials( 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) +} } diff --git a/man/integrateVector.Rd b/man/integrateVector.Rd index 486867bd..d3956800 100644 --- a/man/integrateVector.Rd +++ b/man/integrateVector.Rd @@ -19,8 +19,4 @@ This function returns for each upper limit the estimates of the integral. \description{ Helper for Efficient Integration } -\examples{ -integrand <- function(x) x^2 -upper <- c(0, 1, 0.4, 2, 5, 2, 0.3, 0.4, 1) -integrateVector(integrand, upper = upper) -} +\keyword{internal} diff --git a/tests/testthat/test-survivalFunctions.R b/tests/testthat/test-survivalFunctions.R index dff63912..e4e998c3 100644 --- a/tests/testthat/test-survivalFunctions.R +++ b/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", {