Skip to content

Commit

Permalink
Make tests self-contained
Browse files Browse the repository at this point in the history
  • Loading branch information
nanxstats committed Feb 25, 2024
1 parent 2fadd4f commit 7b5e075
Show file tree
Hide file tree
Showing 37 changed files with 1,765 additions and 1,195 deletions.
13 changes: 8 additions & 5 deletions .lintr
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,7 @@ exclusions:
"tests/testthat/helper.R" = list(
object_name_linter = Inf
),
"tests/testthat/test-double_programming_ppwe.R" = list(
"tests/testthat/helper-ppwe.R" = list(
object_name_linter = Inf
),
"tests/testthat/test-independent_test_gs_design_wlr.R" = list(
Expand All @@ -35,9 +35,11 @@ exclusions:
object_name_linter = Inf,
commented_code_linter = Inf
),
"tests/testthat/test-independent-expected_accrual.R" = list(
object_name_linter = Inf,
commented_code_linter = Inf
"tests/testthat/helper-expected_accrual.R" = list(
object_name_linter = Inf
),
"tests/testthat/helper-expected_event.R" = list(
object_name_linter = Inf
),
"tests/testthat/test-independent-expected_event.R" = list(
object_name_linter = Inf
Expand All @@ -64,6 +66,7 @@ exclusions:
object_name_linter = Inf
),
"tests/testthat/test-independent-hupdate.R" = list(
object_name_linter = Inf
object_name_linter = Inf,
commented_code_linter = Inf
)
)
25 changes: 25 additions & 0 deletions tests/testthat/helper-ahr.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,25 @@
# Helper functions used by test-independent-AHR.R

test_ahr <- function() {
load("fixtures/simulation_test_data.Rdata")

enroll_rate <- define_enroll_rate(
duration = c(2, 2, 10),
rate = c(3, 6, 9)
)
fail_rate <- define_fail_rate(
stratum = "All",
duration = c(3, 100),
fail_rate = log(2) / c(9, 18),
hr = c(.9, .6),
dropout_rate = rep(.001, 2)
)

list(
"simulation_ahr1" = simulation_AHR1,
"simulation_ahr2" = simulation_AHR2,
"simulation_ahr3" = simulation_AHR3,
"enroll_rate" = enroll_rate,
"fail_rate" = fail_rate
)
}
26 changes: 26 additions & 0 deletions tests/testthat/helper-expected_accrual.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,26 @@
# Helper functions used by test-independent-expected_accrual.R

test_eAccrual <- function(x, enroll_rate) {
boundary <- cumsum(enroll_rate$duration)
rate <- enroll_rate$rate
xvals <- unique(c(x, boundary))

eAc2 <- numeric(length(xvals))
for (t in seq_along(xvals)) {
val <- xvals[t]
if (val <= boundary[1]) {
eAc2[t] <- val * rate[1]
} else if (val <= boundary[2]) {
eAc2[t] <- boundary[1] * rate[1] + (val - boundary[1]) * rate[2]
} else if (val <= boundary[3]) {
eAc2[t] <- boundary[1] * rate[1] +
(boundary[2] - boundary[1]) * rate[2] + (val - boundary[2]) * rate[3]
} else {
eAc2[t] <- boundary[1] * rate[1] +
(boundary[2] - boundary[1]) * rate[2] + (boundary[3] - boundary[2]) * rate[3]
}
}

ind <- !is.na(match(xvals, x))
return(eAc2[ind])
}
81 changes: 81 additions & 0 deletions tests/testthat/helper-expected_event.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,81 @@
# Helper functions used by test-independent-expected_event.R

n_event <- function(failRates, followup) {
failduration <- failRates$duration
failtime <- cumsum(failduration)
failRate <- failRates$failRate
dropoutRate <- failRates$dropoutRate
lamda <- failRate + dropoutRate
lamda1 <- c(lamda, dplyr::last(lamda))
failRate1 <- c(failRate, dplyr::last(failRate))

failtimeend <- c(0, failtime[failtime < followup], followup)
failtimeend1 <- c(failtime[failtime < followup], followup)
lamda2 <- lamda1[c(1:(length(failtimeend) - 1))]
failRate2 <- failRate1[c(1:(length(failtimeend) - 1))]

failduration <- diff(failtimeend)
failduration2 <- followup - failtimeend1

fail <- lamda2 * failduration
sumfail <- cumsum(fail)
Bi1 <- c(1, exp(-sumfail))
diffbi <- diff(Bi1)
Bi <- Bi1[c(1:(length(Bi1) - 1))]

totalevent <- diffbi * (1 / lamda2 - failduration2) + Bi * failduration

failevent <- totalevent * (failRate2 / lamda2)
return(sum(failevent))
}

test_expected_event <- function(enrollRates, failRates, totalDuration) {
enrolltime <- c(0, cumsum(enrollRates$duration))
Event <- 0
for (i in seq_along(enrollRates$duration)) {
enrollmentstart <- 0
enrollmentend <- enrollRates$duration[i]
enrollrate <- enrollRates$rate[i]
followup <- totalDuration - enrolltime[i]
nEventnum <- 0

if (followup > 0 && followup <= enrollmentend) {
nEventnum <- n_event(failRates, followup) * enrollrate
} else if (followup > 0 && followup > enrollmentend) {
nEventnum <- (n_event(failRates, followup) - n_event(failRates, followup - enrollmentend)) * enrollrate
} else {
nEventnum <- 0
}
Event <- Event + nEventnum
}
return(Event)
}

params_expected_event <- function() {
enroll_rate <- define_enroll_rate(
duration = c(50),
rate = c(10)
)

fail_rate <- define_fail_rate(
duration = c(10, 20, 10),
fail_rate = log(2) / c(5, 10, 5),
dropout_rate = c(0.1, 0.2, 0),
hr = 1
)

fail_rate$failRate <- fail_rate$fail_rate
fail_rate$dropoutRate <- fail_rate$dropout_rate
failRates <- fail_rate

total_duration <- 5
simple <- TRUE

list(
"enroll_rate" = enroll_rate,
"fail_rate" = fail_rate,
"failRates" = failRates,
"total_duration" = total_duration,
"simple" = simple
)
}
27 changes: 27 additions & 0 deletions tests/testthat/helper-expected_time.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,27 @@
# Helper functions used by test-independent-expected_time.R

test_expected_time <- function() {
enroll_rate <- define_enroll_rate(
duration = c(2, 2, 10),
rate = c(3, 6, 9) * 5
)

fail_rate <- define_fail_rate(
duration = c(3, 100),
fail_rate = log(2) / c(9, 18),
dropout_rate = rep(.001, 2),
hr = c(.9, .6)
)

target_event <- 150
interval <- c(.01, 100)

t1 <- expected_time(
enroll_rate = enroll_rate,
fail_rate = fail_rate,
target_event = target_event,
interval = interval
)

list("enroll_rate" = enroll_rate, "fail_rate" = fail_rate, "t1" = t1)
}
30 changes: 30 additions & 0 deletions tests/testthat/helper-fixed_design.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,30 @@
# Helper functions used by test-independent-fixed_design.R

test_fixed_design <- function() {
# Enrollment rate
enroll_rate <- define_enroll_rate(
duration = 18,
rate = 20
)

# Failure rates
fail_rate <- define_fail_rate(
duration = c(4, 100),
fail_rate = log(2) / 12,
dropout_rate = .001,
hr = c(1, .6)
)

# Study duration in months
study_duration <- 36

# Experimental / Control randomization ratio
ratio <- 1

list(
"enroll_rate" = enroll_rate,
"fail_rate" = fail_rate,
"study_duration" = study_duration,
"ratio" = ratio
)
}
97 changes: 97 additions & 0 deletions tests/testthat/helper-gs_design_combo.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,97 @@
# Helper functions used by test-independent-gs_design_combo.R

test_gs_design_combo <- function() {
load("fixtures/sim_gsd_pMaxCombo_exp1_H0_test.Rdata")
load("fixtures/sim_gsd_pMaxCombo_exp1_H1_test.Rdata")

ratio <- 1
algorithm <- mvtnorm::GenzBretz(maxpts = 1e5, abseps = 1e-5)
alpha <- 0.025
beta <- 0.2
enroll_rate <- define_enroll_rate(duration = 12, rate = 500 / 12)
fail_rate <- define_fail_rate(
duration = c(4, 100),
fail_rate = log(2) / 15, # Median survival 15 month
dropout_rate = 0.001,
hr = c(1, .6)
)

fh_test <- rbind(
data.frame(
rho = 0,
gamma = 0,
tau = -1,
test = 1,
analysis = 1:3,
analysis_time = c(12, 24, 36)
),
data.frame(
rho = c(0, 0.5),
gamma = 0.5,
tau = -1,
test = 2:3,
analysis = 3,
analysis_time = 36
)
)

x <- gsDesign::gsSurv(
k = 3,
test.type = 4,
alpha = 0.025,
beta = 0.2,
astar = 0,
timing = c(1),
sfu = gsDesign::sfLDOF,
sfupar = c(0),
sfl = gsDesign::sfLDOF,
sflpar = c(0),
lambdaC = c(0.1),
hr = 0.6,
hr0 = 1,
eta = 0.01,
gamma = c(10),
R = c(12),
S = NULL,
T = 36,
minfup = 24,
ratio = 1
)

# User-defined boundary
gs_design_combo_test1 <- gs_design_combo(
enroll_rate = enroll_rate,
fail_rate = fail_rate,
fh_test = fh_test,
alpha = alpha,
beta = beta,
ratio = 1,
binding = FALSE, # test.type = 4 non-binding futility bound
upar = x$upper$bound,
lpar = x$lower$bound
)

# Boundary derived by spending function testing
gs_design_combo_test2 <- gs_design_combo(
enroll_rate = enroll_rate,
fail_rate = fail_rate,
fh_test = fh_test,
alpha = 0.025,
beta = 0.2,
ratio = 1,
binding = FALSE, # test.type = 4 non-binding futility bound
upper = gs_spending_combo,
upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025), # alpha spending
lower = gs_spending_combo,
lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.2), # beta spending
)

list(
"alpha" = alpha,
"beta" = beta,
"enroll_rate" = enroll_rate,
"fail_rate" = fail_rate,
"fh_test" = fh_test,
"gs_design_combo_test2" = gs_design_combo_test2
)
}
14 changes: 14 additions & 0 deletions tests/testthat/helper-gs_design_npe.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@
# Helper functions used by test-independent-gs_design_npe.R

# Parameters used repeatedly
params_gs_design_npe <- list(
K = 3,
timing = c(.45, .8, 1),
sfu = gsDesign::sfPower,
sfupar = 4,
sfl = gsDesign::sfHSD,
sflpar = 2,
delta = .2,
alpha = .02,
beta = .15
)
16 changes: 16 additions & 0 deletions tests/testthat/helper-gs_info_ahr.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,16 @@
# Helper functions used by test-independent-gs_info_ahr.R

test_gs_info_ahr <- function() {
enroll_rate <- define_enroll_rate(
duration = c(2, 2, 10),
rate = c(3, 6, 9)
)
fail_rate <- define_fail_rate(
duration = c(3, 100),
fail_rate = log(2) / c(9, 18),
hr = c(0.9, 0.6),
dropout_rate = 0.001
)

list("enroll_rate" = enroll_rate, "fail_rate" = fail_rate)
}
37 changes: 37 additions & 0 deletions tests/testthat/helper-gs_info_combo.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,37 @@
# Helper functions used by test-independent-gs_info_combo.R

test_gs_info_combo <- function() {
rho <- c(1, 1, 0, 0)
gamma <- c(0, 1, 0, 1)
tau <- c(-1, -1, -1, -1)
enroll_rate <- define_enroll_rate(
duration = c(2, 2, 30),
rate = c(3, 6, 9)
)
fail_rate <- define_fail_rate(
duration = c(3, 100),
fail_rate = log(2) / c(9, 18),
dropout_rate = rep(.001, 2),
hr = c(.9, .6)
)
info_combo <- gsDesign2::gs_info_combo(
enroll_rate = enroll_rate,
fail_rate = fail_rate,
ratio = 1, # Experimental:Control randomization ratio
event = NULL, # Events at analyses
analysis_time = 30, # Times of analyses
rho = rho,
gamma = gamma,
tau = rep(-1, length(rho)),
approx = "asymptotic"
)

list(
"rho" = rho,
"gamma" = gamma,
"tau" = tau,
"enroll_rate" = enroll_rate,
"fail_rate" = fail_rate,
"info_combo" = info_combo
)
}
Loading

0 comments on commit 7b5e075

Please sign in to comment.