Merge pull request #339 from jdblischak/sim-gs-n-ex11

Add bounds to sim_gs_n() output using {data.table}

Author: LittleBeannie

NAMESPACE

@@ -45,6 +45,8 @@ importFrom(data.table,merge.data.table)
 importFrom(data.table,rbindlist)
 importFrom(data.table,setDF)
 importFrom(data.table,setDT)
+importFrom(data.table,setcolorder)
+importFrom(data.table,setnames)
 importFrom(data.table,setorderv)
 importFrom(data.table,uniqueN)
 importFrom(doFuture,"%dofuture%")

R/sim_gs_n.R

@@ -53,7 +53,7 @@
 #' @return A data frame summarizing the simulation ID, analysis date,
 #'   z statistics or p-values.
 #'
-#' @importFrom data.table rbindlist setDF
+#' @importFrom data.table as.data.table dcast rbindlist setcolorder setDF setnames
 #'
 #' @export
 #'
@@ -408,10 +408,13 @@ sim_gs_n <- function(
     # Add planned and updated bounds
     if (!is.null(original_design) && is_logrank){
       # Add planned bounds
-      ans_1sim <- ans_1sim |>
-        dplyr::left_join(original_design$bound |> dplyr::filter(bound == "upper") |> dplyr::select(analysis, z) |> dplyr::rename(planed_upper_bound = z)) |>
-        dplyr::left_join(original_design$bound |> dplyr::filter(bound == "lower") |> dplyr::select(analysis, z) |> dplyr::rename(planed_lower_bound = z))
-
+      planned_bounds <- as.data.table(original_design$bound)
+      planned_bounds <- dcast(planned_bounds, analysis ~ bound, fill = NA, drop = FALSE, value.var = "z")
+      setnames(planned_bounds, c("analysis", "planned_lower_bound", "planned_upper_bound"))
+      # workaround for the fact that merge() moves the "by" column to be first
+      final_column_order <- union(colnames(ans_1sim), colnames(planned_bounds))
+      ans_1sim <- merge(ans_1sim, planned_bounds, all.x = TRUE, sort = FALSE)
+      setcolorder(ans_1sim, final_column_order)
 
       # Calculate ustime and lstime
       obs_event <- with(event_tbl, tapply(event, analysis, sum, simplify = TRUE))
@@ -437,9 +440,13 @@ sim_gs_n <- function(
                                                  lstime = if(all(original_design$bound$bound == "upper")){NULL}else{lstime},
                                                  event_tbl = event_tbl)
 
-      ans_1sim <- ans_1sim |>
-        dplyr::left_join(updated_design$bound |> dplyr::filter(bound == "upper") |> dplyr::select(analysis, z) |> dplyr::rename(updated_upper_bound = z)) |>
-        dplyr::left_join(updated_design$bound |> dplyr::filter(bound == "lower") |> dplyr::select(analysis, z) |> dplyr::rename(updated_lower_bound = z))
+      updated_bounds <- as.data.table(updated_design$bound)
+      updated_bounds <- dcast(updated_bounds, analysis ~ bound, fill = NA, drop = FALSE, value.var = "z")
+      setnames(updated_bounds, c("analysis", "updated_lower_bound", "updated_upper_bound"))
+      # workaround for the fact that merge() moves the "by" column to be first
+      final_column_order <- union(colnames(ans_1sim), colnames(updated_bounds))
+      ans_1sim <- merge(ans_1sim, updated_bounds, all.x = TRUE, sort = FALSE)
+      setcolorder(ans_1sim, final_column_order)
     }
 
     ans_1sim

tests/testthat/test-unvalidated-sim_gs_n.R

@@ -662,6 +662,8 @@ test_that("create_cut() can accept variables as arguments", {
 })
 
 test_that("Updating bounds changes the simulation results", {
+  skip_if_not_installed("gsDesign2")
+
   x <- gsDesign2::gs_design_ahr(analysis_time = 1:3*12) |>
     gsDesign2::to_integer()
 
@@ -702,7 +704,56 @@ test_that("Updating bounds changes the simulation results", {
     updated_upper_bound = c(3.870248012128966, 2.3867954048423474, 2.0074221828251764),
     updated_lower_bound = c(-1.6671962217546439, 0.9631736579151768, 2.1126105535696467)
   )
-  observed <- run2[, c("planed_upper_bound", "planed_lower_bound",
+  observed <- run2[, c("planned_upper_bound", "planned_lower_bound",
                        "updated_upper_bound", "updated_lower_bound")]
   expect_equal(observed, expected, ignore_attr = TRUE)
 })
+
+test_that("sim_gs_n() can update bounds even when some are missing", {
+  # https://github.com/Merck/simtrial/issues/335
+
+  skip_if_not_installed("gsDesign2")
+
+  # futility - IA1; efficacy - IA2 & FA
+  x <- gsDesign2::gs_design_ahr(
+    alpha = 0.025,
+    beta = 0.1,
+    analysis_time = 1:3*12,
+    upper = gsDesign2::gs_spending_bound,
+    upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025),
+    test_upper = c(FALSE, TRUE, TRUE),
+    lower = gsDesign2::gs_spending_bound,
+    lpar = list(sf = gsDesign::sfHSD, param = -4, total_spend = 0.01),
+    test_lower = c(TRUE, FALSE, FALSE)
+  ) |> gsDesign2::to_integer()
+
+  set.seed(1)
+  observed <- sim_gs_n(
+    n_sim = 1,
+    sample_size = max(x$analysis$n),
+    enroll_rate = x$enroll_rate,
+    fail_rate = x$fail_rate,
+    test = wlr,
+    weight = fh(rho = 0, gamma = 0),
+    cut = list(ia1 = create_cut(planned_calendar_time = x$analysis$time[1]),
+               ia2 = create_cut(planned_calendar_time = x$analysis$time[2]),
+               fa = create_cut(planned_calendar_time = x$analysis$time[3])),
+    original_design = x)
+
+  expect_equal(
+    observed$planned_upper_bound,
+    c(NA, 2.35835648246416, 2.00932773528063)
+  )
+  expect_equal(
+    observed$planned_lower_bound,
+    c(-2.31975897600847, NA, NA)
+  )
+  expect_equal(
+    observed$updated_upper_bound,
+    c(Inf, 2.46416041021134, 1.99094670148633)
+  )
+  expect_equal(
+    observed$updated_lower_bound,
+    c(-2.72847356838699, -Inf, -Inf)
+  )
+})