diff --git a/DESCRIPTION b/DESCRIPTION index 88d599d4..ca21590c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: simtrial Type: Package Title: Clinical Trial Simulation -Version: 0.3.2.9 +Version: 0.3.2.10 Authors@R: c( person("Keaven", "Anderson", email = "keaven_anderson@merck.com", role = c("aut")), person("Yilong", "Zhang", email = "elong0527@gmail.com", role = c("aut")), diff --git a/R/sim_gs_n.R b/R/sim_gs_n.R index 33cbb770..34395994 100644 --- a/R/sim_gs_n.R +++ b/R/sim_gs_n.R @@ -22,9 +22,13 @@ #' arguments will change as we add additional features. #' #' @inheritParams sim_fixed_n -#' @param test A test function such as [wlr()], -#' [maxcombo()], or [rmst()]. The simulated data set is -#' passed as the first positional argument to the test function provided. +#' @param test A test function such as [wlr()], [maxcombo()], or [rmst()]. The +#' simulated data set is passed as the first positional argument to the test +#' function provided. Alternatively a list of functions created by +#' [create_cutting_test()]. The list form is experimental and currently +#' limited. It only accepts one test per cutting (in the future multiple tests +#' may be accepted), and all the tests must consistently return the same exact +#' results (again this may be more flexible in the future). #' @param cutting A list of cutting functions created by [create_cutting()], #' see examples. #' @param seed Random seed. @@ -268,6 +272,17 @@ sim_gs_n <- function( cut_date <- rep(-100, n_analysis) ans_1sim <- NULL + # Organize tests for each cutting + if (is.function(test)) { + test_single <- test + test <- vector(mode = "list", length = n_analysis) + test[] <- list(test_single) + } + if (length(test) != length(cutting)) { + 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] <- cutting[[i_analysis]](data = simu_data) @@ -276,7 +291,7 @@ sim_gs_n <- function( simu_data_cut <- simu_data |> cut_data_by_date(cut_date[i_analysis]) # Test - ans_1sim_new <- test(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 diff --git a/man/sim_gs_n.Rd b/man/sim_gs_n.Rd index 959f42db..38538351 100644 --- a/man/sim_gs_n.Rd +++ b/man/sim_gs_n.Rd @@ -36,9 +36,13 @@ for experimental vs. control, and dropout rates by stratum and time period.} \item{block}{As in \code{\link[=sim_pw_surv]{sim_pw_surv()}}. Vector of treatments to be included in each block.} -\item{test}{A test function such as \code{\link[=wlr]{wlr()}}, -\code{\link[=maxcombo]{maxcombo()}}, or \code{\link[=rmst]{rmst()}}. The simulated data set is -passed as the first positional argument to the test function provided.} +\item{test}{A test function such as \code{\link[=wlr]{wlr()}}, \code{\link[=maxcombo]{maxcombo()}}, or \code{\link[=rmst]{rmst()}}. The +simulated data set is passed as the first positional argument to the test +function provided. Alternatively a list of functions created by +\code{\link[=create_cutting_test]{create_cutting_test()}}. The list form is experimental and currently +limited. It only accepts one test per cutting (in the future multiple tests +may be accepted), and all the tests must consistently return the same exact +results (again this may be more flexible in the future).} \item{cutting}{A list of cutting functions created by \code{\link[=create_cutting]{create_cutting()}}, see examples.} diff --git a/tests/testthat/test-unvalidated-sim_gs_n.R b/tests/testthat/test-unvalidated-sim_gs_n.R index 5a5b119d..b6a3df23 100644 --- a/tests/testthat/test-unvalidated-sim_gs_n.R +++ b/tests/testthat/test-unvalidated-sim_gs_n.R @@ -231,3 +231,52 @@ test_that("Test 7: MaxCombo (WLR-FH(0,0) + WLR-FH(0, 0.5))", { ) expect_equal(observed, expected) }) + +test_that("sim_gs_n() accepts different tests per cutting", { + wlr_cut1 <- create_cutting_test(wlr, weight = fh(rho = 0, gamma = 0)) + wlr_cut2 <- create_cutting_test(wlr, weight = fh(rho = 0, gamma = 0.5)) + wlr_cut3 <- create_cutting_test(wlr, weight = fh(rho = 0.5, gamma = 0)) + + observed <- sim_gs_n( + n_sim = 3, + sample_size = 400, + enroll_rate = test_enroll_rate(), + fail_rate = test_fail_rate(), + test = list(wlr_cut1, wlr_cut2, wlr_cut3), + cutting = test_cutting(), + seed = 2024 + ) + expected <- data.frame( + rho = rep(c(0, 0, 0.5), 3), + gamma = rep(c(0, 0.5, 0), 3), + z = c( + -3.7486049782713247, -4.778107819550277, -4.189693884801371, + -3.4771440155825752, -3.945081123231263, -3.438138809871842, + -3.075862925191481, -3.640458610667732, -3.9489173860678495 + ), + analysis = rep(1:3, 3), + cut_date = c(24, 32, 45, 24, 32, 46.219327415802894, 24, 32, 50.86585486314699), + sim_id = rep(1:3, each = 3L), + n = rep(400L, 9L), + event = c(229, 295, 355, 241, 290, 350, 226, 282, 350) + ) + expect_equal(observed, expected) +}) + +test_that("sim_gs_n() requires a test for each cutting", { + wlr_cut1 <- create_cutting_test(wlr, weight = fh(rho = 0, gamma = 0)) + wlr_cut2 <- create_cutting_test(wlr, weight = fh(rho = 0, gamma = 0.5)) + + expect_error( + sim_gs_n( + n_sim = 3, + sample_size = 400, + enroll_rate = test_enroll_rate(), + fail_rate = test_fail_rate(), + test = list(wlr_cut1, wlr_cut2), + cutting = test_cutting(), + seed = 2024 + ), + "If you want to run different tests at each cutting" + ) +})