Big refactor to simplify S3 classes

NAMESPACE

@@ -1,10 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
-S3method(as_gt,fixed_design)
-S3method(as_gt,gs_design)
+S3method(as_gt,fixed_design_summary)
+S3method(as_gt,gs_design_summary)
 S3method(as_gt,simtrial_gs_wlr)
-S3method(as_rtf,fixed_design)
-S3method(as_rtf,gs_design)
+S3method(as_rtf,fixed_design_summary)
+S3method(as_rtf,gs_design_summary)
 S3method(summary,fixed_design)
 S3method(summary,gs_design)
 S3method(to_integer,fixed_design)

R/as_gt.R

@@ -78,60 +78,22 @@ as_gt <- function(x, ...) {
 #' ) |>
 #'   summary() |>
 #'   as_gt()
-as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) {
-  method <- fd_method(x)
-  ans <- gt::gt(x) |>
-    gt::tab_header(title = title %||% fd_title(method))
-  if (!isFALSE(footnote)) ans <- ans |>
-    gt::tab_footnote(
-      footnote = footnote %||% fd_footnote(x, method),
-      locations = gt::cells_title(group = "title")
-    )
-  return(ans)
-}
-
-get_method <- function(x, methods) intersect(methods, class(x))[1]
+as_gt.fixed_design_summary <- function(x, title = NULL, footnote = NULL, ...) {
+  if (is.null(title)) title <- attr(x, "title")
+  if (is.null(footnote)) footnote <- attr(x, "footnote")
 
-# get the fixed design method
-fd_method <- function(x) {
-  get_method(x, c("ahr", "fh", "mb", "lf", "rd", "maxcombo", "milestone", "rmst"))
-}
+  ans <- gt::gt(x) |>
+    gt::tab_header(title = title)
 
-# get the default title
-fd_title <- function(method) {
-  sprintf("Fixed Design %s Method", switch(
-    method,
-    ahr = "under AHR", fh = "under Fleming-Harrington", mb = "under Magirr-Burman",
-    lf = "under Lachin and Foulkes", maxcombo = "under MaxCombo",
-    milestone = "under Milestone", rmst = "under Restricted Mean Survival Time",
-    rd = "of Risk Difference under Farrington-Manning"
-  ))
-}
+  if (!isFALSE(footnote)) {
+    ans <- ans |>
+      gt::tab_footnote(
+        footnote = footnote,
+        locations = gt::cells_title(group = "title")
+      )
+  }
 
-# get the default footnote
-fd_footnote <- function(x, method) {
-  switch(
-    method,
-    ahr = "Power computed with average hazard ratio method.",
-    fh = paste(
-      "Power for Fleming-Harrington test", substring(x$Design, 19),
-      "using method of Yung and Liu."
-    ),
-    lf = paste(
-      "Power using Lachin and Foulkes method applied using expected",
-      "average hazard ratio (AHR) at time of planned analysis."
-    ),
-    rd = paste(
-      "Risk difference power without continuity correction using method of",
-      "Farrington and Manning."
-    ),
-    maxcombo = paste0(
-      "Power for MaxCombo test with Fleming-Harrington tests ",
-      substring(x$Design, 9), "."
-    ),
-    # for mb, milestone, and rmst
-    paste("Power for", x$Design, "computed with method of Yung and Liu.")
-  )
+  return(ans)
 }
 
 #' @rdname as_gt
@@ -243,7 +205,7 @@ fd_footnote <- function(x, method) {
 #'   summary() |>
 #'   as_gt(display_columns = c("Analysis", "Bound", "Nominal p", "Z", "Probability"))
 #' }
-as_gt.gs_design <- function(
+as_gt.gs_design_summary <- function(
     x,
     title = NULL,
     subtitle = NULL,
@@ -355,7 +317,7 @@ gsd_footnote <- function(method, columns) {
 # footnote for non-binding designs
 gsd_footnote_nb <- function(x, x_alpha) {
   full_alpha <- attr(x, "full_alpha")
-  if (!inherits(x, "non_binding") || x_alpha >= full_alpha) return()
+  if (attr(x, "binding") || x_alpha >= full_alpha) return()
   a1 <- format(x_alpha, scientific = FALSE)
   a2 <- format(full_alpha, scientific = FALSE)
   a3 <- format(full_alpha - x_alpha, scientific = FALSE)
@@ -387,7 +349,7 @@ gsd_parts <- function(
   x, title, subtitle, spannersub, footnote, bound, columns, inf_bound,
   transform = identity
 ) {
-  method <- intersect(c("ahr", "wlr", "combo", "rd"), class(x))[1]
+  method <- attr(x, "design")
   if (!inf_bound) x <- filter(x, !is.infinite(Z))
   # `x` needs a custom transformation in as_rtf()
   x2 <- transform(x)

R/as_rtf.R

@@ -90,7 +90,7 @@ as_rtf <- function(x, ...) {
 #' ) |>
 #'   summary() |>
 #'   as_rtf(file = tempfile(fileext = ".rtf"))
-as_rtf.fixed_design <- function(
+as_rtf.fixed_design_summary <- function(
     x,
     title = NULL,
     footnote = NULL,
@@ -100,9 +100,10 @@ as_rtf.fixed_design <- function(
     file,
     ...) {
   orientation <- match.arg(orientation)
-  method <- fd_method(x)
-  title <- title %||% paste(fd_title(method), "{^a}")
-  footnote <- footnote %||% paste("{^a}", fd_footnote(x, method))
+  if (is.null(title)) title <- attr(x, "title")
+  if (is.null(footnote)) footnote <- attr(x, "footnote")
+  title <- paste(title, "{^a}")
+  footnote <- paste("{^a}", footnote)
 
   # set default column width
   n_row <- nrow(x)
@@ -266,7 +267,7 @@ check_rel_width <- function(width, n_col) {
 #'     file = tempfile(fileext = ".rtf")
 #'   )
 #' }
-as_rtf.gs_design <- function(
+as_rtf.gs_design_summary <- function(
     x,
     title = NULL,
     subtitle = NULL,

R/fixed_design_ahr.R

@@ -122,6 +122,8 @@ fixed_design_ahr <- function(
       info_scale = info_scale
     )
   }
+
+  # Prepare output ----
   ans <- tibble(
     design = "ahr",
     n = d$analysis$n,
@@ -132,10 +134,16 @@ fixed_design_ahr <- function(
     alpha = alpha,
     power = (d$bound |> filter(bound == "upper"))$probability
   )
-  y <- list(
-    input = input, enroll_rate = d$enroll_rate,
-    fail_rate = d$fail_rate, analysis = ans, design = "ahr"
+  y <- structure(
+    list(
+      input = input, enroll_rate = d$enroll_rate, fail_rate = d$fail_rate,
+      analysis = ans, design = "ahr"
+    ),
+    class = "fixed_design",
+    design_display = "Average hazard ratio",
+    title = "Fixed Design under AHR Method",
+    footnote = "Power computed with average hazard ratio method."
   )
-  class(y) <- c("fixed_design", class(y))
+
   return(y)
 }

R/fixed_design_fh.R

@@ -121,6 +121,8 @@ fixed_design_fh <- function(
       info_scale = info_scale
     )
   }
+
+  # Prepare output ----
   ans <- tibble(
     design = "fh",
     n = d$analysis$n,
@@ -131,11 +133,23 @@ fixed_design_fh <- function(
     alpha = alpha,
     power = (d$bound |> filter(bound == "upper"))$probability
   )
-  y <- list(
-    input = input, enroll_rate = d$enroll_rate, fail_rate = d$fail_rate,
-    analysis = ans,
-    design = "fh", design_par = list(rho = rho, gamma = gamma)
+  design_display <- paste0(
+    "Fleming-Harrington FH(", rho, ", ", gamma, ")",
+    if (rho == 0 && gamma == 0) " (logrank)"
+  )
+  y <- structure(
+    list(
+      input = input, enroll_rate = d$enroll_rate, fail_rate = d$fail_rate,
+      analysis = ans, design = "fh", design_par = list(rho = rho, gamma = gamma)
+    ),
+    class = "fixed_design",
+    design_display = design_display,
+    title = "Fixed Design under Fleming-Harrington Method",
+    footnote = paste(
+      "Power for Fleming-Harrington test", substring(design_display, 19),
+      "using method of Yung and Liu."
+    )
   )
-  class(y) <- c("fixed_design", class(y))
+
   return(y)
 }

R/fixed_design_lf.R

@@ -172,6 +172,8 @@ fixed_design_lf <- function(
       rr[, 1]
     })
   )
+
+  # Prepare output ----
   ans <- tibble(
     design = "lf",
     n = d$n,
@@ -181,13 +183,22 @@ fixed_design_lf <- function(
     alpha = d$alpha,
     power = d$power
   )
-  y <- list(
-    input = input,
-    enroll_rate = enroll_rate |> mutate(rate = rate * d$n / sum(enroll_rate$duration * enroll_rate$rate)),
-    fail_rate = fail_rate,
-    analysis = ans,
-    design = "lf"
+  y <- structure(
+    list(
+      input = input,
+      enroll_rate = enroll_rate |> mutate(rate = rate * d$n / sum(enroll_rate$duration * enroll_rate$rate)),
+      fail_rate = fail_rate,
+      analysis = ans,
+      design = "lf"
+    ),
+    class = "fixed_design",
+    design_display = "Lachin and Foulkes",
+    title = "Fixed Design under Lachin and Foulkes Method",
+    footnote = paste(
+      "Power using Lachin and Foulkes method applied using expected",
+      "average hazard ratio (AHR) at time of planned analysis."
+    )
   )
-  class(y) <- c("fixed_design", class(y))
+
   return(y)
 }

R/fixed_design_maxcombo.R

@@ -116,7 +116,8 @@ fixed_design_maxcombo <- function(
       lower = gs_b, lpar = -Inf
     )
   }
-  # get the output of MaxCombo
+
+  # Prepare output ----
   ans <- tibble(
     design = "maxcombo",
     n = d$analysis$n,
@@ -126,11 +127,30 @@ fixed_design_maxcombo <- function(
     alpha = alpha,
     power = (d$bound |> filter(bound == "upper"))$probability
   )
-  y <- list(
-    input = input,
-    enroll_rate = d$enroll_rate, fail_rate = d$fail_rate, analysis = ans,
-    design = "maxcombo", design_par = list(rho = rho, gamma = gamma, tau = tau)
+  design_display <- gsub(
+    "FH(0, 0)", "logrank", paste(
+      "MaxCombo:", paste0(
+        "FHC(", rho, ", ", gamma, ")",
+        collapse = ", "
+      )
+    ),
+    fixed = TRUE
+  )
+  y <- structure(
+    list(
+      input = input, enroll_rate = d$enroll_rate, fail_rate = d$fail_rate,
+      analysis = ans, design = "maxcombo",
+      design_par = list(rho = rho, gamma = gamma, tau = tau)
+    ),
+    class = "fixed_design",
+    design_display = design_display,
+    title = "Fixed Design under MaxCombo Method",
+    footnote = paste0(
+      "Power for MaxCombo test with Fleming-Harrington tests ",
+      substring(design_display, 9),
+      "."
+    )
   )
-  class(y) <- c("fixed_design", class(y))
+
   return(y)
 }

R/fixed_design_mb.R

@@ -118,7 +118,8 @@ fixed_design_mb <- function(
       info_scale = info_scale
     )
   }
-  # get the output of MB
+
+  # Prepare output ----
   ans <- tibble(
     design = "mb",
     n = d$analysis$n,
@@ -129,10 +130,20 @@ fixed_design_mb <- function(
     alpha = alpha,
     power = (d$bound |> filter(bound == "upper"))$probability
   )
-  y <- list(
-    input = input, enroll_rate = d$enroll_rate, fail_rate = d$fail_rate, analysis = ans,
-    design = "mb", design_par = list(tau = tau, w_max = w_max)
+  design_display <- paste0("Modestly weighted LR: tau = ", tau)
+  y <- structure(
+    list(
+      input = input, enroll_rate = d$enroll_rate, fail_rate = d$fail_rate,
+      analysis = ans, design = "mb", design_par = list(tau = tau, w_max = w_max)
+    ),
+    class = "fixed_design",
+    design_display = design_display,
+    title = "Fixed Design under Magirr-Burman Method",
+    footnote = paste(
+      "Power for", design_display,
+      "computed with method of Yung and Liu."
+    )
   )
-  class(y) <- c("fixed_design", class(y))
+
   return(y)
 }

R/fixed_design_milestone.R

@@ -104,7 +104,8 @@ fixed_design_milestone <- function(
       tau = tau
     )
   }
-  # get the output of MaxCombo
+
+  # Prepare output ----
   ans <- tibble(
     design = "milestone",
     n = d$analysis$n,
@@ -114,11 +115,20 @@ fixed_design_milestone <- function(
     alpha = alpha,
     power = (d$bound |> filter(bound == "upper"))$probability
   )
-  y <- list(
-    input = input,
-    enroll_rate = d$enroll_rate, fail_rate = d$fail_rate, analysis = ans,
-    design = "milestone", design_par = list(tau = tau)
+  design_display <- paste("Milestone: tau =", tau)
+  y <- structure(
+    list(
+      input = input, enroll_rate = d$enroll_rate, fail_rate = d$fail_rate,
+      analysis = ans, design = "milestone", design_par = list(tau = tau)
+    ),
+    class = "fixed_design",
+    design_display = design_display,
+    title = "Fixed Design under Milestone Method",
+    footnote = paste(
+      "Power for", design_display,
+      "computed with method of Yung and Liu."
+    )
   )
-  class(y) <- c("fixed_design", class(y))
+
   return(y)
 }