From 409b24c9e667371244459afaa2552195a0111312 Mon Sep 17 00:00:00 2001 From: John Blischak Date: Tue, 29 Oct 2024 14:46:06 -0400 Subject: [PATCH 1/4] Refactor as_gt.fixed_design() to use S3 dispatch per method --- NAMESPACE | 10 ++++- R/as_gt.R | 110 ++++++++++++++++++++++++++++++++++++++++++++++++--- R/summary.R | 5 ++- man/as_gt.Rd | 72 ++++++++++++++++++++++++++++++++- 4 files changed, 186 insertions(+), 11 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 4839c16cb..b66421ee9 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/as_gt.R b/R/as_gt.R index 76ce4f5be..7af38d8a7 100644 --- a/R/as_gt.R +++ b/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] diff --git a/R/summary.R b/R/summary.R index fa36f8679..453c181e1 100644 --- a/R/summary.R +++ b/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. diff --git a/man/as_gt.Rd b/man/as_gt.Rd index 7b342d85d..8fa694fa2 100644 --- a/man/as_gt.Rd +++ b/man/as_gt.Rd @@ -2,13 +2,81 @@ % Please edit documentation in R/as_gt.R \name{as_gt} \alias{as_gt} -\alias{as_gt.fixed_design} +\alias{as_gt.design_fixed_summary} +\alias{as_gt.design_fixed_ahr_summary} +\alias{as_gt.design_fixed_fh_summary} +\alias{as_gt.design_fixed_mb_summary} +\alias{as_gt.design_fixed_lf_summary} +\alias{as_gt.design_fixed_rd_summary} +\alias{as_gt.design_fixed_maxcombo_summary} +\alias{as_gt.design_fixed_milestone_summary} +\alias{as_gt.design_fixed_rmst_summary} \alias{as_gt.gs_design} \title{Convert summary table of a fixed or group sequential design object to a gt object} \usage{ as_gt(x, ...) -\method{as_gt}{fixed_design}(x, title = NULL, footnote = NULL, ...) +\method{as_gt}{design_fixed_summary}(x, title, footnote, ...) + +\method{as_gt}{design_fixed_ahr_summary}( + x, + title = "Fixed Design under AHR Method", + footnote = "Power computed with average hazard ratio method.", + ... +) + +\method{as_gt}{design_fixed_fh_summary}( + 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."), + ... +) + +\method{as_gt}{design_fixed_mb_summary}( + x, + title = "Fixed Design under Magirr-Burman Method", + footnote = paste("Power for", x$Design, "computed with method of Yung and Liu."), + ... +) + +\method{as_gt}{design_fixed_lf_summary}( + 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."), + ... +) + +\method{as_gt}{design_fixed_rd_summary}( + 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."), + ... +) + +\method{as_gt}{design_fixed_maxcombo_summary}( + x, + title = "Fixed Design under MaxCombo Method", + footnote = paste0("Power for MaxCombo test with Fleming-Harrington tests ", + substring(x$Design, 9), "."), + ... +) + +\method{as_gt}{design_fixed_milestone_summary}( + x, + title = "Fixed Design under Milestone Method", + footnote = paste("Power for", x$Design, "computed with method of Yung and Liu."), + ... +) + +\method{as_gt}{design_fixed_rmst_summary}( + x, + title = "Fixed Design under Restricted Mean Survival Time Method", + footnote = paste("Power for", x$Design, "computed with method of Yung and Liu."), + ... +) \method{as_gt}{gs_design}( x, From cafdaf0e510ac83185247569e20fc578b036a770 Mon Sep 17 00:00:00 2001 From: John Blischak Date: Tue, 29 Oct 2024 15:57:31 -0400 Subject: [PATCH 2/4] Refactor summary.fixed_design() to use S3 dispatch per method --- NAMESPACE | 8 +++ R/fixed_design_ahr.R | 2 +- R/fixed_design_fh.R | 2 +- R/fixed_design_lf.R | 2 +- R/fixed_design_maxcombo.R | 2 +- R/fixed_design_mb.R | 2 +- R/fixed_design_milestone.R | 2 +- R/fixed_design_rd.R | 2 +- R/fixed_design_rmst.R | 2 +- R/summary.R | 111 ++++++++++++++++++++++++++++++------- man/summary.Rd | 52 ++++++++++++++++- 11 files changed, 157 insertions(+), 30 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index b66421ee9..da74f616f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -13,6 +13,14 @@ S3method(as_gt,gs_design) S3method(as_gt,simtrial_gs_wlr) S3method(as_rtf,fixed_design) 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) diff --git a/R/fixed_design_ahr.R b/R/fixed_design_ahr.R index 888f9900d..d42591cd5 100644 --- a/R/fixed_design_ahr.R +++ b/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) } diff --git a/R/fixed_design_fh.R b/R/fixed_design_fh.R index d65ba8271..2ac3e695f 100644 --- a/R/fixed_design_fh.R +++ b/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) } diff --git a/R/fixed_design_lf.R b/R/fixed_design_lf.R index ede0fce8e..cbebf2c21 100644 --- a/R/fixed_design_lf.R +++ b/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) } diff --git a/R/fixed_design_maxcombo.R b/R/fixed_design_maxcombo.R index 0475f5133..d3c1294b8 100644 --- a/R/fixed_design_maxcombo.R +++ b/R/fixed_design_maxcombo.R @@ -132,6 +132,6 @@ 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) ) - class(y) <- c("fixed_design", class(y)) + class(y) <- c("design_fixed_maxcombo", "fixed_design", class(y)) return(y) } diff --git a/R/fixed_design_mb.R b/R/fixed_design_mb.R index b79cb9d5d..4632ac975 100644 --- a/R/fixed_design_mb.R +++ b/R/fixed_design_mb.R @@ -131,6 +131,6 @@ 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) ) - class(y) <- c("fixed_design", class(y)) + class(y) <- c("design_fixed_mb", "fixed_design", class(y)) return(y) } diff --git a/R/fixed_design_milestone.R b/R/fixed_design_milestone.R index 3ccfee341..afcade542 100644 --- a/R/fixed_design_milestone.R +++ b/R/fixed_design_milestone.R @@ -120,6 +120,6 @@ fixed_design_milestone <- function( enroll_rate = d$enroll_rate, fail_rate = d$fail_rate, analysis = ans, design = "milestone", design_par = list(tau = tau) ) - class(y) <- c("fixed_design", class(y)) + class(y) <- c("design_fixed_milestone", "fixed_design", class(y)) return(y) } diff --git a/R/fixed_design_rd.R b/R/fixed_design_rd.R index 171d2d44f..11464397d 100644 --- a/R/fixed_design_rd.R +++ b/R/fixed_design_rd.R @@ -106,6 +106,6 @@ fixed_design_rd <- function( input = input, enroll_rate = d$enroll_rate, fail_rate = d$fail_rate, analysis = ans, design = "rd" ) - class(y) <- c("fixed_design", class(y)) + class(y) <- c("design_fixed_rd", "fixed_design", class(y)) return(y) } diff --git a/R/fixed_design_rmst.R b/R/fixed_design_rmst.R index 340a500a7..908c819aa 100644 --- a/R/fixed_design_rmst.R +++ b/R/fixed_design_rmst.R @@ -119,6 +119,6 @@ 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 ) - class(y) <- c("fixed_design", class(y)) + class(y) <- c("design_fixed_rmst", "fixed_design", class(y)) return(y) } diff --git a/R/summary.R b/R/summary.R index 453c181e1..f8d409d23 100644 --- a/R/summary.R +++ b/R/summary.R @@ -19,6 +19,7 @@ #' Summary for fixed design or group sequential design objects #' #' @param object A design object returned by fixed_design_xxx() and gs_design_xxx(). +#' @param design_display The display name for the design method. #' @param ... Additional parameters (not used). #' #' @return A summary table (data frame). @@ -77,35 +78,103 @@ #' ratio = ratio #' ) %>% 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) - ) +summary.fixed_design <- function(object, design_display, ...) { + ans <- object$analysis + ans$design <- design_display # capitalize names ans <- cap_names(ans) 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")) + ans <- add_class(ans, paste0("design_fixed_", object$design, "_summary")) return(ans) } +#' @rdname summary +#' @export +summary.design_fixed_ahr <- function( + object, + design_display = "Average hazard ratio", + ... +) { + NextMethod("summary", object, design_display = design_display, ...) +} + +#' @rdname summary +#' @export +summary.design_fixed_fh <- function( + object, + design_display = paste0( + "Fleming-Harrington FH(", object$design_par$rho, ", ", object$design_par$gamma, ")", + if (object$design_par$rho == 0 && object$design_par$gamma == 0) " (logrank)" + ), + ... +) { + NextMethod("summary", object, design_display = design_display, ...) +} + +#' @rdname summary +#' @export +summary.design_fixed_mb <- function( + object, + design_display = paste0("Modestly weighted LR: tau = ", object$design_par$tau), + ... +) { + NextMethod("summary", object, design_display = design_display, ...) +} + +#' @rdname summary +#' @export +summary.design_fixed_lf <- function( + object, + design_display = "Lachin and Foulkes", + ... +) { + NextMethod("summary", object, design_display = design_display, ...) +} + +#' @rdname summary +#' @export +summary.design_fixed_rd <- function( + object, + design_display = "Risk difference", + ... +) { + NextMethod("summary", object, design_display = design_display, ...) +} + +#' @rdname summary +#' @export +summary.design_fixed_maxcombo <- function( + object, + design_display = gsub("FH(0, 0)", "logrank", paste( + "MaxCombo:", paste0("FHC(", object$design_par[[1]], ", ", object$design_par[[2]], ")", collapse = ", ") + ), fixed = TRUE), + ... +) { + NextMethod("summary", object, design_display = design_display, ...) +} + +#' @rdname summary +#' @export +summary.design_fixed_milestone <- function( + object, + design_display = paste0("Milestone: tau = ", object$design_par$tau), + ... +) { + NextMethod("summary", object, design_display = design_display, ...) +} + +#' @rdname summary +#' @export +summary.design_fixed_rmst <- function( + object, + design_display = paste0("RMST: tau = ", object$design_par$tau), + ... +) { + NextMethod("summary", object, design_display = design_display, ...) +} + #' @rdname summary #' #' @param analysis_vars The variables to be put at the summary header of each analysis. diff --git a/man/summary.Rd b/man/summary.Rd index 5e814a0eb..044affbdb 100644 --- a/man/summary.Rd +++ b/man/summary.Rd @@ -2,10 +2,58 @@ % Please edit documentation in R/summary.R \name{summary.fixed_design} \alias{summary.fixed_design} +\alias{summary.design_fixed_ahr} +\alias{summary.design_fixed_fh} +\alias{summary.design_fixed_mb} +\alias{summary.design_fixed_lf} +\alias{summary.design_fixed_rd} +\alias{summary.design_fixed_maxcombo} +\alias{summary.design_fixed_milestone} +\alias{summary.design_fixed_rmst} \alias{summary.gs_design} \title{Summary for fixed design or group sequential design objects} \usage{ -\method{summary}{fixed_design}(object, ...) +\method{summary}{fixed_design}(object, design_display, ...) + +\method{summary}{design_fixed_ahr}(object, design_display = "Average hazard ratio", ...) + +\method{summary}{design_fixed_fh}( + object, + design_display = paste0("Fleming-Harrington FH(", object$design_par$rho, ", ", + object$design_par$gamma, ")", if (object$design_par$rho == 0 && + object$design_par$gamma == 0) " (logrank)"), + ... +) + +\method{summary}{design_fixed_mb}( + object, + design_display = paste0("Modestly weighted LR: tau = ", object$design_par$tau), + ... +) + +\method{summary}{design_fixed_lf}(object, design_display = "Lachin and Foulkes", ...) + +\method{summary}{design_fixed_rd}(object, design_display = "Risk difference", ...) + +\method{summary}{design_fixed_maxcombo}( + object, + design_display = gsub("FH(0, 0)", "logrank", paste("MaxCombo:", paste0("FHC(", + object$design_par[[1]], ", ", object$design_par[[2]], ")", collapse = ", ")), fixed = + TRUE), + ... +) + +\method{summary}{design_fixed_milestone}( + object, + design_display = paste0("Milestone: tau = ", object$design_par$tau), + ... +) + +\method{summary}{design_fixed_rmst}( + object, + design_display = paste0("RMST: tau = ", object$design_par$tau), + ... +) \method{summary}{gs_design}( object, @@ -20,6 +68,8 @@ \arguments{ \item{object}{A design object returned by fixed_design_xxx() and gs_design_xxx().} +\item{design_display}{The display name for the design method.} + \item{...}{Additional parameters (not used).} \item{analysis_vars}{The variables to be put at the summary header of each analysis.} From 3139a80c64fb9ce5a742893eceb47e9925a0927d Mon Sep 17 00:00:00 2001 From: John Blischak Date: Wed, 30 Oct 2024 14:34:26 -0400 Subject: [PATCH 3/4] Refactor as_rtf.fixed_design() to use S3 dispatch per method --- NAMESPACE | 10 +++- R/as_rtf.R | 159 ++++++++++++++++++++++++++++++++++++++++++++++++-- R/summary.R | 4 +- man/as_rtf.Rd | 108 ++++++++++++++++++++++++++++++++-- 4 files changed, 268 insertions(+), 13 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index da74f616f..aaa37c826 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,7 +11,15 @@ 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) diff --git a/R/as_rtf.R b/R/as_rtf.R index 7ed40a528..e125b0386 100644 --- a/R/as_rtf.R +++ b/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 ", diff --git a/R/summary.R b/R/summary.R index f8d409d23..40aa871b1 100644 --- a/R/summary.R +++ b/R/summary.R @@ -84,8 +84,8 @@ summary.fixed_design <- function(object, design_display, ...) { # capitalize names ans <- cap_names(ans) - ans <- add_class(ans, paste0("fixed_design")) - ans <- add_class(ans, paste0("design_fixed_summary")) + ans <- add_class(ans, "fixed_design") + ans <- add_class(ans, "design_fixed_summary") ans <- add_class(ans, paste0("design_fixed_", object$design, "_summary")) return(ans) } diff --git a/man/as_rtf.Rd b/man/as_rtf.Rd index b7924f557..e798fe47a 100644 --- a/man/as_rtf.Rd +++ b/man/as_rtf.Rd @@ -2,16 +2,116 @@ % Please edit documentation in R/as_rtf.R \name{as_rtf} \alias{as_rtf} -\alias{as_rtf.fixed_design} +\alias{as_rtf.design_fixed_summary} +\alias{as_rtf.design_fixed_ahr_summary} +\alias{as_rtf.design_fixed_fh_summary} +\alias{as_rtf.design_fixed_mb_summary} +\alias{as_rtf.design_fixed_lf_summary} +\alias{as_rtf.design_fixed_rd_summary} +\alias{as_rtf.design_fixed_maxcombo_summary} +\alias{as_rtf.design_fixed_milestone_summary} +\alias{as_rtf.design_fixed_rmst_summary} \alias{as_rtf.gs_design} \title{Write summary table of a fixed or group sequential design object to an RTF file} \usage{ as_rtf(x, ...) -\method{as_rtf}{fixed_design}( +\method{as_rtf}{design_fixed_summary}( x, - title = NULL, - footnote = NULL, + title, + footnote, + col_rel_width = NULL, + orientation = c("portrait", "landscape"), + text_font_size = 9, + file, + ... +) + +\method{as_rtf}{design_fixed_ahr_summary}( + 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, + ... +) + +\method{as_rtf}{design_fixed_fh_summary}( + 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, + ... +) + +\method{as_rtf}{design_fixed_mb_summary}( + 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, + ... +) + +\method{as_rtf}{design_fixed_lf_summary}( + 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, + ... +) + +\method{as_rtf}{design_fixed_rd_summary}( + 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, + ... +) + +\method{as_rtf}{design_fixed_maxcombo_summary}( + 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, + ... +) + +\method{as_rtf}{design_fixed_milestone_summary}( + 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, + ... +) + +\method{as_rtf}{design_fixed_rmst_summary}( + 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, From 90e2888a95587ec9a707f72ba5b611eff81e07ef Mon Sep 17 00:00:00 2001 From: John Blischak Date: Wed, 30 Oct 2024 14:37:09 -0400 Subject: [PATCH 4/4] Remove unused functions post-refactoring --- R/as_gt.R | 42 ------------------------------------------ 1 file changed, 42 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 7af38d8a7..8e39e549d 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -189,48 +189,6 @@ as_gt.design_fixed_rmst_summary <- function( 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.