From 6118448bc694494e57aced0f34c0623bbf67ad18 Mon Sep 17 00:00:00 2001 From: Cole Date: Mon, 13 May 2024 16:01:17 -0400 Subject: [PATCH 1/7] Adding %doFuture% parallel framework for the sim_gs_n.R code and updating associated tests. --- R/sim_gs_n.R | 40 ++-- man/sim_gs_n.Rd | 15 +- tests/testthat/test-unvalidated-sim_gs_n.R | 256 ++++++++++----------- 3 files changed, 153 insertions(+), 158 deletions(-) diff --git a/R/sim_gs_n.R b/R/sim_gs_n.R index c385836d..b4c2ff70 100644 --- a/R/sim_gs_n.R +++ b/R/sim_gs_n.R @@ -33,7 +33,6 @@ #' positional argument to each test function provided. #' @param cut A list of cutting functions created by [create_cut()], see #' examples. -#' @param seed Random seed. #' @param ... Arguments passed to the test function(s) provided by the argument #' `test`. #' @@ -119,7 +118,6 @@ #' fail_rate = fail_rate, #' test = wlr, #' cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut), -#' seed = 2024, #' weight = fh(rho = 0, gamma = 0) #' ) #' @@ -131,7 +129,6 @@ #' fail_rate = fail_rate, #' test = wlr, #' cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut), -#' seed = 2024, #' weight = fh(rho = 0, gamma = 0.5) #' ) #' @@ -143,7 +140,6 @@ #' fail_rate = fail_rate, #' test = wlr, #' cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut), -#' seed = 2024, #' weight = mb(delay = 3) #' ) #' @@ -155,7 +151,6 @@ #' fail_rate = fail_rate, #' test = wlr, #' cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut), -#' seed = 2024, #' weight = early_zero(6) #' ) #' @@ -167,7 +162,6 @@ #' fail_rate = fail_rate, #' test = rmst, #' cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut), -#' seed = 2024, #' tau = 20 #' ) #' @@ -179,7 +173,6 @@ #' fail_rate = fail_rate, #' test = milestone, #' cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut), -#' seed = 2024, #' ms_time = 10 #' ) #' @@ -194,8 +187,7 @@ #' enroll_rate = enroll_rate, #' fail_rate = fail_rate, #' test = list(ia1 = ia1_test, ia2 = ia2_test, fa = fa_test), -#' cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut), -#' seed = 2024 +#' cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut) #' ) #' #' # WARNING: Multiple tests per cut will be enabled in a future version. @@ -223,8 +215,7 @@ #' enroll_rate = enroll_rate, #' fail_rate = fail_rate, #' test = list(ia1 = ia1_test, ia2 = ia2_test, fa = fa_test), -#' cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut), -#' seed = 2024 +#' cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut) #' ) #' } sim_gs_n <- function( @@ -242,15 +233,29 @@ sim_gs_n <- function( block = rep(c("experimental", "control"), 2), test = wlr, cut = NULL, - seed = 2024, ...) { # Input checking # TODO + # parallel computation message for backends ---- + if (!is(plan(), "sequential")) { + # future backend + message("Using ", nbrOfWorkers(), " cores with backend ", attr(plan("list")[[1]], "class")[2]) + } else if (foreach::getDoParWorkers() > 1) { + message("Using ", foreach::getDoParWorkers(), " cores with backend ", foreach::getDoParName()) + message("Warning: ") + message("doFuture may exhibit suboptimal performance when using a doParallel backend.") + } else { + message("Backend uses sequential processing.") + } + # Simulate for `n_sim` times - ans <- NULL - for (sim_id in seq_len(n_sim)) { - set.seed(seed + sim_id) + ans <- foreach::foreach( + sim_id = seq_len(n_sim), + .combine = "rbind", + .errorhandling = "stop", + .options.future = list(seed = TRUE) + ) %dofuture% { # Generate data simu_data <- sim_pw_surv( n = sample_size, @@ -265,7 +270,6 @@ sim_gs_n <- function( n_analysis <- length(cut) cut_date <- rep(-100, n_analysis) ans_1sim <- NULL - # Organize tests for each cutting if (is.function(test)) { test_single <- test @@ -301,10 +305,12 @@ sim_gs_n <- function( # rbind simulation results for all IA(s) and FA in 1 simulation ans_1sim <- rbind(ans_1sim, ans_1sim_new) + } - ans <- rbind(ans, ans_1sim) + ans_1sim } + # ans <- convert_list_to_df_w_list_cols(ans) return(ans) } diff --git a/man/sim_gs_n.Rd b/man/sim_gs_n.Rd index 3f203a86..90d2da3d 100644 --- a/man/sim_gs_n.Rd +++ b/man/sim_gs_n.Rd @@ -14,7 +14,6 @@ sim_gs_n( block = rep(c("experimental", "control"), 2), test = wlr, cut = NULL, - seed = 2024, ... ) } @@ -49,8 +48,6 @@ positional argument to each test function provided.} \item{cut}{A list of cutting functions created by \code{\link[=create_cut]{create_cut()}}, see examples.} -\item{seed}{Random seed.} - \item{...}{Arguments passed to the test function(s) provided by the argument \code{test}.} } @@ -140,7 +137,6 @@ sim_gs_n( fail_rate = fail_rate, test = wlr, cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut), - seed = 2024, weight = fh(rho = 0, gamma = 0) ) @@ -152,7 +148,6 @@ sim_gs_n( fail_rate = fail_rate, test = wlr, cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut), - seed = 2024, weight = fh(rho = 0, gamma = 0.5) ) @@ -164,7 +159,6 @@ sim_gs_n( fail_rate = fail_rate, test = wlr, cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut), - seed = 2024, weight = mb(delay = 3) ) @@ -176,7 +170,6 @@ sim_gs_n( fail_rate = fail_rate, test = wlr, cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut), - seed = 2024, weight = early_zero(6) ) @@ -188,7 +181,6 @@ sim_gs_n( fail_rate = fail_rate, test = rmst, cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut), - seed = 2024, tau = 20 ) @@ -200,7 +192,6 @@ sim_gs_n( fail_rate = fail_rate, test = milestone, cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut), - seed = 2024, ms_time = 10 ) @@ -215,8 +206,7 @@ sim_gs_n( enroll_rate = enroll_rate, fail_rate = fail_rate, test = list(ia1 = ia1_test, ia2 = ia2_test, fa = fa_test), - cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut), - seed = 2024 + cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut) ) # WARNING: Multiple tests per cut will be enabled in a future version. @@ -244,8 +234,7 @@ sim_gs_n( enroll_rate = enroll_rate, fail_rate = fail_rate, test = list(ia1 = ia1_test, ia2 = ia2_test, fa = fa_test), - cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut), - seed = 2024 + cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut) ) } \dontshow{\}) # examplesIf} diff --git a/tests/testthat/test-unvalidated-sim_gs_n.R b/tests/testthat/test-unvalidated-sim_gs_n.R index fc9abe8f..ebe164c4 100644 --- a/tests/testthat/test-unvalidated-sim_gs_n.R +++ b/tests/testthat/test-unvalidated-sim_gs_n.R @@ -4,6 +4,7 @@ # See helper-sim_gs_n.R for helper functions test_that("regular logrank test", { + set.seed(2024) observed <- sim_gs_n( n_sim = 3, sample_size = 400, @@ -11,7 +12,6 @@ test_that("regular logrank test", { fail_rate = test_fail_rate(), test = wlr, cut = test_cutting(), - seed = 2024, weight = fh(rho = 0, gamma = 0) ) expected <- data.frame( @@ -19,29 +19,30 @@ test_that("regular logrank test", { method = rep("WLR", 9L), parameter = rep("FH(rho=0, gamma=0)", 9L), analysis = rep(1:3, 3), - cut_date = c(24, 32, 45, 24, 32, 46.219327415802894, 24, 32, 50.86585486314699), + cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), n = rep(400L, 9L), - event = c(229, 295, 355, 241, 290, 350, 226, 282, 350), + event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), estimate = c( - -28.194825408790173, -38.32580538077858, -39.49229553865729, - -26.84871111584948, -32.548237296118835, -30.06631062297029, - -23.063020152157016, -30.16329862679027, -38.75506042018556 + -14.8967761757316, -22.6791676993923, -29.4104630799085, + -13.3530329578349, -17.9272135845997, -25.9789692783839, + -15.7016927028295, -22.7155477802184, -34.9030500614426 ), se = c( - 7.521418120132856, 8.459807588292295, 9.149247748025164, 7.7214837796562, - 8.425309955739992, 9.17277218574699, 7.498065002594769, 8.333909813280053, - 9.178026778744327 + 7.79986198971421, 8.70892718893558, 9.29168172400568, + 7.65165409688827, 8.77164253357172, 9.41875140383468, + 7.44263362582829, 8.42150520256931, 9.20559144909002 ), z = c( - -3.7486049782713247, -4.53034007934394, -4.316452743033609, - -3.4771440155825752, -3.8631501353780324, -3.2777779731288317, - -3.075862925191481, -3.619345457605645, -4.2225917786532925 + -1.90987689210094, -2.60412875287388, -3.16524650257064, + -1.74511717188905, -2.04376928448542, -2.75821795952773, + -2.10969577332675, -2.6973263370173, -3.79150544041283 ) ) expect_equal(observed, expected) }) test_that("weighted logrank test by FH(0, 0.5)", { + set.seed(2024) observed <- sim_gs_n( n_sim = 3, sample_size = 400, @@ -49,7 +50,6 @@ test_that("weighted logrank test by FH(0, 0.5)", { fail_rate = test_fail_rate(), test = wlr, cut = test_cutting(), - seed = 2024, weight = fh(rho = 0, gamma = 0.5) ) expected <- data.frame( @@ -57,29 +57,30 @@ test_that("weighted logrank test by FH(0, 0.5)", { method = rep("WLR", 9L), parameter = rep("FH(rho=0, gamma=0.5)", 9L), analysis = rep(1:3, 3), - cut_date = c(24, 32, 45, 24, 32, 46.219327415802894, 24, 32, 50.86585486314699), + cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), n = rep(400L, 9L), - event = c(229, 295, 355, 241, 290, 350, 226, 282, 350), + event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), estimate = c( - -16.934217242190208, -24.448179085866208, -25.51076208491462, - -15.500239367897708, -19.967690764549445, -17.5390556887186, - -12.664624037110103, -18.05051250570102, -25.59217169575864 + -11.5775033174745, -18.1616545384682, -24.0266481696649, + -8.44736378922731, -12.0875497249867, -19.3796342804342, + -9.95948396485636, -15.7876875029804, -26.5907291815672 ), se = c( - 4.081359229309616, 5.116707284384241, 5.987416130471112, 4.299539499761723, - 5.061414490811455, 6.008213897648367, 4.02917790229253, 4.958307300296486, - 6.031210878226377 + 4.34496240294236, 5.37217800719008, 6.12650200890773, + 4.16899365283586, 5.47959154932447, 6.30461298220442, + 3.99084589541075, 5.03739766754931, 6.02201456006756 ), z = c( - -4.149161171743935, -4.778107819550277, -4.2607297587160256, - -3.605092910242299, -3.945081123231263, -2.919179640988388, - -3.1432278107909206, -3.640458610667732, -4.243289152457 + -2.66458078201881, -3.3806874072603, -3.92175635211266, + -2.02623570402444, -2.20592166700397, -3.0738816696815, + -2.49558219632314, -3.13409592510117, -4.41558699606811 ) ) expect_equal(observed, expected) }) test_that("weighted logrank test by MB(3)", { + set.seed(2024) observed <- sim_gs_n( n_sim = 3, sample_size = 400, @@ -87,7 +88,6 @@ test_that("weighted logrank test by MB(3)", { fail_rate = test_fail_rate(), test = wlr, cut = test_cutting(), - seed = 2024, weight = mb(delay = 3) ) expected <- data.frame( @@ -95,29 +95,30 @@ test_that("weighted logrank test by MB(3)", { method = rep("WLR", 9L), parameter = rep("MB(delay = 3, max_weight = Inf)", 9L), analysis = rep(1:3, 3), - cut_date = c(24, 32, 45, 24, 32, 46.219327415802894, 24, 32, 50.86585486314699), + cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), n = rep(400L, 9L), - event = c(229, 295, 355, 241, 290, 350, 226, 282, 350), + event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), estimate = c( - -34.1924345680359, -46.745479781695614, -48.190848712798775, - -32.192766832733724, -39.186116293163025, -36.14077883676622, - -27.895635278073794, -36.66945854377384, -47.28630966948101 + -19.5592474225953, -29.5687542054386, -38.2263688427585, + -16.3881266934583, -22.1124941540687, -32.188879862274, + -19.8774758099929, -28.6176512547267, -43.8048638497507 ), se = c( - 9.004800861990685, 10.203472306286518, 11.079263268070516, 9.194961439431635, - 10.082514836095871, 11.020928299103936, 8.957907914269184, 10.022497598741575, - 11.091534337637594 + 9.61093979157535, 10.8257248464033, 11.5995352667424, + 9.23731341784668, 10.6834095617449, 11.5139237244706, + 8.93809056261512, 10.198207959654, 11.2011384564222 ), z = c( - -3.797133894694147, -4.581330588107247, -4.3496437937060906, - -3.5011312494121394, -3.886541892591609, -3.2792862684447983, - -3.114079263266195, -3.6587146250230145, -4.2632793831797855 + -2.03510248183433, -2.73134174616145, -3.29550865303709, + -1.7741226211721, -2.0697974767577, -2.79564817629134, + -2.22390628856832, -2.80614509607408, -3.91075103840314 ) ) expect_equal(observed, expected) }) test_that("weighted logrank test by early zero (6)", { + set.seed(2024) observed <- sim_gs_n( n_sim = 3, sample_size = 400, @@ -125,7 +126,6 @@ test_that("weighted logrank test by early zero (6)", { fail_rate = test_fail_rate(), test = wlr, cut = test_cutting(), - seed = 2024, weight = early_zero(6) ) expected <- data.frame( @@ -133,29 +133,30 @@ test_that("weighted logrank test by early zero (6)", { method = rep("WLR", 9L), parameter = rep("Xu 2017 with first 6 months of 0 weights", 9L), analysis = rep(1:3, 3), - cut_date = c(24, 32, 45, 24, 32, 46.219327415802894, 24, 32, 50.86585486314699), + cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), n = rep(400L, 9L), - event = c(229, 295, 355, 241, 290, 350, 226, 282, 350), + event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), estimate = c( - -21.998993527998245, -32.129973499986654, -33.29646365786535, - -17.199406900467533, -22.89893308073689, -20.417006407588342, - -11.776058510868394, -18.876336985501645, -27.468098778896934 + -13.1571999820816, -20.9395915057423, -27.6708868862585, + -12.9176255501546, -17.4918061769194, -25.5435618707036, + -5.11317406520125, -12.1270291425901, -24.3145314238143 ), se = c( - 4.8321641639910355, 6.192448982496682, 7.105407400328277, 5.399223368403168, - 6.36522969520413, 7.325984629661098, 4.974375513742725, 6.162587585135993, - 7.2635809708390155 + 4.90920032621625, 6.25362403463101, 7.04256700674935, 5.10417050246453, + 6.66681774436398, 7.49784129646925, 4.65652183734504, 6.10017624419681, + 7.14376051256763 ), z = c( - -4.552617167258777, -5.188572984743822, -4.686073828268738, - -3.185533497487861, -3.5975030245947046, -2.786930008687834, - -2.3673440974318556, -3.0630537456426414, -3.7816194091003705 + -2.68011063060906, -3.34839309011608, -3.92909103452473, + -2.5307982058823, -2.62371146889484, -3.4067888156998, + -1.09806723640677, -1.98798012666056, -3.40360393955524 ) ) expect_equal(observed, expected) }) test_that("RMST", { + set.seed(2024) observed <- sim_gs_n( n_sim = 3, sample_size = 400, @@ -163,7 +164,6 @@ test_that("RMST", { fail_rate = test_fail_rate(), test = rmst, cut = test_cutting(), - seed = 2024, tau = 20 ) expected <- data.frame( @@ -171,29 +171,30 @@ test_that("RMST", { method = rep("RMST", 9L), parameter = rep(20, 9L), analysis = rep(1:3, 3), - cut_date = c(24, 32, 45, 24, 32, 46.219327415802894, 24, 32, 50.86585486314699), + cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), n = rep(400L, 9L), - event = c(229, 295, 355, 241, 290, 350, 226, 282, 350), + event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), estimate = c( - 2.8811516510432966, 2.8531309198097876, 2.834507997939104, 2.567389750892662, - 2.3996923551365086, 2.36833514283823, 2.287497785439662, 2.4481174776559786, - 2.478942232915438 + 1.29434319527997, 1.03579407229687, 1.05740233262724, 1.27673666400642, + 1.34542683554887, 1.355651597816, 1.52706388710948, 1.33389386467127, + 1.34645188089274 ), se = c( - 0.7602020283980866, 0.7147367073498636, 0.7121698913441514, - 0.7388450867596175, 0.7282783320819864, 0.7277969580678861, - 0.7674790677752639, 0.7416397937499536, 0.7398877489385366 + 0.772544846741024, 0.738409622827227, 0.738497623667433, + 0.771657256733873, 0.738351348672298, 0.738159118543527, + 0.782892168148695, 0.739072978624375, 0.736694772438538 ), z = c( - 3.7899815357169184, 3.991862864282945, 3.980100861311682, 3.474868814723485, - 3.2950209410683957, 3.2541151987300845, 2.9805344295194454, - 3.3009521580248022, 3.3504301652133 + 1.67542790653533, 1.40273642200249, 1.4318290252257, 1.65453853101876, + 1.82220407393879, 1.83653031407491, 1.95054178498237, 1.80482023189919, + 1.82769300294591 ) ) expect_equal(observed, expected) }) test_that("Milestone", { + set.seed(2024) observed <- sim_gs_n( n_sim = 3, sample_size = 400, @@ -201,7 +202,6 @@ test_that("Milestone", { fail_rate = test_fail_rate(), test = milestone, cut = test_cutting(), - seed = 2024, ms_time = 10, test_type = "naive" ) @@ -210,23 +210,23 @@ test_that("Milestone", { method = rep("milestone", 9L), parameter = rep(10, 9L), analysis = rep(1:3, 3), - cut_date = c(24, 32, 45, 24, 32, 46.219327415802894, 24, 32, 50.86585486314699), + cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), n = rep(400L, 9L), - event = c(229, 295, 355, 241, 290, 350, 226, 282, 350), + event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), estimate = c( - 0.16097092361893622, 0.1752731092436976, 0.1752731092436976, - 0.12045851966961263, 0.11738941400903585, 0.11738941400903585, - 0.15355822418246762, 0.1519773404060174, 0.1519773404060174 + 0.0570882489260027, 0.055, 0.055, + 0.0982363112856928, 0.0995332208091276, 0.0995332208091276, + 0.0314033376239697, 0.047591242749346, 0.047591242749346 ), se = c( - 0.0735577751616129, 0.06979341256316365, 0.06979341256316365, - 0.0714536511961349, 0.07034478932059006, 0.07034478932059006, - 0.07086699850042757, 0.07013955795451529, 0.07013955795451529 + 0.0711607062867438, 0.0705956555729631, 0.0705956555729631, + 0.0707139642597667, 0.070488618189222, 0.070488618189222, + 0.0725290309676113, 0.0705189167423676, 0.0705189167423676 ), z = c( - 2.188360418259918, 2.5113130710591616, 2.5113130710591616, 1.685827353160205, - 1.6687719892662431, 1.6687719892662431, 2.1668509663428335, - 2.1667849760982665, 2.1667849760982665 + 0.802243989765422, 0.779084768795093, 0.779084768795093, + 1.38920667670141, 1.41204670152474, 1.41204670152474, + 0.432976109083731, 0.674872005241018, 0.674872005241018 ) ) expect_equal(observed, expected) @@ -237,43 +237,44 @@ test_that("WLR with fh(0, 0.5) test at IA1, WLR with mb(6, Inf) at IA2, and mile ia2_test <- create_test(wlr, weight = mb(delay = 6, w_max = Inf)) fa_test <- create_test(milestone, ms_time = 10, test_type = "naive") + set.seed(2024) observed <- sim_gs_n( n_sim = 3, sample_size = 400, enroll_rate = test_enroll_rate(), fail_rate = test_fail_rate(), test = list(ia1 = ia1_test, ia2 = ia2_test, fa = fa_test), - cut = test_cutting(), - seed = 2024 + cut = test_cutting() ) expected <- data.frame( sim_id = rep(1:3, each = 3L), method = rep(c("WLR", "WLR", "milestone"), 3), parameter = rep(c("FH(rho=0, gamma=0.5)", "MB(delay = 6, max_weight = Inf)", "10"), 3), analysis = rep(1:3, 3), - cut_date = c(24, 32, 45, 24, 32, 46.219327415802894, 24, 32, 50.86585486314699), + cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), n = rep(400L, 9L), - event = c(229, 295, 355, 241, 290, 350, 226, 282, 350), + event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), estimate = c( - -16.934217242190208, -55.13395025199291, 0.1752731092436976, - -15.500239367897708, -44.437051762182506, 0.11738941400903585, - -12.664624037110103, -41.66249375734963, 0.1519773404060174 + -11.5775033174745, -36.9093856541259, 0.055, + -8.44736378922731, -25.8424460996795, 0.0995332208091276, + -9.95948396485636, -32.6844032640339, 0.047591242749346 ), se = c( - 4.081359229309616, 11.636448672437368, 0.06979341256316365, 4.299539499761723, - 11.272930548434758, 0.07034478932059006, 4.02917790229253, 11.25721499206715, - 0.07013955795451529 + 4.34496240294236, 12.4451486506265, 0.0705956555729631, + 4.16899365283586, 12.0591010341806, 0.070488618189222, + 3.99084589541075, 11.6181044782549, 0.0705189167423676 ), z = c( - -4.149161171743935, -4.738039225196407, 2.5113130710591616, - -3.605092910242299, -3.9419254444313574, 1.6687719892662431, - -3.1432278107909206, -3.7009592325196583, 2.1667849760982665 + -2.66458078201881, -2.96576494908061, 0.779084768795093, + -2.02623570402444, -2.14298279999738, 1.41204670152474, + -2.49558219632314, -2.81323027566226, 0.674872005241018 ) ) expect_equal(observed, expected) }) test_that("MaxCombo (WLR-FH(0,0) + WLR-FH(0, 0.5))", { + set.seed(2024) observed <- sim_gs_n( n_sim = 3, sample_size = 400, @@ -281,7 +282,6 @@ test_that("MaxCombo (WLR-FH(0,0) + WLR-FH(0, 0.5))", { fail_rate = test_fail_rate(), test = maxcombo, cut = test_cutting(), - seed = 2024, rho = c(0, 0), gamma = c(0, 0.5) ) @@ -290,24 +290,24 @@ test_that("MaxCombo (WLR-FH(0,0) + WLR-FH(0, 0.5))", { method = rep("MaxCombo", 9L), parameter = rep("FH(0, 0) + FH(0, 0.5)", 9L), analysis = rep(1:3, 3), - cut_date = c(24, 32, 45, 24, 32, 46.219327415802894, 24, 32, 50.86585486314699), + cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), n = rep(400L, 9L), - event = c(229, 295, 355, 241, 290, 350, 226, 282, 350), + event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), z = I(list( - c(-3.7486049782713247, -4.149161171743935), - c(-4.53034007934394, -4.778107819550277), - c(-4.316452743033609, -4.2607297587160256), - c(-3.4771440155825752, -3.605092910242299), - c(-3.8631501353780324, -3.945081123231263), - c(-3.2777779731288317, -2.919179640988388), - c(-3.075862925191481, -3.1432278107909206), - c(-3.619345457605645, -3.640458610667732), - c(-4.2225917786532925, -4.243289152457) + c(-1.90987689210094, -2.66458078201881), + c(-2.60412875287388, -3.3806874072603), + c(-3.16524650257064, -3.92175635211266), + c(-1.74511717188905, -2.02623570402444), + c(-2.04376928448542, -2.20592166700397), + c(-2.75821795952773, -3.0738816696815), + c(-2.10969577332675, -2.49558219632314), + c(-2.6973263370173, -3.13409592510117), + c(-3.79150544041283, -4.41558699606811) )), p_value = c( - 2.6155386454673746e-05, 1.4330486162172917e-06, 1.247801863046849e-05, - 0.0002358380298724816, 6.130077643518028e-05, 0.0007667834024346343, - 0.001216230102102256, 0.00020471863687732128, 1.7249355113824194e-05 + 0.00540201317191025, 0.000532495483968387, 6.72595178197177e-05, + 0.0283259325313511, 0.0184175606190634, 0.00152059320052655, + 0.00872501551218574, 0.00124820253291602, 7.95668913800007e-06 ) ) expect_equal(observed, expected) @@ -318,37 +318,37 @@ test_that("sim_gs_n() accepts different tests per cutting", { wlr_cut2 <- create_test(wlr, weight = fh(rho = 0, gamma = 0.5)) wlr_cut3 <- create_test(wlr, weight = fh(rho = 0.5, gamma = 0)) + set.seed(2024) 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), - cut = test_cutting(), - seed = 2024 + cut = test_cutting() ) expected <- data.frame( sim_id = rep(1:3, each = 3L), method = rep("WLR", 9L), parameter = rep(c("FH(rho=0, gamma=0)", "FH(rho=0, gamma=0.5)", "FH(rho=0.5, gamma=0)"), 3), analysis = rep(1:3, 3), - cut_date = c(24, 32, 45, 24, 32, 46.219327415802894, 24, 32, 50.86585486314699), + cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), n = rep(400L, 9L), - event = c(229, 295, 355, 241, 290, 350, 226, 282, 350), + event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), estimate = c( - -28.194825408790173, -24.448179085866208, -28.98456223760244, - -26.84871111584948, -19.967690764549445, -23.830324019953483, - -23.063020152157016, -18.05051250570102, -27.319166131937404 + -14.8967761757316, -18.1616545384682, -16.9584344921688, + -13.3530329578349, -12.0875497249867, -16.4421705167356, + -15.7016927028295, -15.7876875029804, -21.4586952735303 ), se = c( - 7.521418120132856, 5.116707284384241, 6.918062043326721, 7.7214837796562, - 5.061414490811455, 6.931169838614448, 7.498065002594769, 4.958307300296486, - 6.9181407107482125 + 7.79986198971421, 5.37217800719008, 6.98579432813984, + 7.65165409688827, 5.47959154932447, 6.99748048599332, + 7.44263362582829, 5.03739766754931, 6.96263273237168 ), z = c( - -3.7486049782713247, -4.778107819550277, -4.189693884801371, - -3.4771440155825752, -3.945081123231263, -3.438138809871842, - -3.075862925191481, -3.640458610667732, -3.9489173860678495 + -1.90987689210094, -3.3806874072603, -2.42755994459466, + -1.74511717188905, -2.20592166700397, -2.34972724106162, + -2.10969577332675, -3.13409592510117, -3.08198006391483 ) ) expect_equal(observed, expected) @@ -360,6 +360,7 @@ test_that("sim_gs_n() requires a test for each cutting", { wlr_cut1 <- create_test(wlr, weight = fh(rho = 0, gamma = 0)) wlr_cut2 <- create_test(wlr, weight = fh(rho = 0, gamma = 0.5)) + set.seed(2024) expect_error( sim_gs_n( n_sim = 3, @@ -367,8 +368,7 @@ test_that("sim_gs_n() requires a test for each cutting", { enroll_rate = test_enroll_rate(), fail_rate = test_fail_rate(), test = list(wlr_cut1, wlr_cut2), - cut = test_cutting(), - seed = 2024 + cut = test_cutting() ), "If you want to run different tests at each cutting" ) @@ -379,37 +379,37 @@ test_that("sim_gs_n() can combine wlr(), rmst(), and milestone() tests", { test_cut2 <- create_test(rmst, tau = 20) test_cut3 <- create_test(milestone, ms_time = 10, test_type = "naive") + set.seed(2024) observed <- sim_gs_n( n_sim = 3, sample_size = 400, enroll_rate = test_enroll_rate(), fail_rate = test_fail_rate(), test = list(test_cut1, test_cut2, test_cut3), - cut = test_cutting(), - seed = 2024 + cut = test_cutting() ) expected <- data.frame( sim_id = rep(1:3, each = 3L), method = rep(c("WLR", "RMST", "milestone"), 3), parameter = rep(c("FH(rho=0, gamma=0)", "20", "10"), 3), analysis = rep(1:3, 3), - cut_date = c(24, 32, 45, 24, 32, 46.219327415802894, 24, 32, 50.86585486314699), + cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), n = rep(400L, 9L), - event = c(229, 295, 355, 241, 290, 350, 226, 282, 350), + event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), estimate = c( - -28.194825408790173, 2.8531309198097876, 0.1752731092436976, - -26.84871111584948, 2.3996923551365086, 0.11738941400903585, - -23.063020152157016, 2.4481174776559786, 0.1519773404060174 + -14.8967761757316, 1.03579407229687, 0.055, + -13.3530329578349, 1.34542683554887, 0.0995332208091276, + -15.7016927028295, 1.33389386467127, 0.047591242749346 ), se = c( - 7.521418120132856, 0.7147367073498636, 0.06979341256316365, 7.7214837796562, - 0.7282783320819864, 0.07034478932059006, 7.498065002594769, - 0.7416397937499536, 0.07013955795451529 + 7.79986198971421, 0.738409622827227, 0.0705956555729631, + 7.65165409688827, 0.738351348672298, 0.070488618189222, + 7.44263362582829, 0.739072978624375, 0.0705189167423676 ), z = c( - -3.7486049782713247, 3.991862864282945, 2.5113130710591616, - -3.4771440155825752, 3.2950209410683957, 1.6687719892662431, - -3.075862925191481, 3.3009521580248022, 2.1667849760982665 + -1.90987689210094, 1.40273642200249, 0.779084768795093, + -1.74511717188905, 1.82220407393879, 1.41204670152474, + -2.10969577332675, 1.80482023189919, 0.674872005241018 ) ) expect_equal(observed, expected) From c294b30afa52ad8dda53ddc094914817203005bb Mon Sep 17 00:00:00 2001 From: cmansch <50928670+cmansch@users.noreply.github.com> Date: Tue, 14 May 2024 16:02:01 -0400 Subject: [PATCH 2/7] Update sim_gs_n.R Removed a commented out line of code that is not needed. --- R/sim_gs_n.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/sim_gs_n.R b/R/sim_gs_n.R index b4c2ff70..474b1f03 100644 --- a/R/sim_gs_n.R +++ b/R/sim_gs_n.R @@ -310,7 +310,6 @@ sim_gs_n <- function( ans_1sim } - # ans <- convert_list_to_df_w_list_cols(ans) return(ans) } From 291778d9eb689535ab3f9eaec1f716825cde8e09 Mon Sep 17 00:00:00 2001 From: Cole Date: Wed, 15 May 2024 13:34:14 -0400 Subject: [PATCH 3/7] Updating Roxygen in sim_gs_n to describe choice of "stop". Updating error handling to "stop" in sim_fixed_n for parity. --- R/sim_fixed_n.R | 2 +- R/sim_gs_n.R | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/R/sim_fixed_n.R b/R/sim_fixed_n.R index f8ca3a4b..a2494580 100644 --- a/R/sim_fixed_n.R +++ b/R/sim_fixed_n.R @@ -252,7 +252,7 @@ sim_fixed_n <- function( results <- foreach::foreach( i = seq_len(n_sim), .combine = "rbind", - .errorhandling = "pass", + .errorhandling = "stop", .options.future = list(seed = TRUE) ) %dofuture% { # Generate piecewise data ---- diff --git a/R/sim_gs_n.R b/R/sim_gs_n.R index 474b1f03..9906b238 100644 --- a/R/sim_gs_n.R +++ b/R/sim_gs_n.R @@ -18,6 +18,11 @@ #' Simulate group sequential designs with fixed sample size #' +#' This function uses the option "stop" for the error-handling behavior of the +#' foreach loop. This will cause the entire function to stop when errors are +#' encountered and return the first error encountered instead of returning +#' errors for each individual simulation. +#' #' WARNING: This experimental function is a work-in-progress. The function #' arguments will change as we add additional features. #' From 04d6efb5fbec805edea8adf98ba9023ddee37e9c Mon Sep 17 00:00:00 2001 From: Cole Date: Wed, 15 May 2024 13:51:31 -0400 Subject: [PATCH 4/7] Updating the description for version change. Adding `sim_id` to the global parameters to avoid note from R CMD check. Adding test as an input to the foreach loop to handle the test in multisession Windows. --- DESCRIPTION | 2 +- R/global.R | 1 + R/sim_gs_n.R | 1 + 3 files changed, 3 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index fe53c949..84186b52 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: simtrial Type: Package Title: Clinical Trial Simulation -Version: 0.4.1.2 +Version: 0.4.1.3 Authors@R: c( person("Keaven", "Anderson", email = "keaven_anderson@merck.com", role = c("aut")), person("Yujie", "Zhao", email = "yujie.zhao@merck.com", role = c("ctb","cre")), diff --git a/R/global.R b/R/global.R index 71c2500d..b6146585 100644 --- a/R/global.R +++ b/R/global.R @@ -50,6 +50,7 @@ utils::globalVariables( "period", "rate", "s", + "sim_id", "status", "stratum", "time", diff --git a/R/sim_gs_n.R b/R/sim_gs_n.R index 9906b238..de11ad78 100644 --- a/R/sim_gs_n.R +++ b/R/sim_gs_n.R @@ -257,6 +257,7 @@ sim_gs_n <- function( # Simulate for `n_sim` times ans <- foreach::foreach( sim_id = seq_len(n_sim), + test = test, .combine = "rbind", .errorhandling = "stop", .options.future = list(seed = TRUE) From 2f2cd90c8a85d92515a69fcf020dffe70a6c1aad Mon Sep 17 00:00:00 2001 From: Cole Date: Wed, 15 May 2024 14:23:23 -0400 Subject: [PATCH 5/7] Fixing how test is passed to the loops for parallel design. --- R/sim_gs_n.R | 2 +- man/sim_gs_n.Rd | 6 ++++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/R/sim_gs_n.R b/R/sim_gs_n.R index de11ad78..9f3d3cbd 100644 --- a/R/sim_gs_n.R +++ b/R/sim_gs_n.R @@ -257,7 +257,7 @@ sim_gs_n <- function( # Simulate for `n_sim` times ans <- foreach::foreach( sim_id = seq_len(n_sim), - test = test, + test = replicate(n=n_sim, expr=test, simplify = FALSE), .combine = "rbind", .errorhandling = "stop", .options.future = list(seed = TRUE) diff --git a/man/sim_gs_n.Rd b/man/sim_gs_n.Rd index 90d2da3d..d454562e 100644 --- a/man/sim_gs_n.Rd +++ b/man/sim_gs_n.Rd @@ -56,6 +56,12 @@ A data frame summarizing the simulation ID, analysis date, z statistics or p-values. } \description{ +This function uses the option "stop" for the error-handling behavior of the +foreach loop. This will cause the entire function to stop when errors are +encountered and return the first error encountered instead of returning +errors for each individual simulation. +} +\details{ WARNING: This experimental function is a work-in-progress. The function arguments will change as we add additional features. } From f515139a144224ddb6cb9efb46587f44f6c6e125 Mon Sep 17 00:00:00 2001 From: Cole Date: Fri, 17 May 2024 09:10:31 -0400 Subject: [PATCH 6/7] Reverting the behavior for error handling in `sim_fixed_n`. --- R/sim_fixed_n.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/sim_fixed_n.R b/R/sim_fixed_n.R index a2494580..f8ca3a4b 100644 --- a/R/sim_fixed_n.R +++ b/R/sim_fixed_n.R @@ -252,7 +252,7 @@ sim_fixed_n <- function( results <- foreach::foreach( i = seq_len(n_sim), .combine = "rbind", - .errorhandling = "stop", + .errorhandling = "pass", .options.future = list(seed = TRUE) ) %dofuture% { # Generate piecewise data ---- From 749eadcca8d95b2fc3df50653b92274783020c95 Mon Sep 17 00:00:00 2001 From: Cole Date: Fri, 24 May 2024 14:18:18 -0400 Subject: [PATCH 7/7] Updating with parallel examples and test that are possible to run on all machines. --- R/sim_gs_n.R | 13 +++++++ man/sim_gs_n.Rd | 13 +++++++ tests/testthat/test-unvalidated-sim_gs_n.R | 41 ++++++++++++++++++++++ 3 files changed, 67 insertions(+) diff --git a/R/sim_gs_n.R b/R/sim_gs_n.R index 9f3d3cbd..dc52e269 100644 --- a/R/sim_gs_n.R +++ b/R/sim_gs_n.R @@ -222,6 +222,19 @@ #' test = list(ia1 = ia1_test, ia2 = ia2_test, fa = fa_test), #' cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut) #' ) +#' +#' # Example 9: regular logrank test at all 3 analyses in parallel +#' plan("multisession", workers = 2) +#' sim_gs_n( +#' n_sim = 3, +#' sample_size = 400, +#' enroll_rate = enroll_rate, +#' fail_rate = fail_rate, +#' test = wlr, +#' cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut), +#' weight = fh(rho = 0, gamma = 0) +#' ) +#' plan("sequential") #' } sim_gs_n <- function( n_sim = 1000, diff --git a/man/sim_gs_n.Rd b/man/sim_gs_n.Rd index d454562e..80bf338b 100644 --- a/man/sim_gs_n.Rd +++ b/man/sim_gs_n.Rd @@ -242,6 +242,19 @@ sim_gs_n( test = list(ia1 = ia1_test, ia2 = ia2_test, fa = fa_test), cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut) ) + +# Example 9: regular logrank test at all 3 analyses in parallel +plan("multisession", workers = 2) +sim_gs_n( + n_sim = 3, + sample_size = 400, + enroll_rate = enroll_rate, + fail_rate = fail_rate, + test = wlr, + cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut), + weight = fh(rho = 0, gamma = 0) +) +plan("sequential") } \dontshow{\}) # examplesIf} } diff --git a/tests/testthat/test-unvalidated-sim_gs_n.R b/tests/testthat/test-unvalidated-sim_gs_n.R index ebe164c4..b8b34735 100644 --- a/tests/testthat/test-unvalidated-sim_gs_n.R +++ b/tests/testthat/test-unvalidated-sim_gs_n.R @@ -41,6 +41,47 @@ test_that("regular logrank test", { expect_equal(observed, expected) }) +test_that("regular logrank test parallel", { + set.seed(2024) + plan("multisession", workers = 2) + observed <- sim_gs_n( + n_sim = 3, + sample_size = 400, + enroll_rate = test_enroll_rate(), + fail_rate = test_fail_rate(), + test = wlr, + cut = test_cutting(), + weight = fh(rho = 0, gamma = 0) + ) + plan("sequential") + expected <- data.frame( + sim_id = rep(1:3, each = 3L), + method = rep("WLR", 9L), + parameter = rep("FH(rho=0, gamma=0)", 9L), + analysis = rep(1:3, 3), + cut_date = c(24, 32, 45, 24, 32, 45, 24, 32, 45), + n = rep(400L, 9L), + event = c(244, 307, 362, 235, 310, 361, 222, 286, 351), + estimate = c( + -14.8967761757316, -22.6791676993923, -29.4104630799085, + -13.3530329578349, -17.9272135845997, -25.9789692783839, + -15.7016927028295, -22.7155477802184, -34.9030500614426 + ), + se = c( + 7.79986198971421, 8.70892718893558, 9.29168172400568, + 7.65165409688827, 8.77164253357172, 9.41875140383468, + 7.44263362582829, 8.42150520256931, 9.20559144909002 + ), + z = c( + -1.90987689210094, -2.60412875287388, -3.16524650257064, + -1.74511717188905, -2.04376928448542, -2.75821795952773, + -2.10969577332675, -2.6973263370173, -3.79150544041283 + ) + ) + expect_equal(observed, expected) +}) + + test_that("weighted logrank test by FH(0, 0.5)", { set.seed(2024) observed <- sim_gs_n(