Refactor as_gt.fixed_design() to use S3 dispatch per method

Author: jdblischak

NAMESPACE

@@ -1,6 +1,14 @@
 # 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)

R/as_gt.R

@@ -78,15 +78,113 @@ 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)
+}
+
+#' @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, ...)
+}
+
+#' @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."
+    ),
+    ...
+) {
+  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."
+    ),
+    ...
+) {
+  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."
+    ),
+    ...
+) {
+  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), "."
+    ),
+    ...
+) {
+  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]

R/summary.R

@@ -100,11 +100,12 @@ summary.fixed_design <- function(object, ...) {
 
   # capitalize names
   ans <- cap_names(ans)
-  ans <- add_class(ans, "fixed_design", x$design)
+  ans <- add_class(ans, paste0("fixed_design"))
+  ans <- add_class(ans, paste0("design_fixed_summary"))
+  ans <- add_class(ans, paste0("design_fixed_", x$design, "_summary"))
   return(ans)
 }
 
-
 #' @rdname summary
 #'
 #' @param analysis_vars The variables to be put at the summary header of each analysis.