Skip to content

Commit 8e92453

Browse files
87: Add additional unit tests for survival helper functions (#99)
1 parent 1a0c4bc commit 8e92453

File tree

9 files changed

+58
-43
lines changed

9 files changed

+58
-43
lines changed

NAMESPACE

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,6 @@ export(ExpSurvPFS)
2424
export(PCWInversionMethod)
2525
export(PWCsurvOS)
2626
export(PWCsurvPFS)
27-
export(WeibOSInteg)
2827
export(WeibSurvOS)
2928
export(WeibSurvPFS)
3029
export(addStaggeredEntry)
@@ -57,7 +56,6 @@ export(getTarget)
5756
export(getTimePoint)
5857
export(getWaitTimeSum)
5958
export(haz)
60-
export(integrateVector)
6159
export(logRankTest)
6260
export(log_p11)
6361
export(negLogLik)

NEWS.md

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@
1616
### Miscellaneous
1717

1818
- Renamed piecewise constant hazards function to `getPWCHazard` (previously `getPCWHazard`).
19-
- `PwcOSInt` is no longer exported, and only used for internal tests.
19+
- `PwcOSInt`, `integrateVector`, `WeibOSInteg` are no longer exported, and only used internally.
2020

2121
# simIDM 0.0.5
2222

R/corPFSOS.R

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -301,7 +301,10 @@ corTrans <- function(transition) {
301301
#' transitionByArm = list(transition), dropout = list(rate = 0.5, time = 12),
302302
#' accrual = list(param = "intensity", value = 7)
303303
#' )[[1]]
304-
#' corPFSOS(data, transition = exponential_transition())
304+
#' corPFSOS(data, transition = exponential_transition(), bootstrap = FALSE)
305+
#' \dontrun{
306+
#' corPFSOS(data, transition = exponential_transition(), bootstrap = TRUE)
307+
#' }
305308
corPFSOS <- function(data, transition, bootstrap = TRUE, bootstrap_n = 100, conf_level = 0.95) {
306309
assert_data_frame(data)
307310
assert_flag(bootstrap)

R/survivalFunctions.R

Lines changed: 12 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -59,12 +59,7 @@ WeibSurvPFS <- function(t, h01, h02, p01, p02) {
5959
#' @param ... additional arguments to be passed to `integrand`.
6060
#'
6161
#' @return This function returns for each upper limit the estimates of the integral.
62-
#' @export
63-
#'
64-
#' @examples
65-
#' integrand <- function(x) x^2
66-
#' upper <- c(0, 1, 0.4, 2, 5, 2, 0.3, 0.4, 1)
67-
#' integrateVector(integrand, upper = upper)
62+
#' @keywords internal
6863
integrateVector <- function(integrand, upper, ...) {
6964
assert_true(all(upper >= 0))
7065
boundaries <- sort(unique(upper))
@@ -86,11 +81,19 @@ integrateVector <- function(integrand, upper, ...) {
8681
#'
8782
#' @return Numeric results of the integrand used to calculate
8883
#' the OS survival function for Weibull transition hazards, see `WeibSurvOS()`.
89-
#' @export
9084
#'
91-
#' @examples
92-
#' WeibOSInteg(1:5, 2:6, 0.2, 0.5, 2.1, 1.2, 0.9, 1)
85+
#' @keywords internal
9386
WeibOSInteg <- function(x, t, h01, h02, h12, p01, p02, p12) {
87+
assert_numeric(x, finite = TRUE, any.missing = FALSE)
88+
assert_numeric(t, finite = TRUE, any.missing = FALSE)
89+
assert_true(test_scalar(x) || identical(length(x), length(t)) || test_scalar(t))
90+
assert_positive_number(h01, zero_ok = TRUE)
91+
assert_positive_number(h02, zero_ok = TRUE)
92+
assert_positive_number(h12, zero_ok = TRUE)
93+
assert_positive_number(p01)
94+
assert_positive_number(p02)
95+
assert_positive_number(p12)
96+
9497
x^(p01 - 1) * exp(-h01 * x^p01 - h02 * x^p02 - h12 * (t^p12 - x^p12))
9598
}
9699

@@ -111,11 +114,7 @@ WeibOSInteg <- function(x, t, h01, h02, h12, p01, p02, p12) {
111114
WeibSurvOS <- function(t, h01, h02, h12, p01, p02, p12) {
112115
assert_numeric(t, lower = 0, any.missing = FALSE)
113116
assert_positive_number(h01, zero_ok = TRUE)
114-
assert_positive_number(h02, zero_ok = TRUE)
115-
assert_positive_number(h12, zero_ok = TRUE)
116117
assert_positive_number(p01)
117-
assert_positive_number(p02)
118-
assert_positive_number(p12)
119118

120119
WeibSurvPFS(t, h01, h02, p01, p02) +
121120
h01 * p01 *

_pkgdown.yaml

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -67,8 +67,6 @@ reference:
6767
- ExpSurvOS
6868
- ExpQuantOS
6969
- WeibSurvPFS
70-
- integrateVector
71-
- WeibOSInteg
7270
- WeibSurvOS
7371
- pwA
7472
- PWCsurvPFS

man/WeibOSInteg.Rd

Lines changed: 1 addition & 3 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

man/corPFSOS.Rd

Lines changed: 4 additions & 1 deletion
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

man/integrateVector.Rd

Lines changed: 1 addition & 5 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

tests/testthat/test-survivalFunctions.R

Lines changed: 35 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,41 @@ test_that("WeibSurvPFS works as expected", {
4343
expect_equal(actual2, 1)
4444
})
4545

46+
# integrateVector ----
47+
48+
test_that("integrateVector works as expected", {
49+
integrand <- function(x) x^2
50+
upper <- c(1, 0.4, 1)
51+
52+
actual <- integrateVector(integrand, upper = upper)
53+
expected <- c(
54+
integrate(integrand, 0, 1)$value,
55+
integrate(integrand, 0, 0.4)$value,
56+
integrate(integrand, 0, 1)$value
57+
)
58+
expect_equal(actual, expected)
59+
})
60+
61+
# WeibOSInteg ----
62+
63+
test_that("WeibOSInteg works as expected with scalar x", {
64+
result <- expect_silent(WeibOSInteg(4, 2:6, 0.2, 0.5, 2.1, 1.2, 0.9, 1))
65+
expected <- c(5.368515, 0.657409, 0.080504, 0.009858, 0.001207)
66+
expect_equal(result, expected, tolerance = 1e-4)
67+
})
68+
69+
test_that("WeibOSInteg works as expected with vector x", {
70+
result <- expect_silent(WeibOSInteg(1:5, 2:6, 0.2, 0.5, 2.1, 1.2, 0.9, 1))
71+
expected <- c(0.06081, 0.034948, 0.018842, 0.009858, 0.005061)
72+
expect_equal(result, expected, tolerance = 1e-4)
73+
})
74+
75+
test_that("WeibOSInteg works as expected with scalar t", {
76+
result <- expect_silent(WeibOSInteg(2:6, 4, 0.2, 0.5, 2.1, 1.2, 0.9, 1))
77+
expected <- c(0.00428, 0.018842, 0.080504, 0.337499, 1.395583)
78+
expect_equal(result, expected, tolerance = 1e-4)
79+
})
80+
4681
# WeibSurvOS ----
4782

4883
test_that("WeibSurvOS works as expected", {
@@ -144,21 +179,6 @@ test_that("PwcOSInt works as expected", {
144179
expect_equal(actual3, 0, tolerance = 1e-6)
145180
})
146181

147-
# integrateVector ----
148-
149-
test_that("integrateVector works as expected", {
150-
integrand <- function(x) x^2
151-
upper <- c(1, 0.4, 1)
152-
153-
actual <- integrateVector(integrand, upper = upper)
154-
expected <- c(
155-
integrate(integrand, 0, 1)$value,
156-
integrate(integrand, 0, 0.4)$value,
157-
integrate(integrand, 0, 1)$value
158-
)
159-
expect_equal(actual, expected)
160-
})
161-
162182
# singleExpQuantOS ----
163183

164184
test_that("singleExpQuantOS works as expected", {

0 commit comments

Comments
 (0)