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

R/fixed_design_ahr.R

@@ -119,6 +119,8 @@ fixed_design_ahr <- function(
       analysis_time = study_duration
     )
   }
+
+  # Prepare output ----
   ans <- tibble(
     design = "ahr",
     n = d$analysis$n,
@@ -128,10 +130,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

@@ -118,6 +118,8 @@ fixed_design_fh <- function(
       analysis_time = study_duration
     )
   }
+
+  # Prepare output ----
   ans <- tibble(
     design = "fh",
     n = d$analysis$n,
@@ -127,11 +129,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

@@ -173,6 +173,8 @@ fixed_design_lf <- function(
       rr[, 1]
     })
   )
+
+  # Prepare output ----
   ans <- tibble(
     design = "lf",
     n = d$n,
@@ -182,13 +184,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

@@ -117,7 +117,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,
@@ -127,11 +128,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

@@ -117,7 +117,8 @@ fixed_design_mb <- function(
       analysis_time = study_duration
     )
   }
-  # get the output of MB
+
+  # Prepare output ----
   ans <- tibble(
     design = "mb",
     n = d$analysis$n,
@@ -127,10 +128,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)
+  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)
+    ),
+    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

@@ -105,7 +105,8 @@ fixed_design_milestone <- function(
       tau = tau
     )
   }
-  # get the output of MaxCombo
+
+  # Prepare output ----
   ans <- tibble(
     design = "milestone",
     n = d$analysis$n,
@@ -115,11 +116,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)
 }

R/fixed_design_rd.R

@@ -94,18 +94,28 @@ fixed_design_rd <- function(
       rd0 = rd0, weight = "unstratified"
     )
   }
-  # get the output of MaxCombo
+
+  # Prepare output ----
   ans <- tibble(
     design = "rd",
     n = d$analysis$n,
     bound = (d$bound %>% filter(bound == "upper"))$z,
     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 = "rd"
+  y <- structure(
+    list(
+      input = input, enroll_rate = d$enroll_rate, fail_rate = d$fail_rate,
+      analysis = ans, design = "rd"
+    ),
+    class = "fixed_design",
+    design_display = "Risk difference",
+    title = "Fixed Design of Risk Difference under Farrington-Manning Method",
+    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

@@ -104,7 +104,8 @@ fixed_design_rmst <- function(
       tau = tau
     )
   }
-  # get the output
+
+  # Prepare output ----
   ans <- tibble(
     design = "rmst",
     n = d$analysis$n,
@@ -114,11 +115,21 @@ fixed_design_rmst <- 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 = "rmst", design_par = list(tau = tau), study_duration
+  design_display <- paste("RMST: tau =", tau)
+  y <- structure(
+    list(
+      input = input, enroll_rate = d$enroll_rate, fail_rate = d$fail_rate,
+      analysis = ans, design = "rmst", design_par = list(tau = tau),
+      study_duration
+    ),
+    class = "fixed_design",
+    design_display = design_display,
+    title = "Fixed Design under Restricted Mean Survival Time Method",
+    footnote = paste(
+      "Power for", design_display,
+      "computed with method of Yung and Liu."
+    )
   )
-  class(y) <- c("fixed_design", class(y))
+
   return(y)
 }