From 84479c9dc6406d9233d11210c07fd61e10974620 Mon Sep 17 00:00:00 2001
From: Yihui Xie <xie@yihui.name>
Date: Thu, 8 Aug 2024 16:27:10 -0500
Subject: [PATCH 1/8] ceiling() and floor() guarantee integer values, so no
 need to call as.integer()

---
 R/to_integer.R | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/R/to_integer.R b/R/to_integer.R
index 6066428ec..50ce8bb89 100644
--- a/R/to_integer.R
+++ b/R/to_integer.R
@@ -98,7 +98,7 @@ to_integer.fixed_design <- function(x, sample_size = TRUE, ...) {
     mutate(rate = rate * ceiling(output_n / multiply_factor) * multiply_factor / output_n)
 
   # Round up the FA events
-  event_ceiling <- ceiling(x$analysis$event) |> as.integer()
+  event_ceiling <- ceiling(x$analysis$event)
 
   if ((x$design == "ahr") && (input_n != output_n)) {
     x_new <- gs_power_ahr(
@@ -277,9 +277,9 @@ to_integer.gs_design <- function(x, sample_size = TRUE, ...) {
     # Updated events
     event <- x$analysis$event
     if (n_analysis == 1) {
-      event_new <- ceiling(event) %>% as.integer()
+      event_new <- ceiling(event)
     } else {
-      event_new <- c(floor(event[1:(n_analysis - 1)]), ceiling(event[n_analysis])) %>% as.integer()
+      event_new <- c(floor(event[1:(n_analysis - 1)]), ceiling(event[n_analysis]))
     }
 
     # Updated sample size and enroll rate
@@ -338,9 +338,9 @@ to_integer.gs_design <- function(x, sample_size = TRUE, ...) {
     # Updated events to integer
     event <- x$analysis$event
     if (n_analysis == 1) {
-      event_new <- ceiling(event) %>% as.integer()
+      event_new <- ceiling(event)
     } else {
-      event_new <- c(floor(event[1:(n_analysis - 1)]), ceiling(event[n_analysis])) %>% as.integer()
+      event_new <- c(floor(event[1:(n_analysis - 1)]), ceiling(event[n_analysis]))
     }
 
     # Updated sample size to integer and enroll rates

From 08fb0b7afae4e3ada6d77fd7c946ce5e861816e1 Mon Sep 17 00:00:00 2001
From: Yihui Xie <xie@yihui.name>
Date: Thu, 8 Aug 2024 17:21:47 -0500
Subject: [PATCH 2/8] the code for the cases 'ahr' and 'wlr' are almost
 identical---the only difference is that for 'wlr', we call gs_power_wlr()
 with two additional arguments 'weight' and 'approx'

---
 R/to_integer.R | 70 ++++----------------------------------------------
 1 file changed, 5 insertions(+), 65 deletions(-)

diff --git a/R/to_integer.R b/R/to_integer.R
index 50ce8bb89..f97ab0a49 100644
--- a/R/to_integer.R
+++ b/R/to_integer.R
@@ -273,68 +273,8 @@ to_integer.gs_design <- function(x, sample_size = TRUE, ...) {
   n_analysis <- length(x$analysis$analysis)
   multiply_factor <- x$input$ratio + 1
 
-  if ("ahr" %in% class(x)) {
-    # Updated events
-    event <- x$analysis$event
-    if (n_analysis == 1) {
-      event_new <- ceiling(event)
-    } else {
-      event_new <- c(floor(event[1:(n_analysis - 1)]), ceiling(event[n_analysis]))
-    }
-
-    # Updated sample size and enroll rate
-    sample_size_new <- (ceiling(x$analysis$n[n_analysis] / multiply_factor) * multiply_factor) %>% as.integer()
-    enroll_rate <- x$enroll_rate
-    enroll_rate_new <- enroll_rate %>%
-      mutate(rate = rate * sample_size_new / x$analysis$n[n_analysis])
-
-    # Updated upar
-    # If it is spending bounds
-    # Scenario 1: information-based spending
-    # Scenario 2: calendar-based spending
-    if (identical(x$input$upper, gs_b)) {
-      upar_new <- x$input$upar
-    } else if (identical(x$input$upper, gs_spending_bound)) {
-      upar_new <- x$input$upar
-      if (!("timing" %in% names(x$input$upar))) {
-        info_with_new_event <- gs_info_ahr(
-          enroll_rate = enroll_rate_new,
-          fail_rate = x$input$fail_rate,
-          ratio = x$input$ratio,
-          event = event_new,
-          analysis_time = NULL
-        )
-
-        upar_new$timing <- info_with_new_event$info / max(info_with_new_event$info)
-      }
-    }
-
-    # Updated lpar
-    if (identical(x$input$lower, gs_b)) {
-      lpar_new <- x$input$lpar
-    } else if (identical(x$input$lower, gs_spending_bound)) {
-      lpar_new <- x$input$lpar
-      if (!("timing" %in% names(x$input$lpar))) {
-        lpar_new$timing <- upar_new$timing
-      }
-    }
-
-    # Updated design with integer events and sample size
-    x_new <- gs_power_ahr(
-      enroll_rate = enroll_rate_new,
-      fail_rate = x$input$fail_rate,
-      event = event_new,
-      analysis_time = NULL,
-      ratio = x$input$ratio,
-      upper = x$input$upper, upar = upar_new,
-      lower = x$input$lower, lpar = lpar_new,
-      test_upper = x$input$test_upper,
-      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)
-    )
-  } else if ("wlr" %in% class(x)) {
+  if (inherits(x, c("ahr", "wlr"))) {
+    is_wlr <- inherits(x, "wlr")
     # Updated events to integer
     event <- x$analysis$event
     if (n_analysis == 1) {
@@ -384,7 +324,7 @@ to_integer.gs_design <- function(x, sample_size = TRUE, ...) {
     }
 
     # Updated design with integer events and sample size
-    x_new <- gs_power_wlr(
+    power_args = list(
       enroll_rate = enroll_rate_new,
       fail_rate = x$input$fail_rate,
       event = event_new,
@@ -396,10 +336,10 @@ 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,
-      weight = x$input$weight,
-      approx = x$input$approx,
       interval = c(0.01, max(x$analysis$time) + 100)
     )
+    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 if ("rd" %in% class(x)) {
     n_stratum <- length(x$input$p_c$stratum)
 

From 0944087a38f3169530e158a4bfede4a858da1474 Mon Sep 17 00:00:00 2001
From: Yihui Xie <xie@yihui.name>
Date: Thu, 8 Aug 2024 17:29:50 -0500
Subject: [PATCH 3/8] rename is_almost_k() to almost_equal()

---
 R/pw_info.R     |  2 +-
 R/to_integer.R  | 10 +++++-----
 R/utility_wlr.R |  4 ++--
 3 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/R/pw_info.R b/R/pw_info.R
index 90f55339c..0c5dd6b98 100644
--- a/R/pw_info.R
+++ b/R/pw_info.R
@@ -239,7 +239,7 @@ pw_info <- function(
   ans <- ans[order(t), .SD, by = .(time, stratum)]
 
   # filter out the rows with 0 events
-  ans <- ans[!is_almost_k(event, 0L)]
+  ans <- ans[!almost_equal(event, 0L)]
   setcolorder(ans, neworder = c("time", "stratum", "t", "hr", "n", "event", "info", "info0"))
 
   setDF(ans)
diff --git a/R/to_integer.R b/R/to_integer.R
index f97ab0a49..e17413576 100644
--- a/R/to_integer.R
+++ b/R/to_integer.R
@@ -200,11 +200,11 @@ to_integer.fixed_design <- function(x, sample_size = TRUE, ...) {
 
   # Make n and event of ans$analysis exactly integers
   if ("fixed_design" %in% class(ans)) {
-    if (is_almost_k(x = ans$analysis$n, k = round(ans$analysis$n))) {
+    if (almost_equal(x = ans$analysis$n, k = round(ans$analysis$n))) {
       ans$analysis$n <- round(ans$analysis$n)
     }
 
-    if (is_almost_k(x = ans$analysis$event, k = round(ans$analysis$event))) {
+    if (almost_equal(x = ans$analysis$event, k = round(ans$analysis$event))) {
       ans$analysis$event <- round(ans$analysis$event)
     }
   }
@@ -433,17 +433,17 @@ to_integer.gs_design <- function(x, sample_size = TRUE, ...) {
   # Make n and event of x_new$analysis exactly integers
   if ("ahr" %in% class(x) || "wlr" %in% class(x)) {
     for (i in seq_len(n_analysis)) {
-      if (is_almost_k(x = x_new$analysis$n[i], k = round(x_new$analysis$n[i]))) {
+      if (almost_equal(x = x_new$analysis$n[i], k = round(x_new$analysis$n[i]))) {
         x_new$analysis$n[i] <- round(x_new$analysis$n[i])
       }
 
-      if (is_almost_k(x = x_new$analysis$event[i], k = round(x_new$analysis$event[i]))) {
+      if (almost_equal(x = x_new$analysis$event[i], k = round(x_new$analysis$event[i]))) {
         x_new$analysis$event[i] <- round(x_new$analysis$event[i])
       }
     }
   } else if ("rd" %in% class(x)) {
     for (i in seq_len(n_analysis)) {
-      if (is_almost_k(x = x_new$analysis$n[i], k = round(x_new$analysis$n[i]))) {
+      if (almost_equal(x = x_new$analysis$n[i], k = round(x_new$analysis$n[i]))) {
         x_new$analysis$n[i] <- round(x_new$analysis$n[i])
       }
     }
diff --git a/R/utility_wlr.R b/R/utility_wlr.R
index 56c7c0f8c..5622f29ed 100644
--- a/R/utility_wlr.R
+++ b/R/utility_wlr.R
@@ -273,6 +273,6 @@ gs_sigma2_wlr <- function(arm0,
 }
 
 #' @noRd
-is_almost_k <- function(x, k, tol = .Machine$double.eps^0.5) {
+almost_equal <- function(x, k, tol = .Machine$double.eps^0.5) {
   abs(x - k) < tol
-}
\ No newline at end of file
+}

From 65d5f3ca9cac3bf3cfc9a29bbc873f32c45471eb Mon Sep 17 00:00:00 2001
From: Yihui Xie <xie@yihui.name>
Date: Thu, 8 Aug 2024 17:36:18 -0500
Subject: [PATCH 4/8] vectorize rounding---no need to use for-loops

---
 R/to_integer.R  | 27 ++++++++-------------------
 R/utility_wlr.R |  8 ++++++++
 2 files changed, 16 insertions(+), 19 deletions(-)

diff --git a/R/to_integer.R b/R/to_integer.R
index e17413576..8933660ab 100644
--- a/R/to_integer.R
+++ b/R/to_integer.R
@@ -273,8 +273,10 @@ to_integer.gs_design <- function(x, sample_size = TRUE, ...) {
   n_analysis <- length(x$analysis$analysis)
   multiply_factor <- x$input$ratio + 1
 
-  if (inherits(x, c("ahr", "wlr"))) {
-    is_wlr <- inherits(x, "wlr")
+  is_ahr <- inherits(x, "ahr")
+  is_wlr <- inherits(x, "wlr")
+  is_rd  <- inherits(x, "rd")
+  if (is_ahr || is_wlr) {
     # Updated events to integer
     event <- x$analysis$event
     if (n_analysis == 1) {
@@ -340,7 +342,7 @@ to_integer.gs_design <- function(x, sample_size = 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)
-  } else if ("rd" %in% class(x)) {
+  } else if (is_rd) {
     n_stratum <- length(x$input$p_c$stratum)
 
     # Update unstratified sample size to integer
@@ -431,22 +433,9 @@ to_integer.gs_design <- function(x, sample_size = TRUE, ...) {
   }
 
   # Make n and event of x_new$analysis exactly integers
-  if ("ahr" %in% class(x) || "wlr" %in% class(x)) {
-    for (i in seq_len(n_analysis)) {
-      if (almost_equal(x = x_new$analysis$n[i], k = round(x_new$analysis$n[i]))) {
-        x_new$analysis$n[i] <- round(x_new$analysis$n[i])
-      }
-
-      if (almost_equal(x = x_new$analysis$event[i], k = round(x_new$analysis$event[i]))) {
-        x_new$analysis$event[i] <- round(x_new$analysis$event[i])
-      }
-    }
-  } else if ("rd" %in% class(x)) {
-    for (i in seq_len(n_analysis)) {
-      if (almost_equal(x = x_new$analysis$n[i], k = round(x_new$analysis$n[i]))) {
-        x_new$analysis$n[i] <- round(x_new$analysis$n[i])
-      }
-    }
+  if (is_ahr || is_wlr || is_rd) {
+    x_new$analysis$n <- round2(x_new$analysis$n)
+    if (!is_rd) x_new$analysis$event <- round2(x_new$analysis$event)
   }
 
   return(x_new)
diff --git a/R/utility_wlr.R b/R/utility_wlr.R
index 5622f29ed..3fe861181 100644
--- a/R/utility_wlr.R
+++ b/R/utility_wlr.R
@@ -276,3 +276,11 @@ gs_sigma2_wlr <- function(arm0,
 almost_equal <- function(x, k, tol = .Machine$double.eps^0.5) {
   abs(x - k) < tol
 }
+
+# Round a number only if it is close enough to the rounded value
+round2 <- function(x) {
+  y <- round(x)
+  i <- almost_equal(x, y)
+  x[i] <- y[i]
+  x
+}

From c2bdec2256b49bdc1882f127debf0f0e4e0c0833 Mon Sep 17 00:00:00 2001
From: Yihui Xie <xie@yihui.name>
Date: Thu, 8 Aug 2024 17:39:39 -0500
Subject: [PATCH 5/8] return early when the input `x` is not ahr, wlr, or rd

---
 DESCRIPTION    |  2 +-
 R/to_integer.R | 24 ++++++++++++------------
 2 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 50e4c642d..935d639d1 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: gsDesign2
 Title: Group Sequential Design with Non-Constant Effect
-Version: 1.1.2.18
+Version: 1.1.2.19
 Authors@R: c(
     person("Keaven", "Anderson", email = "keaven_anderson@merck.com", role = c("aut")),
     person("Yilong", "Zhang", email = "elong0527@gmail.com", role = c("aut")),
diff --git a/R/to_integer.R b/R/to_integer.R
index 8933660ab..8361a75a3 100644
--- a/R/to_integer.R
+++ b/R/to_integer.R
@@ -270,13 +270,18 @@ to_integer.fixed_design <- function(x, sample_size = TRUE, ...) {
 #' gsDesign::sfLDOF(alpha = 0.025, t = 18 / 30)$spend
 #' }
 to_integer.gs_design <- function(x, sample_size = TRUE, ...) {
-  n_analysis <- length(x$analysis$analysis)
-  multiply_factor <- x$input$ratio + 1
-
   is_ahr <- inherits(x, "ahr")
   is_wlr <- inherits(x, "wlr")
   is_rd  <- inherits(x, "rd")
-  if (is_ahr || is_wlr) {
+  if (!(is_ahr || is_wlr || is_rd)) {
+    message("The input object is not applicable to get an integer sample size.")
+    return(x)
+  }
+
+  n_analysis <- length(x$analysis$analysis)
+  multiply_factor <- x$input$ratio + 1
+
+  if (!is_rd) {
     # Updated events to integer
     event <- x$analysis$event
     if (n_analysis == 1) {
@@ -342,7 +347,7 @@ to_integer.gs_design <- function(x, sample_size = 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)
-  } else if (is_rd) {
+  } else {
     n_stratum <- length(x$input$p_c$stratum)
 
     # Update unstratified sample size to integer
@@ -427,16 +432,11 @@ to_integer.gs_design <- function(x, sample_size = TRUE, ...) {
       r = x$input$r,
       tol = x$input$tol
     )
-  } else {
-    message("The input object is not applicable to get an integer sample size.")
-    x_new <- x
   }
 
   # Make n and event of x_new$analysis exactly integers
-  if (is_ahr || is_wlr || is_rd) {
-    x_new$analysis$n <- round2(x_new$analysis$n)
-    if (!is_rd) x_new$analysis$event <- round2(x_new$analysis$event)
-  }
+  x_new$analysis$n <- round2(x_new$analysis$n)
+  if (!is_rd) x_new$analysis$event <- round2(x_new$analysis$event)
 
   return(x_new)
 }

From b7dd4acacbd4c626bc27b1b8637634beff8a9b3b Mon Sep 17 00:00:00 2001
From: Yihui Xie <xie@yihui.name>
Date: Thu, 8 Aug 2024 17:41:55 -0500
Subject: [PATCH 6/8] only call suppressMessages() once

---
 R/to_integer.R | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/R/to_integer.R b/R/to_integer.R
index 8361a75a3..9d62e273d 100644
--- a/R/to_integer.R
+++ b/R/to_integer.R
@@ -360,16 +360,14 @@ to_integer.gs_design <- function(x, sample_size = TRUE, ...) {
     )
 
     # Update sample size per stratum
-    if (n_stratum == 1) {
-      suppressMessages(
+    suppressMessages(
+      if (n_stratum == 1) {
         tbl_n <- tibble::tibble(
           analysis = rep(1:n_analysis, each = n_stratum),
           stratum = rep(x$input$p_c$stratum, n_analysis)
         ) %>%
           left_join(sample_size_new)
-      )
-    } else {
-      suppressMessages(
+      } else {
         tbl_n <- tibble::tibble(
           analysis = rep(1:n_analysis, each = n_stratum),
           stratum = rep(x$input$p_c$stratum, n_analysis)
@@ -379,8 +377,8 @@ to_integer.gs_design <- function(x, sample_size = TRUE, ...) {
           mutate(n_new = prevalence * n) %>%
           select(-c(n, prevalence)) %>%
           dplyr::rename(n = n_new)
-      )
-    }
+      }
+    )
 
     # If it is spending bounds
     # Scenario 1: information-based spending

From f7520ea0c773f5eef1f8d81caa29aae949ad9b8c Mon Sep 17 00:00:00 2001
From: Yihui Xie <xie@yihui.name>
Date: Thu, 8 Aug 2024 17:46:03 -0500
Subject: [PATCH 7/8] remove the repeated code for the initial creation of
 tbl_n

---
 R/to_integer.R | 20 +++++++++-----------
 1 file changed, 9 insertions(+), 11 deletions(-)

diff --git a/R/to_integer.R b/R/to_integer.R
index 9d62e273d..d5805ea3a 100644
--- a/R/to_integer.R
+++ b/R/to_integer.R
@@ -360,25 +360,23 @@ to_integer.gs_design <- function(x, sample_size = TRUE, ...) {
     )
 
     # Update sample size per stratum
-    suppressMessages(
-      if (n_stratum == 1) {
-        tbl_n <- tibble::tibble(
-          analysis = rep(1:n_analysis, each = n_stratum),
-          stratum = rep(x$input$p_c$stratum, n_analysis)
-        ) %>%
+    suppressMessages({
+      tbl_n <- tibble::tibble(
+        analysis = rep(1:n_analysis, each = n_stratum),
+        stratum = rep(x$input$p_c$stratum, n_analysis)
+      )
+      tbl_n <- if (n_stratum == 1) {
+        tbl_n %>%
           left_join(sample_size_new)
       } else {
-        tbl_n <- tibble::tibble(
-          analysis = rep(1:n_analysis, each = n_stratum),
-          stratum = rep(x$input$p_c$stratum, n_analysis)
-        ) %>%
+        tbl_n %>%
           left_join(x$input$stratum_prev) %>%
           left_join(sample_size_new) %>%
           mutate(n_new = prevalence * n) %>%
           select(-c(n, prevalence)) %>%
           dplyr::rename(n = n_new)
       }
-    )
+    })
 
     # If it is spending bounds
     # Scenario 1: information-based spending

From a55297cfc02c0bb71196e1ae233088ad589d3533 Mon Sep 17 00:00:00 2001
From: Yihui Xie <xie@yihui.name>
Date: Fri, 9 Aug 2024 11:59:28 -0500
Subject: [PATCH 8/8] `=` -> `<-` [ci skip]

---
 R/to_integer.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/to_integer.R b/R/to_integer.R
index d5805ea3a..5663ed11a 100644
--- a/R/to_integer.R
+++ b/R/to_integer.R
@@ -331,7 +331,7 @@ to_integer.gs_design <- function(x, sample_size = TRUE, ...) {
     }
 
     # Updated design with integer events and sample size
-    power_args = list(
+    power_args <- list(
       enroll_rate = enroll_rate_new,
       fail_rate = x$input$fail_rate,
       event = event_new,