Merge pull request #249 from cmansch/main

Adding %doFuture% parallel framework for the sim_gs_n.R code and upda…

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 = "[email protected]", role = c("aut")),
     person("Yujie", "Zhao", email = "[email protected]", role =  c("ctb","cre")),

R/global.R

@@ -50,6 +50,7 @@ utils::globalVariables(
     "period",
     "rate",
     "s",
+    "sim_id",
     "status",
     "stratum",
     "time",

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.
 #'
@@ -33,7 +38,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 +123,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 +134,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 +145,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 +156,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 +167,6 @@
 #'   fail_rate = fail_rate,
 #'   test = rmst,
 #'   cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut),
-#'   seed = 2024,
 #'   tau = 20
 #' )
 #'
@@ -179,7 +178,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 +192,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,9 +220,21 @@
 #'   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)
+#' )
+#'
+#' # 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),
-#'   seed = 2024
+#'   weight = fh(rho = 0, gamma = 0)
 #' )
+#' plan("sequential")
 #' }
 sim_gs_n <- function(
     n_sim = 1000,
@@ -242,15 +251,30 @@ 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),
+    test = replicate(n=n_sim, expr=test, simplify = FALSE),
+    .combine = "rbind",
+    .errorhandling = "stop",
+    .options.future = list(seed = TRUE)
+  ) %dofuture% {
     # Generate data
     simu_data <- sim_pw_surv(
       n = sample_size,
@@ -265,7 +289,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,9 +324,10 @@ 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
   }
   return(ans)
 }