Skip to content

Commit

Permalink
87: Add additional unit tests for survival helper functions (#99)
Browse files Browse the repository at this point in the history
  • Loading branch information
danielinteractive committed Dec 7, 2023
1 parent 1a0c4bc commit 8e92453
Show file tree
Hide file tree
Showing 9 changed files with 58 additions and 43 deletions.
2 changes: 0 additions & 2 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,6 @@ export(ExpSurvPFS)
export(PCWInversionMethod)
export(PWCsurvOS)
export(PWCsurvPFS)
export(WeibOSInteg)
export(WeibSurvOS)
export(WeibSurvPFS)
export(addStaggeredEntry)
Expand Down Expand Up @@ -57,7 +56,6 @@ export(getTarget)
export(getTimePoint)
export(getWaitTimeSum)
export(haz)
export(integrateVector)
export(logRankTest)
export(log_p11)
export(negLogLik)
Expand Down
2 changes: 1 addition & 1 deletion NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
5 changes: 4 additions & 1 deletion R/corPFSOS.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
25 changes: 12 additions & 13 deletions R/survivalFunctions.R
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand All @@ -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))
}

Expand All @@ -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 *
Expand Down
2 changes: 0 additions & 2 deletions _pkgdown.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -67,8 +67,6 @@ reference:
- ExpSurvOS
- ExpQuantOS
- WeibSurvPFS
- integrateVector
- WeibOSInteg
- WeibSurvOS
- pwA
- PWCsurvPFS
Expand Down
4 changes: 1 addition & 3 deletions man/WeibOSInteg.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

5 changes: 4 additions & 1 deletion man/corPFSOS.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

6 changes: 1 addition & 5 deletions man/integrateVector.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

50 changes: 35 additions & 15 deletions tests/testthat/test-survivalFunctions.R
Original file line number Diff line number Diff line change
Expand Up @@ -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", {
Expand Down Expand Up @@ -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", {
Expand Down

0 comments on commit 8e92453

Please sign in to comment.