Refactor S3 methods for fixed designs

NAMESPACE

@@ -1,10 +1,34 @@
 # Generated by roxygen2: do not edit by hand
 
-S3method(as_gt,fixed_design)
+S3method(as_gt,design_fixed_ahr_summary)
+S3method(as_gt,design_fixed_fh_summary)
+S3method(as_gt,design_fixed_lf_summary)
+S3method(as_gt,design_fixed_maxcombo_summary)
+S3method(as_gt,design_fixed_mb_summary)
+S3method(as_gt,design_fixed_milestone_summary)
+S3method(as_gt,design_fixed_rd_summary)
+S3method(as_gt,design_fixed_rmst_summary)
+S3method(as_gt,design_fixed_summary)
 S3method(as_gt,gs_design)
 S3method(as_gt,simtrial_gs_wlr)
-S3method(as_rtf,fixed_design)
+S3method(as_rtf,design_fixed_ahr_summary)
+S3method(as_rtf,design_fixed_fh_summary)
+S3method(as_rtf,design_fixed_lf_summary)
+S3method(as_rtf,design_fixed_maxcombo_summary)
+S3method(as_rtf,design_fixed_mb_summary)
+S3method(as_rtf,design_fixed_milestone_summary)
+S3method(as_rtf,design_fixed_rd_summary)
+S3method(as_rtf,design_fixed_rmst_summary)
+S3method(as_rtf,design_fixed_summary)
 S3method(as_rtf,gs_design)
+S3method(summary,design_fixed_ahr)
+S3method(summary,design_fixed_fh)
+S3method(summary,design_fixed_lf)
+S3method(summary,design_fixed_maxcombo)
+S3method(summary,design_fixed_mb)
+S3method(summary,design_fixed_milestone)
+S3method(summary,design_fixed_rd)
+S3method(summary,design_fixed_rmst)
 S3method(summary,fixed_design)
 S3method(summary,gs_design)
 S3method(to_integer,fixed_design)

R/as_gt.R

@@ -78,61 +78,117 @@ 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)) %>%
+as_gt.design_fixed_summary <- function(x, title, footnote, ...) {
+  gt::gt(x) %>%
+    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"
-  ))
+#' @rdname as_gt
+#' @export
+as_gt.design_fixed_ahr_summary <- function(
+    x,
+    title = "Fixed Design under AHR Method",
+    footnote = "Power computed with average hazard ratio method.",
+    ...
+) {
+  NextMethod("as_gt", x, title = title, footnote = footnote, ...)
 }
 
-# get the default footnote
-fd_footnote <- function(x, method) {
-  switch(
-    method,
-    ahr = "Power computed with average hazard ratio method.",
-    fh = paste(
+#' @rdname as_gt
+#' @export
+as_gt.design_fixed_fh_summary <- function(
+    x,
+    title = "Fixed Design under Fleming-Harrington Method",
+    footnote = paste(
       "Power for Fleming-Harrington test", substring(x$Design, 19),
       "using method of Yung and Liu."
     ),
-    lf = paste(
+    ...
+) {
+  NextMethod("as_gt", x, title = title, footnote = footnote, ...)
+}
+
+#' @rdname as_gt
+#' @export
+as_gt.design_fixed_mb_summary <- function(
+    x,
+    title = "Fixed Design under Magirr-Burman Method",
+    footnote = paste("Power for", x$Design, "computed with method of Yung and Liu."),
+    ...
+) {
+  NextMethod("as_gt", x, title = title, footnote = footnote, ...)
+}
+
+#' @rdname as_gt
+#' @export
+as_gt.design_fixed_lf_summary <- function(
+    x,
+    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."
     ),
-    rd = paste(
+    ...
+) {
+  NextMethod("as_gt", x, title = title, footnote = footnote, ...)
+}
+
+#' @rdname as_gt
+#' @export
+as_gt.design_fixed_rd_summary <- function(
+    x,
+    title = "Fixed Design of Risk Difference under Farrington-Manning Method",
+    footnote = paste(
       "Risk difference power without continuity correction using method of",
       "Farrington and Manning."
     ),
-    maxcombo = paste0(
+    ...
+) {
+  NextMethod("as_gt", x, title = title, footnote = footnote, ...)
+}
+
+#' @rdname as_gt
+#' @export
+as_gt.design_fixed_maxcombo_summary <- function(
+    x,
+    title = "Fixed Design under MaxCombo Method",
+    footnote = 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.")
-  )
+    ...
+) {
+  NextMethod("as_gt", x, title = title, footnote = footnote, ...)
 }
 
+#' @rdname as_gt
+#' @export
+as_gt.design_fixed_milestone_summary <- function(
+    x,
+    title = "Fixed Design under Milestone Method",
+    footnote = paste("Power for", x$Design, "computed with method of Yung and Liu."),
+    ...
+) {
+  NextMethod("as_gt", x, title = title, footnote = footnote, ...)
+}
+
+#' @rdname as_gt
+#' @export
+as_gt.design_fixed_rmst_summary <- function(
+    x,
+    title = "Fixed Design under Restricted Mean Survival Time Method",
+    footnote = paste("Power for", x$Design, "computed with method of Yung and Liu."),
+    ...
+) {
+  NextMethod("as_gt", x, title = title, footnote = footnote, ...)
+}
+
+get_method <- function(x, methods) intersect(methods, class(x))[1]
+
 #' @rdname as_gt
 #'
 #' @param title A string to specify the title of the gt table.

R/as_rtf.R

@@ -91,19 +91,18 @@ as_rtf <- function(x, ...) {
 #' ) %>%
 #'   summary() %>%
 #'   as_rtf(file = tempfile(fileext = ".rtf"))
-as_rtf.fixed_design <- function(
+as_rtf.design_fixed_summary <- function(
     x,
-    title = NULL,
-    footnote = NULL,
+    title,
+    footnote,
     col_rel_width = NULL,
     orientation = c("portrait", "landscape"),
     text_font_size = 9,
     file,
     ...) {
   orientation <- match.arg(orientation)
-  method <- fd_method(x)
-  title <- title %||% paste(fd_title(method), "{^a}")
-  footnote <- footnote %||% paste("{^a}", fd_footnote(x, method))
+  title <- paste(title, "{^a}")
+  footnote <- paste("{^a}", footnote)
 
   # set default column width
   n_row <- nrow(x)
@@ -146,6 +145,154 @@ as_rtf.fixed_design <- function(
   invisible(x)
 }
 
+#' @rdname as_rtf
+#' @export
+as_rtf.design_fixed_ahr_summary <- function(
+    x,
+    title = "Fixed Design under AHR Method",
+    footnote = "Power computed with average hazard ratio method.",
+    col_rel_width = NULL,
+    orientation = c("portrait", "landscape"),
+    text_font_size = 9,
+    file,
+    ...
+) {
+  NextMethod("as_rtf", x, title = title, footnote = footnote,
+             col_rel_width = col_rel_width, orientation = orientation,
+             text_font_size = text_font_size, file = file, ...)
+}
+
+#' @rdname as_rtf
+#' @export
+as_rtf.design_fixed_fh_summary <- function(
+    x,
+    title = "Fixed Design under Fleming-Harrington Method",
+    footnote = paste(
+      "Power for Fleming-Harrington test", substring(x$Design, 19),
+      "using method of Yung and Liu."
+    ),
+    col_rel_width = NULL,
+    orientation = c("portrait", "landscape"),
+    text_font_size = 9,
+    file,
+    ...
+) {
+  NextMethod("as_rtf", x, title = title, footnote = footnote,
+             col_rel_width = col_rel_width, orientation = orientation,
+             text_font_size = text_font_size, file = file, ...)
+}
+
+#' @rdname as_rtf
+#' @export
+as_rtf.design_fixed_mb_summary <- function(
+    x,
+    title = "Fixed Design under Magirr-Burman Method",
+    footnote = paste("Power for", x$Design, "computed with method of Yung and Liu."),
+    col_rel_width = NULL,
+    orientation = c("portrait", "landscape"),
+    text_font_size = 9,
+    file,
+    ...
+) {
+  NextMethod("as_rtf", x, title = title, footnote = footnote,
+             col_rel_width = col_rel_width, orientation = orientation,
+             text_font_size = text_font_size, file = file, ...)
+}
+
+#' @rdname as_rtf
+#' @export
+as_rtf.design_fixed_lf_summary <- function(
+    x,
+    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."
+    ),
+    col_rel_width = NULL,
+    orientation = c("portrait", "landscape"),
+    text_font_size = 9,
+    file,
+    ...
+) {
+  NextMethod("as_rtf", x, title = title, footnote = footnote,
+             col_rel_width = col_rel_width, orientation = orientation,
+             text_font_size = text_font_size, file = file, ...)
+}
+
+#' @rdname as_rtf
+#' @export
+as_rtf.design_fixed_rd_summary <- function(
+    x,
+    title = "Fixed Design of Risk Difference under Farrington-Manning Method",
+    footnote = paste(
+      "Risk difference power without continuity correction using method of",
+      "Farrington and Manning."
+    ),
+    col_rel_width = NULL,
+    orientation = c("portrait", "landscape"),
+    text_font_size = 9,
+    file,
+    ...
+) {
+  NextMethod("as_rtf", x, title = title, footnote = footnote,
+             col_rel_width = col_rel_width, orientation = orientation,
+             text_font_size = text_font_size, file = file, ...)
+}
+
+#' @rdname as_rtf
+#' @export
+as_rtf.design_fixed_maxcombo_summary <- function(
+    x,
+    title = "Fixed Design under MaxCombo Method",
+    footnote = paste0(
+      "Power for MaxCombo test with Fleming-Harrington tests ",
+      substring(x$Design, 9), "."
+    ),
+    col_rel_width = NULL,
+    orientation = c("portrait", "landscape"),
+    text_font_size = 9,
+    file,
+    ...
+) {
+  NextMethod("as_rtf", x, title = title, footnote = footnote,
+             col_rel_width = col_rel_width, orientation = orientation,
+             text_font_size = text_font_size, file = file, ...)
+}
+
+#' @rdname as_rtf
+#' @export
+as_rtf.design_fixed_milestone_summary <- function(
+    x,
+    title = "Fixed Design under Milestone Method",
+    footnote = paste("Power for", x$Design, "computed with method of Yung and Liu."),
+    col_rel_width = NULL,
+    orientation = c("portrait", "landscape"),
+    text_font_size = 9,
+    file,
+    ...
+) {
+  NextMethod("as_rtf", x, title = title, footnote = footnote,
+             col_rel_width = col_rel_width, orientation = orientation,
+             text_font_size = text_font_size, file = file, ...)
+}
+
+#' @rdname as_rtf
+#' @export
+as_rtf.design_fixed_rmst_summary <- function(
+    x,
+    title = "Fixed Design under Restricted Mean Survival Time Method",
+    footnote = paste("Power for", x$Design, "computed with method of Yung and Liu."),
+    col_rel_width = NULL,
+    orientation = c("portrait", "landscape"),
+    text_font_size = 9,
+    file,
+    ...
+) {
+  NextMethod("as_rtf", x, title = title, footnote = footnote,
+             col_rel_width = col_rel_width, orientation = orientation,
+             text_font_size = text_font_size, file = file, ...)
+}
+
 check_rel_width <- function(width, n_col) {
   if (!is.null(width) && n_col != length(width)) stop(
     "The length of 'col_rel_width' (", length(width), ") differs with ",

R/fixed_design_ahr.R

@@ -132,6 +132,6 @@ fixed_design_ahr <- function(
     input = input, enroll_rate = d$enroll_rate,
     fail_rate = d$fail_rate, analysis = ans, design = "ahr"
   )
-  class(y) <- c("fixed_design", class(y))
+  class(y) <- c("design_fixed_ahr", "fixed_design", class(y))
   return(y)
 }

R/fixed_design_fh.R

@@ -132,6 +132,6 @@ fixed_design_fh <- function(
     analysis = ans,
     design = "fh", design_par = list(rho = rho, gamma = gamma)
   )
-  class(y) <- c("fixed_design", class(y))
+  class(y) <- c("design_fixed_fh", "fixed_design", class(y))
   return(y)
 }

R/fixed_design_lf.R

@@ -189,6 +189,6 @@ fixed_design_lf <- function(
     analysis = ans,
     design = "lf"
   )
-  class(y) <- c("fixed_design", class(y))
+  class(y) <- c("design_fixed_lf", "fixed_design", class(y))
   return(y)
 }