Refactor methods by passing table metadata as attributes

NAMESPACE

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

R/as_gt.R

@@ -78,61 +78,21 @@ as_gt <- function(x, ...) {
 #' ) %>%
 #'   summary() %>%
 #'   as_gt()
-as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) {
-  method <- fd_method(x)
+as_gt.fixed_design_summary <- function(x, title = NULL, footnote = NULL, ...) {
+  if (is.null(title)) title <- attr(x, "title", exact = TRUE)
+  if (is.null(footnote)) footnote <- attr(x, "footnote", exact = TRUE)
+
   ans <- gt::gt(x) %>%
-    gt::tab_header(title = title %||% fd_title(method)) %>%
+    gt::tab_header(title = title) %>%
     gt::tab_footnote(
-      footnote = footnote %||% fd_footnote(x, method),
+      footnote = footnote,
       locations = gt::cells_title(group = "title")
     )
   return(ans)
 }
 
 get_method <- function(x, methods) intersect(methods, class(x))[1]
 
-# get the fixed design method
-fd_method <- function(x) {
-  get_method(x, c("ahr", "fh", "mb", "lf", "rd", "maxcombo", "milestone", "rmst"))
-}
-
-# 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"
-  ))
-}
-
-# 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.")
-  )
-}
-
 #' @rdname as_gt
 #'
 #' @param title A string to specify the title of the gt table.

R/as_rtf.R

@@ -91,7 +91,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,
@@ -101,9 +101,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", exact = TRUE)
+  if (is.null(footnote)) footnote <- attr(x, "footnote", exact = TRUE)
+  title <- paste(title, "{^a}")
+  footnote <- paste("{^a}", footnote)
 
   # set default column width
   n_row <- nrow(x)

R/fixed_design_ahr.R

@@ -132,6 +132,9 @@ fixed_design_ahr <- function(
     input = input, enroll_rate = d$enroll_rate,
     fail_rate = d$fail_rate, analysis = ans, design = "ahr"
   )
+  attr(y, "design_display") <- "Average hazard ratio"
+  attr(y, "title") <- "Fixed Design under AHR Method"
+  attr(y, "footnote") <- "Power computed with average hazard ratio method."
   class(y) <- c("fixed_design", class(y))
   return(y)
 }

R/fixed_design_fh.R

@@ -132,6 +132,15 @@ fixed_design_fh <- function(
     analysis = ans,
     design = "fh", design_par = list(rho = rho, gamma = gamma)
   )
+  attr(y, "design_display") <- paste0(
+    "Fleming-Harrington FH(", rho, ", ", gamma, ")",
+    if (rho == 0 && gamma == 0) " (logrank)"
+  )
+  attr(y, "title") <- "Fixed Design under Fleming-Harrington Method"
+  attr(y, "footnote") <- paste(
+    "Power for Fleming-Harrington test", substring(attr(y, "design_display"), 19),
+    "using method of Yung and Liu."
+  )
   class(y) <- c("fixed_design", class(y))
   return(y)
 }

R/fixed_design_lf.R

@@ -189,6 +189,12 @@ fixed_design_lf <- function(
     analysis = ans,
     design = "lf"
   )
+  attr(y, "design_display") <- "Lachin and Foulkes"
+  attr(y, "title") <- "Fixed Design under Lachin and Foulkes Method"
+  attr(y, "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

@@ -132,6 +132,20 @@ fixed_design_maxcombo <- function(
     enroll_rate = d$enroll_rate, fail_rate = d$fail_rate, analysis = ans,
     design = "maxcombo", design_par = list(rho = rho, gamma = gamma, tau = tau)
   )
+  attr(y, "design_display") <- gsub(
+    "FH(0, 0)", "logrank", paste(
+      "MaxCombo:", paste0(
+        "FHC(", y$design_par[[1]], ", ", y$design_par[[2]], ")",
+        collapse = ", "
+      )
+    ),
+    fixed = TRUE
+  )
+  attr(y, "title") <- "Fixed Design under MaxCombo Method"
+  attr(y, "footnote") <- paste0(
+    "Power for MaxCombo test with Fleming-Harrington tests ",
+    substring(attr(y, "design_display"), 9), "."
+  )
   class(y) <- c("fixed_design", class(y))
   return(y)
 }

R/fixed_design_mb.R

@@ -131,6 +131,10 @@ fixed_design_mb <- function(
     input = input, enroll_rate = d$enroll_rate, fail_rate = d$fail_rate, analysis = ans,
     design = "mb", design_par = list(tau = tau)
   )
+  attr(y, "design_display") <- paste0("Modestly weighted LR: tau = ", tau)
+  attr(y, "title") <- "Fixed Design under Magirr-Burman Method"
+  attr(y, "footnote") <- paste("Power for", attr(y, "design_display"),
+                               "computed with method of Yung and Liu.")
   class(y) <- c("fixed_design", class(y))
   return(y)
 }

R/fixed_design_milestone.R

@@ -120,6 +120,12 @@ fixed_design_milestone <- function(
     enroll_rate = d$enroll_rate, fail_rate = d$fail_rate, analysis = ans,
     design = "milestone", design_par = list(tau = tau)
   )
+  attr(y, "design_display") <- paste("Milestone: tau =", tau)
+  attr(y, "title") <- "Fixed Design under Milestone Method"
+  attr(y, "footnote") <- paste(
+    "Power for", attr(y, "design_display"),
+    "computed with method of Yung and Liu."
+  )
   class(y) <- c("fixed_design", class(y))
   return(y)
 }

R/fixed_design_rd.R

@@ -106,6 +106,12 @@ fixed_design_rd <- function(
     input = input,
     enroll_rate = d$enroll_rate, fail_rate = d$fail_rate, analysis = ans, design = "rd"
   )
+  attr(y, "design_display") <- "Risk difference"
+  attr(y, "title") <- "Fixed Design of Risk Difference under Farrington-Manning Method"
+  attr(y, "footnote") <- paste(
+    "Risk difference power without continuity correction using method of",
+    "Farrington and Manning."
+  )
   class(y) <- c("fixed_design", class(y))
   return(y)
 }

R/fixed_design_rmst.R

@@ -119,6 +119,12 @@ fixed_design_rmst <- function(
     enroll_rate = d$enroll_rate, fail_rate = d$fail_rate, analysis = ans,
     design = "rmst", design_par = list(tau = tau), study_duration
   )
+  attr(y, "design_display") <- paste("RMST: tau =", tau)
+  attr(y, "title") <- "Fixed Design under Restricted Mean Survival Time Method"
+  attr(y, "footnote") <- paste(
+    "Power for", attr(y, "design_display"),
+    "computed with method of Yung and Liu."
+  )
   class(y) <- c("fixed_design", class(y))
   return(y)
 }

R/summary.R

@@ -78,29 +78,16 @@
 #' ) %>% summary()
 #'
 summary.fixed_design <- function(object, ...) {
-  x <- object
-  p <- x$design_par
-  ans <- x$analysis
-  ans$design <- switch(
-    x$design,
-    ahr = "Average hazard ratio",
-    lf = "Lachin and Foulkes",
-    rd = "Risk difference",
-    milestone = paste0("Milestone: tau = ", p$tau),
-    rmst = paste0("RMST: tau = ", p$tau),
-    mb = paste0("Modestly weighted LR: tau = ", p$tau),
-    fh = paste0(
-      "Fleming-Harrington FH(", p$rho, ", ", p$gamma, ")",
-      if (p$rho == 0 && p$gamma == 0) " (logrank)"
-    ),
-    maxcombo = gsub("FH(0, 0)", "logrank", paste(
-      "MaxCombo:", paste0("FHC(", p[[1]], ", ", p[[2]], ")", collapse = ", ")
-    ), fixed = TRUE)
-  )
+  ans <- object$analysis
+  ans$design <- attr(object, "design_display", exact = TRUE)
 
   # capitalize names
   ans <- cap_names(ans)
-  ans <- add_class(ans, "fixed_design", x$design)
+  # Propagate attributes for as_gt()/as_rtf() tables
+  attr(ans, "title") <- attr(object, "title", exact = TRUE)
+  attr(ans, "footnote") <- attr(object, "footnote", exact = TRUE)
+
+  ans <- add_class(ans, "fixed_design_summary")
   return(ans)
 }