Merge pull request #518 from Merck/516-symmetric-design-issue-with-to_integer

Symmetric design issue with `to_integer`

Author: keaven

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: gsDesign2
 Title: Group Sequential Design with Non-Constant Effect
-Version: 1.1.3.2
+Version: 1.1.3.3
 Authors@R: c(
     person("Keaven", "Anderson", email = "[email protected]", role = c("aut")),
     person("Yilong", "Zhang", email = "[email protected]", role = c("aut")),

R/gs_power_ahr.R

@@ -122,8 +122,8 @@
 #' # Events = max(events, calculated events for targeted analysis_time)
 #' \donttest{
 #' gs_power_ahr(
-#'   analysis_time = c(12, 24, 36),
-#'   event = c(30, 40, 50),
+#'   analysis_time = c(12, 24, 36), 
+#'   event = c(30, 40, 50), h1_spending = FALSE,
 #'   binding = TRUE,
 #'   upper = gs_spending_bound,
 #'   upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025),
@@ -152,6 +152,7 @@ gs_power_ahr <- function(
     test_upper = TRUE,
     ratio = 1,
     binding = FALSE,
+    h1_spending = TRUE,
     info_scale = c("h0_h1_info", "h0_info", "h1_info"),
     r = 18,
     tol = 1e-6,
@@ -207,18 +208,26 @@ gs_power_ahr <- function(
     x$info <- x$info * q
   }
 
+  if (h1_spending) { 
+      theta1 <- x$theta
+      info1 <- x$info
+  } else {
+      theta1 <- 0
+      info1 <- x$info0
+  }
+    
   # Given the above statistical information, calculate the power ----
   y_h1 <- gs_power_npe(
-    theta = x$theta,
-    info = x$info, info0 = x$info0, info1 = x$info, info_scale = info_scale,
+    theta = x$theta, theta0 = 0, theta1 = theta1,
+    info = x$info, info0 = x$info0, info1 = info1, info_scale = info_scale,
     upper = upper, upar = upar, test_upper = test_upper,
     lower = lower, lpar = lpar, test_lower = test_lower,
     binding = binding, r = r, tol = tol
   )
 
   y_h0 <- gs_power_npe(
-    theta = 0, theta0 = 0, theta1 = x$theta,
-    info = x$info0, info0 = x$info0, info1 = x$info, info_scale = info_scale,
+    theta = 0, theta0 = 0, theta1 = theta1,
+    info = x$info0, info0 = x$info0, info1 = info1, info_scale = info_scale,
     upper = upper, upar = upar, test_upper = test_upper,
     lower = if (!two_sided) {
       gs_b

R/to_integer.R

@@ -468,6 +468,7 @@ to_integer.gs_design <- function(x, round_up_final = TRUE, ratio = x$input$ratio
       interval = c(0.01, max(x$analysis$time) + 100),
       integer = TRUE
     )
+    if (is_ahr) power_args["h1_spending"] <- x$input["h1_spending"]
     if (is_wlr) power_args[c("weight", "approx")] <- x$input[c("weight", "approx")]
     x_new <- do.call(if (is_wlr) gs_power_wlr else gs_power_ahr, power_args)
   } else {

man/gs_power_ahr.Rd

@@ -138,3 +138,16 @@ test_that("Use default lower, lpar and test_lower", {
   expect_error(gs_power_ahr(analysis_time = c(24, 36),
                             event = c(50, 100)))
 })
+
+test_that("Validate the boundary is symmetric in symmetric designs.", {
+  x <- gs_design_ahr(analysis_time = 36, info_frac = 1:3/3,
+                     upper = gs_spending_bound,
+                     upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025),
+                     lower = gs_spending_bound,
+                     lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025),
+                     binding = TRUE, h1_spending = FALSE) %>%
+  to_integer()
+
+  expect_equal(x$bound$z[x$bound$bound == "upper"],
+               -x$bound$z[x$bound$bound == "lower"])
+})

tests/testthat/test-developer-gs_power_ahr.R

@@ -248,3 +248,16 @@ test_that("Validate the sample size rounding under unequal randomization (3:2) f
   # error when ratio is negative
   expect_error(x |> to_integer(ratio = -2))
 })
+
+test_that("Validate the boundary is symmetric in symmetric designs.", {
+  x <- gs_design_ahr(analysis_time = 36, info_frac = 1:3/3, 
+                     upper = gs_spending_bound,
+                     upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025),
+                     lower = gs_spending_bound,
+                     lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.025),
+                     binding = TRUE, h1_spending = FALSE) %>%
+  to_integer()
+  
+  expect_equal(x$bound$z[x$bound$bound == "upper"], 
+               -x$bound$z[x$bound$bound == "lower"])
+})