Merge pull request #476 from Merck/472-ensure-integer-sample-size-and-number-of-events

472 ensure integer sample size and number of events

Author: LittleBeannie

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: gsDesign2
 Title: Group Sequential Design with Non-Constant Effect
-Version: 1.1.2.23
+Version: 1.1.2.24
 Authors@R: c(
     person("Keaven", "Anderson", email = "keaven_anderson@merck.com", role = c("aut")),
     person("Yilong", "Zhang", email = "elong0527@gmail.com", role = c("aut")),

R/gs_power_ahr.R

@@ -53,9 +53,12 @@
 #' @param tol Tolerance parameter for boundary convergence (on Z-scale).
 #' @param interval An interval that is presumed to include the time at which
 #'   expected event count is equal to targeted event.
+#' @param integer Logical value integer whether it is an integer design
+#' (i.e., integer sample size and events) or not. This argument is commonly
+#' used when creating integer design via [to_integer()].
 #'
-#' @return A tibble with columns `Analysis`, `Bound`, `Z`, `Probability`,
-#'   `theta`, `Time`, `AHR`, `Events`.
+#' @return A tibble with columns `analysis`, `bound`, `z`, `probability`,
+#'   `theta`, `time`, `ahr`, `event`.
 #'   Contains a row for each analysis and each bound.
 #'
 #' @details
@@ -159,7 +162,8 @@ gs_power_ahr <- function(
     info_scale = c("h0_h1_info", "h0_info", "h1_info"),
     r = 18,
     tol = 1e-6,
-    interval = c(.01, 1000)) {
+    interval = c(.01, 1000),
+    integer = FALSE) {
   # Get the number of analysis
   n_analysis <- max(length(event), length(analysis_time), na.rm = TRUE)
 
@@ -197,6 +201,19 @@ gs_power_ahr <- function(
     interval = interval
   )
 
+  # if both events and sample size are integers, then elaborate the info and info0
+  if (integer) {
+
+    # elaborate info0
+    q_e <- ratio / (1 + ratio)
+    q_c <- 1 - q_e
+    x$info0 <- event * q_e * q_c
+
+    # elaborate info
+    q <- event / x$event
+    x$info <- x$info * q
+  }
+
   # Given the above statistical information, calculate the power ----
   y_h1 <- gs_power_npe(
     theta = x$theta,

R/gs_power_wlr.R

@@ -181,7 +181,8 @@ gs_power_wlr <- function(enroll_rate = define_enroll_rate(duration = c(2, 2, 10)
                          approx = "asymptotic",
                          r = 18,
                          tol = 1e-6,
-                         interval = c(.01, 1000)) {
+                         interval = c(.01, 1000),
+                         integer = FALSE) {
   # check of inputted sample size
   input_sample_size <- sum(enroll_rate$rate * enroll_rate$duration)
 

R/to_integer.R

@@ -308,7 +308,19 @@ to_integer.gs_design <- function(x, sample_size = TRUE, ...) {
           analysis_time = NULL
         )
 
-        upar_new$timing <- info_with_new_event$info / max(info_with_new_event$info)
+        # ensure info0 is based on integer sample size calculation
+        # as as they become a slight different number due to the `enroll_rate`
+        q_e <- x$input$ratio / (1 + x$input$ratio)
+        q_c <- 1 - q_e
+        info_with_new_event$info0 <- event_new * q_e * q_c
+
+        # ensure info is based on integer sample size calculation
+        # as as they become a slight different number due to the `enroll_rate`
+        q <- event_new / event
+        info_with_new_event$info <- x$analysis$info * q
+
+        # update timing
+        upar_new$timing <- info_with_new_event$info0 / max(info_with_new_event$info0)
       }
     }
 
@@ -338,7 +350,8 @@ to_integer.gs_design <- function(x, sample_size = TRUE, ...) {
       test_lower = x$input$test_lower,
       binding = x$input$binding,
       info_scale = x$input$info_scale, r = x$input$r, tol = x$input$tol,
-      interval = c(0.01, max(x$analysis$time) + 100)
+      interval = c(0.01, max(x$analysis$time) + 100),
+      integer = TRUE
     )
     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)

man/gs_power_ahr.Rd

@@ -137,4 +137,4 @@ test_that("Use default lower, lpar and test_lower", {
   # return an error message asking for total spend for the futility test
   expect_error(gs_power_ahr(analysis_time = c(24, 36),
                             event = c(50, 100)))
-})
+})

man/gs_power_wlr.Rd

@@ -17,3 +17,37 @@ test_that("The IA nominal p-value is the same as the IA alpha spending.", {
     gsDesign::sfLDOF(alpha = 0.025, t = 18 / 30)$spend[1]
   )
 })
+
+test_that("The statistcial information under null equals to event/4 udner equal randomization.", {
+  enroll_rate <- define_enroll_rate(duration = c(2, 2, 2, 6),
+                                    rate = 1:4)
+  fail_rate <- define_fail_rate(duration = Inf,
+                                fail_rate = log(2) / 10,
+                                hr = .7,
+                                dropout_rate = 0.001)
+
+  alpha <- 0.025
+  beta <- 0.1
+  ratio <- 1
+
+  x <- gs_design_ahr(
+    enroll_rate = enroll_rate, fail_rate = fail_rate,
+    ratio = ratio,
+    beta = beta,
+    alpha = alpha,
+    # Information fraction at analyses and trial duration
+    info_frac = c(0.6, 0.8, 1),
+    analysis_time = 48,
+    # Function and parameter(s) for upper spending bound
+    upper = gs_spending_bound,
+    upar = list(sf = gsDesign::sfLDOF, total_spend = alpha, param = NULL),
+    test_upper = c(FALSE, TRUE, TRUE),
+    lower = gs_spending_bound,
+    lpar = list(sf = gsDesign::sfHSD, total_spend = beta, param = -4) ,
+    test_lower = c(TRUE, FALSE,FALSE),
+    binding = FALSE
+    ) |>
+    to_integer()
+
+  expect_true(all(x$analysis$info0 - x$analysis$event / 4 == 0))
+})