Skip to content

Commit

Permalink
Use the singular cut and test for consistency in arg names
Browse files Browse the repository at this point in the history
  • Loading branch information
@jdblischak
jdblischak committed Mar 22, 2024
1 parent b108372 commit ada0b24
Show file tree
Hide file tree
Showing 3 changed files with 71 additions and 71 deletions.
56 changes: 28 additions & 28 deletions R/sim_gs_n.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -117,8 +117,8 @@
#' sample_size = 400,
#' enroll_rate = enroll_rate,
#' fail_rate = fail_rate,
#' tests = wlr,
#' cuts = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' test = wlr,
#' cut = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' seed = 2024,
#' weight = fh(rho = 0, gamma = 0)
#' )
Expand All @@ -129,8 +129,8 @@
#' sample_size = 400,
#' enroll_rate = enroll_rate,
#' fail_rate = fail_rate,
#' tests = wlr,
#' cuts = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' test = wlr,
#' cut = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' seed = 2024,
#' weight = fh(rho = 0, gamma = 0.5)
#' )
Expand All @@ -141,8 +141,8 @@
#' sample_size = 400,
#' enroll_rate = enroll_rate,
#' fail_rate = fail_rate,
#' tests = wlr,
#' cuts = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' test = wlr,
#' cut = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' seed = 2024,
#' weight = mb(delay = 3)
#' )
Expand All @@ -153,8 +153,8 @@
#' sample_size = 400,
#' enroll_rate = enroll_rate,
#' fail_rate = fail_rate,
#' tests = wlr,
#' cuts = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' test = wlr,
#' cut = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' seed = 2024,
#' weight = early_zero(6)
#' )
Expand All @@ -165,8 +165,8 @@
#' sample_size = 400,
#' enroll_rate = enroll_rate,
#' fail_rate = fail_rate,
#' tests = rmst,
#' cuts = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' test = rmst,
#' cut = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' seed = 2024,
#' tau = 20
#' )
Expand All @@ -177,8 +177,8 @@
#' sample_size = 400,
#' enroll_rate = enroll_rate,
#' fail_rate = fail_rate,
#' tests = milestone,
#' cuts = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' test = milestone,
#' cut = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' seed = 2024,
#' ms_time = 10
#' )
Expand All @@ -190,8 +190,8 @@
#' sample_size = 400,
#' enroll_rate = enroll_rate,
#' fail_rate = fail_rate,
#' tests = maxcombo,
#' cuts = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' test = maxcombo,
#' cut = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' seed = 2024,
#' rho = c(0, 0),
#' gamma = c(0, 0.5)
Expand All @@ -205,8 +205,8 @@
#' sample_size = 400,
#' enroll_rate = enroll_rate,
#' fail_rate = fail_rate,
#' tests = maxcombo(test1 = wlr, test2 = milestone),
#' cuts = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' test = maxcombo(test1 = wlr, test2 = milestone),
#' cut = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' seed = 2024,
#' test1_par = list(weight = fh(rho = 0, gamma = 0.5)),
#' test2_par = list(ms_time = 10)
Expand All @@ -221,8 +221,8 @@
#' sample_size = 400,
#' enroll_rate = enroll_rate,
#' fail_rate = fail_rate,
#' tests = list(ia1 = wlr, ia2 = wlr, fa = maxcombo),
#' cuts = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' test = list(ia1 = wlr, ia2 = wlr, fa = maxcombo),
#' cut = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' seed = 2024,
#' test_par = list(
#' ia1 = list(weight = fh(rho = 0, gamma = 0)),
Expand All @@ -248,8 +248,8 @@ sim_gs_n <- function(
dropout_rate = rep(.001, 2)
),
block = rep(c("experimental", "control"), 2),
tests = wlr,
cuts = NULL,
test = wlr,
cut = NULL,
seed = 2024,
...) {
# Input checking
Expand All @@ -270,30 +270,30 @@ sim_gs_n <- function(
)

# Initialize the cut date of IA(s) and FA
n_analysis <- length(cuts)
n_analysis <- length(cut)
cut_date <- rep(-100, n_analysis)
ans_1sim <- NULL

# Organize tests for each cutting
if (is.function(tests)) {
test_single <- tests
tests <- vector(mode = "list", length = n_analysis)
tests[] <- list(test_single)
if (is.function(test)) {
test_single <- test
test <- vector(mode = "list", length = n_analysis)
test[] <- list(test_single)
}
if (length(tests) != length(cuts)) {
if (length(test) != length(cut)) {
stop("If you want to run different tests at each cutting, the list of
tests must be the same length as the list of cuttings")
}

for (i_analysis in seq_len(n_analysis)) {
# Get cut date
cut_date[i_analysis] <- cuts[[i_analysis]](simu_data)
cut_date[i_analysis] <- cut[[i_analysis]](simu_data)

# Cut the data
simu_data_cut <- simu_data |> cut_data_by_date(cut_date[i_analysis])

# Test
ans_1sim_new <- tests[[i_analysis]](simu_data_cut, ...)
ans_1sim_new <- test[[i_analysis]](simu_data_cut, ...)
ans_1sim_new$analysis <- i_analysis
ans_1sim_new$cut_date <- cut_date[i_analysis]
ans_1sim_new$sim_id <- sim_id
Expand Down
50 changes: 25 additions & 25 deletions man/sim_gs_n.Rd
View file

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

36 changes: 18 additions & 18 deletions tests/testthat/test-unvalidated-sim_gs_n.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,8 +9,8 @@ test_that("Test 1: regular logrank test", {
sample_size = 400,
enroll_rate = test_enroll_rate(),
fail_rate = test_fail_rate(),
tests = wlr,
cuts = test_cutting(),
test = wlr,
cut = test_cutting(),
seed = 2024,
weight = fh(rho = 0, gamma = 0)
)
Expand All @@ -37,8 +37,8 @@ test_that("Test 2: weighted logrank test by FH(0, 0.5)", {
sample_size = 400,
enroll_rate = test_enroll_rate(),
fail_rate = test_fail_rate(),
tests = wlr,
cuts = test_cutting(),
test = wlr,
cut = test_cutting(),
seed = 2024,
weight = fh(rho = 0, gamma = 0.5)
)
Expand All @@ -65,8 +65,8 @@ test_that("Test 3: weighted logrank test by MB(3)", {
sample_size = 400,
enroll_rate = test_enroll_rate(),
fail_rate = test_fail_rate(),
tests = wlr,
cuts = test_cutting(),
test = wlr,
cut = test_cutting(),
seed = 2024,
weight = mb(delay = 3)
)
Expand All @@ -91,8 +91,8 @@ test_that("Test 4: weighted logrank test by early zero (6)", {
sample_size = 400,
enroll_rate = test_enroll_rate(),
fail_rate = test_fail_rate(),
tests = wlr,
cuts = test_cutting(),
test = wlr,
cut = test_cutting(),
seed = 2024,
weight = early_zero(6)
)
Expand All @@ -117,8 +117,8 @@ test_that("Test 5: RMST", {
sample_size = 400,
enroll_rate = test_enroll_rate(),
fail_rate = test_fail_rate(),
tests = rmst,
cuts = test_cutting(),
test = rmst,
cut = test_cutting(),
seed = 2024,
tau = 20
)
Expand Down Expand Up @@ -158,8 +158,8 @@ test_that("Test 6: Milestone", {
sample_size = 400,
enroll_rate = test_enroll_rate(),
fail_rate = test_fail_rate(),
tests = milestone,
cuts = test_cutting(),
test = milestone,
cut = test_cutting(),
seed = 2024,
ms_time = 10
)
Expand Down Expand Up @@ -211,8 +211,8 @@ test_that("Test 7: MaxCombo (WLR-FH(0,0) + WLR-FH(0, 0.5))", {
sample_size = 400,
enroll_rate = test_enroll_rate(),
fail_rate = test_fail_rate(),
tests = maxcombo,
cuts = test_cutting(),
test = maxcombo,
cut = test_cutting(),
seed = 2024,
rho = c(0, 0),
gamma = c(0, 0.5)
Expand Down Expand Up @@ -242,8 +242,8 @@ test_that("sim_gs_n() accepts different tests per cutting", {
sample_size = 400,
enroll_rate = test_enroll_rate(),
fail_rate = test_fail_rate(),
tests = list(wlr_cut1, wlr_cut2, wlr_cut3),
cuts = test_cutting(),
test = list(wlr_cut1, wlr_cut2, wlr_cut3),
cut = test_cutting(),
seed = 2024
)
expected <- data.frame(
Expand Down Expand Up @@ -273,8 +273,8 @@ test_that("sim_gs_n() requires a test for each cutting", {
sample_size = 400,
enroll_rate = test_enroll_rate(),
fail_rate = test_fail_rate(),
tests = list(wlr_cut1, wlr_cut2),
cuts = test_cutting(),
test = list(wlr_cut1, wlr_cut2),
cut = test_cutting(),
seed = 2024
),
"If you want to run different tests at each cutting"
Expand Down

0 comments on commit ada0b24

Please sign in to comment.