From d01df1991ba3eeb038553a325df6cd2ac39b987b Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 15:03:09 -0500 Subject: [PATCH 01/43] tweak error message --- R/as_rtf.R | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index b97997e8..7dcfe19d 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -211,15 +211,10 @@ as_rtf.fixed_design <- function( # set default column width n_row <- nrow(x) n_col <- ncol(x) - if (!is.null(col_rel_width) && !(n_col == length(col_rel_width))) { - stop( - "col_rel_width must have the same length (has ", - length(col_rel_width), - ") as `x` has number of columns (has ", - n_col, ").", - call. = FALSE - ) - } + if (!is.null(col_rel_width) && n_col != length(col_rel_width)) stop( + "The length of 'col_rel_width' (", length(col_rel_width), ") differs with ", + "the number of columns in 'x' (", n_col, ")." + ) # set column header colheader <- From 5485aec66cc65704e1e088e420799948ca257077 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 15:04:26 -0500 Subject: [PATCH 02/43] remove the redundant paste0() call: paste(collapse = ' | ') will just return a single string --- R/as_rtf.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index 7dcfe19d..f44e373d 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -217,8 +217,7 @@ as_rtf.fixed_design <- function( ) # set column header - colheader <- - paste0(paste(names(x), collapse = " | ")) + colheader <- paste(names(x), collapse = " | ") # set relative width if (is.null(col_rel_width)) { From 1a0da68810eaf4cc272748974e304db0ddff2b02 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 15:20:18 -0500 Subject: [PATCH 03/43] introduce the %||% operator --- R/as_rtf.R | 6 +----- R/utils.R | 4 ++++ 2 files changed, 5 insertions(+), 5 deletions(-) create mode 100644 R/utils.R diff --git a/R/as_rtf.R b/R/as_rtf.R index f44e373d..f6c87d74 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -220,11 +220,7 @@ as_rtf.fixed_design <- function( colheader <- paste(names(x), collapse = " | ") # set relative width - if (is.null(col_rel_width)) { - rel_width <- c(2, rep(1, (n_col - 1))) - } else { - rel_width <- col_rel_width - } + rel_width <- col_rel_width %||% c(2, rep(1, n_col - 1)) # Column boarder border_top <- rep("single", n_col) diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 00000000..841eb12a --- /dev/null +++ b/R/utils.R @@ -0,0 +1,4 @@ +# %||% was introduced in base R 4.4.0 +if (!exists('%||%', baseenv(), inherits = FALSE)) `%||%` <- function(x, y) { + if (is.null(x)) y else x +} From fc0d3e1f75d756263c24a4889a5f6a4f16d19cd5 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 15:20:37 -0500 Subject: [PATCH 04/43] merge the two assignments --- R/as_rtf.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index f6c87d74..231ef1d8 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -223,8 +223,7 @@ as_rtf.fixed_design <- function( rel_width <- col_rel_width %||% c(2, rep(1, n_col - 1)) # Column boarder - border_top <- rep("single", n_col) - border_left <- rep("single", n_col) + border_top <- border_left <- rep("single", n_col) # Using order number to customize row format text_justification <- c("l", rep("c", n_col - 1)) From 52a516506255140f9b6a7b6679eb7e13c39950f2 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 15:35:34 -0500 Subject: [PATCH 05/43] "weld" the few short pipes into one expression --- R/as_rtf.R | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index 231ef1d8..ca69ad62 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -251,16 +251,11 @@ as_rtf.fixed_design <- function( ) if (!is.null(footnote)) { - ans <- ans %>% - r2rtf::rtf_footnote(footnote, - text_font_size = text_font_size - ) + ans <- r2rtf::rtf_footnote(ans, footnote, text_font_size = text_font_size) } # Prepare output - ans %>% - r2rtf::rtf_encode() %>% - r2rtf::write_rtf(file = file) + r2rtf::write_rtf(r2rtf::rtf_encode(ans), file) invisible(x) } From cb14c1bad2fb560441c3c766a77381658c90ced2 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 16:00:53 -0500 Subject: [PATCH 06/43] factor out the code to generate the default title and footnote to be reused by both as_gt() and as_rtf() --- R/as_gt.R | 40 ++++++++++++-------- R/as_rtf.R | 109 ++--------------------------------------------------- 2 files changed, 27 insertions(+), 122 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 89f1f6cb..c5199ed5 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -79,23 +79,37 @@ as_gt <- function(x, ...) { #' summary() %>% #' as_gt() as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) { - # get the design method - design_mtd <- intersect( - c("ahr", "fh", "mb", "lf", "rd", "maxcombo", "milestone", "rmst"), class(x) - )[1] + method <- design_method(x) + ans <- gt::gt(x) %>% + gt::tab_header(title = title %||% method_title(method)) %>% + gt::tab_footnote( + footnote = footnote %||% method_footnote(x, method), + locations = gt::cells_title(group = "title") + ) + return(ans) +} - # set the default title - if (is.null(title)) title <- sprintf("Fixed Design %s Method", switch( - design_mtd, +# get the design method +design_method <- function(x) { + methods <- c("ahr", "fh", "mb", "lf", "rd", "maxcombo", "milestone", "rmst") + intersect(methods, class(x))[1] +} + +# get the default title +method_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" )) +} - # set the default footnote - if (is.null(footnote)) footnote <- switch( - design_mtd, +# get the default footnote +method_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), @@ -116,12 +130,6 @@ as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) { # for mb, milestone, and rmst paste("Power for", x$Design, "computed with method of Yung and Liu.") ) - - ans <- gt::gt(x) %>% - gt::tab_header(title = title) %>% - gt::tab_footnote(footnote = footnote, locations = gt::cells_title(group = "title")) - - return(ans) } #' @rdname as_gt diff --git a/R/as_rtf.R b/R/as_rtf.R index ca69ad62..21ebb81c 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -101,112 +101,9 @@ as_rtf.fixed_design <- function( file, ...) { orientation <- match.arg(orientation) - - # get the design method - if ("ahr" %in% class(x)) { - design_mtd <- "ahr" - } else if ("fh" %in% class(x)) { - design_mtd <- "fh" - } else if ("mb" %in% class(x)) { - design_mtd <- "mb" - } else if ("lf" %in% class(x)) { - design_mtd <- "lf" - } else if ("rd" %in% class(x)) { - design_mtd <- "rd" - } else if ("maxcombo" %in% class(x)) { - design_mtd <- "maxcombo" - } else if ("milestone" %in% class(x)) { - design_mtd <- "milestone" - } else if ("rmst" %in% class(x)) { - design_mtd <- "rmst" - } else if ("rd" %in% class(x)) { - design_mtd <- "rd" - } - - # set the default title - if (is.null(title)) { - title <- switch(design_mtd, - "ahr" = { - paste0("Fixed Design under AHR Method", " {^a}") - }, - "fh" = { - paste0("Fixed Design under Fleming-Harrington Method", " {^a}") - }, - "mb" = { - paste0("Fixed Design under Magirr-Burman Method", " {^a}") - }, - "lf" = { - paste0("Fixed Design under Lachin and Foulkes Method", " {^a}") - }, - "rd" = { - paste0("Fixed Design of Risk Difference under Farrington-Manning Method", " {^a}") - }, - "maxcombo" = { - paste0("Fixed Design under MaxCombo Method", " {^a}") - }, - "milestone" = { - paste0("Fixed Design under Milestone Method", " {^a}") - }, - "rmst" = { - paste0("Fixed Design under Restricted Mean Survival Time Method", " {^a}") - }, - "rd" = { - paste0("Fixed Design of Risk Difference", " {^a}") - } - ) - } - - - # set the default footnote - if (is.null(footnote)) { - footnote <- switch(design_mtd, - "ahr" = { - paste0("{^a} ", "Power computed with average hazard ratio method.") - }, - "fh" = { - paste0( - "{^a} ", - "Power for Fleming-Harrington test ", - substr(x$Design, 19, nchar(x$Design)), - " using method of Yung and Liu." - ) - }, - "mb" = { - paste0( - "{^a} ", - "Power for ", - x$Design, - " computed with method of Yung and Liu." - ) - }, - "lf" = { - paste0( - "{^a} ", - "Power using Lachin and Foulkes method applied - using expected average hazard ratio (AHR) at time of planned analysis." - ) - }, - "rd" = { - paste0( - "{^a} ", - "Risk difference power without continuity correction using method of Farrington and Manning." - ) - }, - "maxcombo" = { - paste0( - "{^a} ", - "Power for MaxCombo test with Fleming-Harrington tests", - substr(x$Design, 9, nchar(x$Design)), "." - ) - }, - "milestone" = { - paste0("{^a} ", "Power for ", x$Design, " computed with method of Yung and Liu.") - }, - "rmst" = { - paste0("{^a} ", "Power for ", x$Design, " computed with method of Yung and Liu.") - } - ) - } + method <- design_method(x) + title <- title %||% paste(method_title(method), "{^a}") + footnote <- footnote %||% paste("{^a}", method_footnote(x, method)) # set default column width n_row <- nrow(x) From 4c926732db791add9f835ddb8a45b6af66ec18e1 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 16:27:41 -0500 Subject: [PATCH 07/43] an alternative way to find the method --- R/as_rtf.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index 21ebb81c..afbbed58 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -295,7 +295,7 @@ as_rtf.gs_design <- function( ...) { orientation <- match.arg(orientation) - method <- class(x)[class(x) %in% c("ahr", "wlr", "combo", "rd")] + method <- intersect(class(x), c("ahr", "wlr", "combo", "rd"))[1] x_alpha <- max((x %>% dplyr::filter(Bound == display_bound[1]))[["Null hypothesis"]]) x_non_binding <- "non_binding" %in% class(x) x_k <- lapply(x$Analysis, function(x) { From 5e493b55a82fcbcc712042f44e5aab4199936941 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 16:29:40 -0500 Subject: [PATCH 08/43] perhaps we should use `colname_spannersub[2]` as in `as_gt()`, instead of hard-coding `"Null hypothesis"` here? --- R/as_rtf.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index afbbed58..9bc8fce9 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -296,7 +296,7 @@ as_rtf.gs_design <- function( orientation <- match.arg(orientation) method <- intersect(class(x), c("ahr", "wlr", "combo", "rd"))[1] - x_alpha <- max((x %>% dplyr::filter(Bound == display_bound[1]))[["Null hypothesis"]]) + x_alpha <- max(filter(x, Bound == display_bound[1])[[colname_spannersub[2]]]) x_non_binding <- "non_binding" %in% class(x) x_k <- lapply(x$Analysis, function(x) { return(as.numeric(substring(x, 11, 11))) From 6dd61641a9dfc20fd4993925d53822b5926e8570 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 16:32:00 -0500 Subject: [PATCH 09/43] copy from as_gt() --- R/as_rtf.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index 9bc8fce9..b2faf2a5 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -297,10 +297,8 @@ as_rtf.gs_design <- function( method <- intersect(class(x), c("ahr", "wlr", "combo", "rd"))[1] x_alpha <- max(filter(x, Bound == display_bound[1])[[colname_spannersub[2]]]) - x_non_binding <- "non_binding" %in% class(x) - x_k <- lapply(x$Analysis, function(x) { - return(as.numeric(substring(x, 11, 11))) - }) %>% unlist() + x_non_binding <- inherits(x, "non_binding") + x_k <- as.numeric(substr(x$Analysis, 11, 11)) x_old <- x x <- data.frame(lapply(x, function(x) trimws(formatC(x, flag = "-"), "r"))) From becd0e0c438c0e5d113ae00242a990bbaf42e4d0 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 16:33:17 -0500 Subject: [PATCH 10/43] copying from as_gt(): the argument `display_inf_bound` was not actually used inside as_rtf(); is this someone's oversight? --- R/as_rtf.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/as_rtf.R b/R/as_rtf.R index b2faf2a5..d36a418c 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -299,6 +299,7 @@ as_rtf.gs_design <- function( x_alpha <- max(filter(x, Bound == display_bound[1])[[colname_spannersub[2]]]) x_non_binding <- inherits(x, "non_binding") x_k <- as.numeric(substr(x$Analysis, 11, 11)) + if (!display_inf_bound) x <- filter(x, !is.infinite(Z)) x_old <- x x <- data.frame(lapply(x, function(x) trimws(formatC(x, flag = "-"), "r"))) From 642e498f1e4343474957a585ab62c7b4d55402e6 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 16:46:18 -0500 Subject: [PATCH 11/43] rename design_method() to fixed_design_method() --- R/as_gt.R | 11 +++-------- R/as_rtf.R | 2 +- 2 files changed, 4 insertions(+), 9 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index c5199ed5..0a0e0280 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -79,7 +79,7 @@ as_gt <- function(x, ...) { #' summary() %>% #' as_gt() as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) { - method <- design_method(x) + method <- fixed_design_method(x) ans <- gt::gt(x) %>% gt::tab_header(title = title %||% method_title(method)) %>% gt::tab_footnote( @@ -89,8 +89,8 @@ as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) { return(ans) } -# get the design method -design_method <- function(x) { +# get the fixed design method +fixed_design_method <- function(x) { methods <- c("ahr", "fh", "mb", "lf", "rd", "maxcombo", "milestone", "rmst") intersect(methods, class(x))[1] } @@ -252,15 +252,10 @@ as_gt.gs_design <- function( method <- intersect(class(x), c("ahr", "wlr", "combo", "rd"))[1] full_alpha <- attr(x, "full_alpha") - x_alpha <- max(filter(x, Bound == display_bound[1])[[colname_spannersub[2]]]) - x_non_binding <- inherits(x, "non_binding") - x_k <- as.numeric(substr(x$Analysis, 11, 11)) - if (!display_inf_bound) x <- filter(x, !is.infinite(Z)) - x_old <- x # Set defaults ---- diff --git a/R/as_rtf.R b/R/as_rtf.R index d36a418c..1b19ee09 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -101,7 +101,7 @@ as_rtf.fixed_design <- function( file, ...) { orientation <- match.arg(orientation) - method <- design_method(x) + method <- fixed_design_method(x) title <- title %||% paste(method_title(method), "{^a}") footnote <- footnote %||% paste("{^a}", method_footnote(x, method)) From e271130fc81940db174baaa351499fd2c0edefa3 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 16:46:45 -0500 Subject: [PATCH 12/43] factor out gs_design_method() --- R/as_gt.R | 6 +++++- R/as_rtf.R | 2 +- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 0a0e0280..23a1ee0f 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -250,7 +250,7 @@ as_gt.gs_design <- function( display_inf_bound = FALSE, ...) { - method <- intersect(class(x), c("ahr", "wlr", "combo", "rd"))[1] + method <- gs_design_method(x) full_alpha <- attr(x, "full_alpha") x_alpha <- max(filter(x, Bound == display_bound[1])[[colname_spannersub[2]]]) x_non_binding <- inherits(x, "non_binding") @@ -387,6 +387,10 @@ as_gt.gs_design <- function( return(x) } +gs_design_method <- function(x) { + intersect(c("ahr", "wlr", "combo", "rd"), class(x))[1] +} + footnote_non_binding <- function(x_alpha, full_alpha) { a1 <- format(x_alpha, scientific = FALSE) a2 <- format(full_alpha, scientific = FALSE) diff --git a/R/as_rtf.R b/R/as_rtf.R index 1b19ee09..cb13c9cd 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -295,7 +295,7 @@ as_rtf.gs_design <- function( ...) { orientation <- match.arg(orientation) - method <- intersect(class(x), c("ahr", "wlr", "combo", "rd"))[1] + method <- gs_design_method(x) x_alpha <- max(filter(x, Bound == display_bound[1])[[colname_spannersub[2]]]) x_non_binding <- inherits(x, "non_binding") x_k <- as.numeric(substr(x$Analysis, 11, 11)) From c2c640e5306ed5e9c4002f14ac6c68ef2ac91d11 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 17:07:03 -0500 Subject: [PATCH 13/43] copy from as_gt() (will see how to refactor the code later) --- R/as_rtf.R | 210 +++++++++++++++-------------------------------------- 1 file changed, 59 insertions(+), 151 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index cb13c9cd..2c667858 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -307,175 +307,83 @@ as_rtf.gs_design <- function( # Set defaults ---- # set different default title to different methods - if (method == "ahr" && is.null(title)) { - title <- "Bound summary for AHR design" - } - if (method == "wlr" && is.null(title)) { - title <- "Bound summary for WLR design" - } - if (method == "combo" && is.null(title)) { - title <- "Bound summary for MaxCombo design" - } - - if (method == "rd" && is.null(title)) { - title <- "Bound summary of Binary Endpoint" - } + if (is.null(title)) title <- paste("Bound summary", switch( + method, + ahr = "for AHR design", wlr = "for WLR design", + combo = "for MaxCombo design", rd = "of Binary Endpoint" + )) # set different default subtitle to different methods - if (method == "ahr" && is.null(subtitle)) { - subtitle <- "AHR approximations of ~HR at bound" - } - if (method == "wlr" && is.null(subtitle)) { - subtitle <- "WLR approximation of ~wHR at bound" - } - if (method == "combo" && is.null(subtitle)) { - subtitle <- "MaxCombo approximation" - } - if (method == "rd" && is.null(subtitle)) { - subtitle <- "measured by risk difference" - } + if (is.null(subtitle)) subtitle <- switch( + method, + ahr = "AHR approximations of ~HR at bound", + wlr = "WLR approximation of ~wHR at bound", + combo = "MaxCombo approximation", + rd = "measured by risk difference" + ) # set different default columns to display - if (is.null(display_columns)) { - if (method == "ahr") { - display_columns <- c( - "Analysis", "Bound", "Z", "Nominal p", - "~HR at bound", "Alternate hypothesis", "Null hypothesis" - ) - } else if (method == "wlr") { - display_columns <- c( - "Analysis", "Bound", "Z", "Nominal p", - "~wHR at bound", "Alternate hypothesis", "Null hypothesis" - ) - } else if (method == "combo") { - display_columns <- c( - "Analysis", "Bound", "Z", "Nominal p", - "Alternate hypothesis", "Null hypothesis" - ) - } else if (method == "rd") { - display_columns <- c( - "Analysis", "Bound", "Z", "Nominal p", - "~Risk difference at bound", "Alternate hypothesis", "Null hypothesis" - ) - } - } + if (is.null(display_columns)) display_columns <- c( + "Analysis", "Bound", "Z", "Nominal p", + sprintf("%s at bound", switch(method, ahr = "~HR", wlr = "~wHR", rd = "~Risk difference")), + "Alternate hypothesis", "Null hypothesis" + ) # filter the columns to display as the output ## if `Probability` is selected to output, then transform it to `c("Alternate hypothesis", "Null hypothesis")` - if ("Probability" %in% display_columns) { - display_columns <- display_columns[!display_columns == "Probability"] - display_columns <- c(display_columns, "Alternate hypothesis", "Null hypothesis") - } + if (any(i <- display_columns == "Probability")) + display_columns <- c(display_columns[!i], "Alternate hypothesis", "Null hypothesis") ## check if the `display_columns` are included in `x` output - if (sum(!(display_columns %in% names(x))) >= 1) { - stop("as_rtf: the variable names in display_columns is not outputted in the summary_bound object!") - } else { - x <- x %>% dplyr::select(dplyr::all_of(display_columns)) - } + if (!all(display_columns %in% names(x))) stop( + "not all variable names in 'display_columns' are in the summary_bound object!" + ) + x <- x[, display_columns] # set different default footnotes to different methods - if (method == "ahr" && is.null(footnote)) { - footnote <- list( + if (is.null(footnote)) footnote <- switch( + method, + ahr = list( content = c( - ifelse( - "Nominal p" %in% display_columns, - paste( - "One-sided p-value for experimental vs control treatment.", - "Value < 0.5 favors experimental, > 0.5 favors control." - ), - NA - ), - ifelse( - "~HR at bound" %in% display_columns, + if (i1 <- "~HR at bound" %in% display_columns) "Approximate hazard ratio to cross bound.", - NA - ) - ), - location = c( - ifelse("Nominal p" %in% display_columns, "Nominal p", NA), - ifelse("~HR at bound" %in% display_columns, "~HR at bound", NA) + if (i2 <- "Nominal p" %in% display_columns) + "One-sided p-value for experimental vs control treatment. + Value < 0.5 favors experimental, > 0.5 favors control." ), - attr = c( - ifelse("Nominal p" %in% display_columns, "colname", NA), - ifelse("~HR at bound" %in% display_columns, "colname", NA) - ) - ) - footnote <- lapply(footnote, function(x) x[!is.na(x)]) - } - if (method == "wlr" && is.null(footnote)) { - footnote <- list( + location = c(if (i1) "~HR at bound", if (i2) "Nominal p"), + attr = c(if (i1) "colname", if (i2) "colname") + ), + wlr = list( content = c( - ifelse( - "Nominal p" %in% display_columns, - paste( - "One-sided p-value for experimental vs control treatment.", - "Value < 0.5 favors experimental, > 0.5 favors control." - ), - NA - ), - ifelse( - "~wHR at bound" %in% display_columns, + if (i1 <- "~wHR at bound" %in% display_columns) "Approximate hazard ratio to cross bound.", - NA - ), + if (i2 <- "Nominal p" %in% display_columns) + "One-sided p-value for experimental vs control treatment. + Value < 0.5 favors experimental, > 0.5 favors control.", "wAHR is the weighted AHR." ), - location = c( - ifelse("Nominal p" %in% display_columns, "Nominal p", NA), - ifelse("~wHR at bound" %in% display_columns, "~wHR at bound", NA), - NA - ), - attr = c( - ifelse("Nominal p" %in% display_columns, "colname", NA), - ifelse("~wHR at bound" %in% display_columns, "colname", NA), - "analysis" - ) - ) - footnote <- lapply(footnote, function(x) x[!is.na(x)]) - } - if (method == "combo" && is.null(footnote)) { - footnote <- list( + location = c(if (i1) "~wHR at bound", if (i2) "Nominal p"), + attr = c(if (i1) "colname", if (i2) "colname", "analysis") + ), + combo = list( content = c( - ifelse( - "Nominal p" %in% display_columns, - paste( - "One-sided p-value for experimental vs control treatment.", - "Value < 0.5 favors experimental, > 0.5 favors control." - ), - NA - ), - "EF is event fraction. AHR is under regular weighted log rank test." - ), - location = c( - ifelse("Nominal p" %in% display_columns, "Nominal p", NA), - NA - ), - attr = c( - ifelse("Nominal p" %in% display_columns, "colname", NA), - "analysis" - ) - ) - footnote <- lapply(footnote, function(x) x[!is.na(x)]) - } - if (method == "rd" && is.null(footnote)) { - footnote <- list( - content = c(ifelse( - "Nominal p" %in% display_columns, - paste( - "One-sided p-value for experimental vs control treatment.", - "Value < 0.5 favors experimental, > 0.5 favors control." - ), - NA - )), - location = c(ifelse("Nominal p" %in% display_columns, "Nominal p", NA)), - attr = c(ifelse("Nominal p" %in% display_columns, "colname", NA)) + if (i2 <- "Nominal p" %in% display_columns) + "One-sided p-value for experimental vs control treatment. + Value < 0.5 favors experimental, > 0.5 favors control.", + "EF is event fraction. AHR is under regular weighted log rank test."), + location = if (i2) "Nominal p", + attr = c(if (i2) "colname", "analysis") + ), + rd = list( + content = if (i2 <- "Nominal p" %in% display_columns) + "One-sided p-value for experimental vs control treatment. + Value < 0.5 favors experimental, > 0.5 favors control.", + location = if (i2) "Nominal p", + attr = if (i2) "colname" ) - footnote <- lapply(footnote, function(x) x[!is.na(x)]) - } + ) # Filter out inf bound ---- - x <- x %>% - subset(!is.na(`Alternate hypothesis`)) %>% - subset(!is.na(`Null hypothesis`)) + x <- subset(x, !is.na(`Alternate hypothesis`) & !is.na(`Null hypothesis`)) # organize data x <- x %>% @@ -496,8 +404,8 @@ as_rtf.gs_design <- function( } # set column header - names(x)[names(x) == "Alternate hypothesis"] <- colname_spannersub[1] - names(x)[names(x) == "Null hypothesis"] <- colname_spannersub[2] + i <- match(c("Alternate hypothesis", "Null hypothesis"), names(x)) + names(x)[i] <- colname_spannersub colheader <- c( paste0(" | ", colname_spanner), From 26c3d2bbc1666287f317aa6a6232f4f44681df48 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 17:07:34 -0500 Subject: [PATCH 14/43] copy from as_rtf.fixed_design() --- R/as_rtf.R | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index 2c667858..2c54eb52 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -393,15 +393,10 @@ as_rtf.gs_design <- function( # Set rtf parameters ---- n_col <- ncol(x) n_row <- nrow(x) - if (!is.null(col_rel_width) && !(n_col == length(col_rel_width))) { - stop( - "col_rel_width must have the same length (has ", - length(col_rel_width), - ") as `x` has number of columns (has ", - n_col, ").", - call. = FALSE - ) - } + if (!is.null(col_rel_width) && n_col != length(col_rel_width)) stop( + "The length of 'col_rel_width' (", length(col_rel_width), ") differs with ", + "the number of columns in 'x' (", n_col, ")." + ) # set column header i <- match(c("Alternate hypothesis", "Null hypothesis"), names(x)) From 6b34090c9e683bcc6ae439474de3be47df0cd0e1 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 17:08:37 -0500 Subject: [PATCH 15/43] use %||% --- R/as_rtf.R | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index 2c54eb52..6ec06ce4 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -408,11 +408,7 @@ as_rtf.gs_design <- function( ) # set relative width - if (is.null(col_rel_width)) { - rel_width_body <- rep(1, n_col) - } else { - rel_width_body <- col_rel_width - } + rel_width_body <- col_rel_width %||% rep(1, n_col) rel_width_head <- rel_width_body[2:length(rel_width_body)] rel_width_head <- list( From 98c0bca02ee3cd2259767e670870ed6da84b888e Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 17:18:34 -0500 Subject: [PATCH 16/43] 2:length is equivalent to -1 (well, assuming length >= 2) --- R/as_rtf.R | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index 6ec06ce4..dc883da4 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -410,12 +410,9 @@ as_rtf.gs_design <- function( # set relative width rel_width_body <- col_rel_width %||% rep(1, n_col) - rel_width_head <- rel_width_body[2:length(rel_width_body)] + rel_width_head <- rel_width_body[-1] rel_width_head <- list( - c( - sum(rel_width_head[2:(n_col - 2)]), - sum(tail(rel_width_head, n = 2)) - ), + c(sum(rel_width_head[2:(n_col - 2)]), sum(tail(rel_width_head, 2))), rel_width_head ) From 680fc01ba68af561e49be42cc9ebcce56b16f595 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 17:20:17 -0500 Subject: [PATCH 17/43] simplify these border variables a little bit --- R/as_rtf.R | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index dc883da4..a66008f1 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -417,14 +417,9 @@ as_rtf.gs_design <- function( ) # column boarder - border_top_head <- rep("single", (n_col - 1)) - border_top_body <- rep("single", n_col) - border_bottom <- rep("single", n_col) - border_left_head <- list( - c("single", "single"), - rep("single", n_col - 1) - ) - border_left_body <- c("single", border_left_head[[2]]) + border_top_body <- border_bottom <- border_left_body <- rep("single", n_col) + border_top_head <- border_top_body[-1] + border_left_head <- list(rep("single", 2), border_top_head) # Using order number to customize row format text_justification <- c("l", "l", rep("c", n_col - 2)) From ee5387aa60d387c10bae61f4f49c1b1c5e4f2ee8 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 17:43:05 -0500 Subject: [PATCH 18/43] intToUtf8() sounds like an overkill; we can simply index the `letters` vector --- R/as_rtf.R | 72 ++++++++++++++++++++++++++++-------------------------- 1 file changed, 37 insertions(+), 35 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index a66008f1..3a5452ba 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -429,44 +429,46 @@ as_rtf.gs_design <- function( # Add footnotes ---- # initialization for footnote footnotes <- NULL - alpha_utf_int <- 96 - - if (!is.null(footnote$content)) { - if (length(footnote$content) > 0) { - for (i in seq_along(footnote$content)) { - alpha_utf_int <- alpha_utf_int + 1 - if (footnote$attr[i] == "colname") { - colheader[2] <- sub( - footnote$location[i], - paste0(footnote$location[i], " {^", intToUtf8(alpha_utf_int), "}"), - colheader[2] - ) - } else if (footnote$attr[i] == "title") { - title <- paste0(title, " \\super ", intToUtf8(alpha_utf_int)) - } else if (footnote$attr[i] == "subtitle") { - subtitle <- paste0(subtitle, " {\\super ", intToUtf8(alpha_utf_int), "}") - } else if (footnote$attr[i] == "analysis") { - x["Analysis"] <- lapply(x["Analysis"], function(z) paste0(z, " {^", intToUtf8(alpha_utf_int), "}")) - } else if (footnote$attr[i] == "spanner") { - colheader[1] <- sub( - colname_spanner, - paste0(colname_spanner, " {^", intToUtf8(alpha_utf_int), "}"), - colheader[1] - ) - } - marked_footnote <- paste0("{\\super ", intToUtf8(alpha_utf_int), "} ", footnote$content[i]) - if (!is.null(footnotes)) { - footnotes <- paste0(footnotes, "\\line", marked_footnote) - } else { - footnotes <- marked_footnote - } - } + # footnote markers (a, b, c, ...) + marker <- local({ + i <- 0L + function() { + i <<- i + 1L + letters[i] + } + }) + + for (i in seq_along(footnote$content)) { + att <- footnote$attr[i] + mkr <- marker() + if (att == "colname") { + colheader[2] <- sub( + footnote$location[i], + paste0(footnote$location[i], " {^", mkr, "}"), + colheader[2] + ) + } else if (att == "title") { + title <- paste0(title, " \\super ", mkr) + } else if (att == "subtitle") { + subtitle <- paste0(subtitle, " {\\super ", mkr, "}") + } else if (att == "analysis") { + x["Analysis"] <- lapply(x["Analysis"], function(z) paste0(z, " {^", mkr, "}")) + } else if (att == "spanner") { + colheader[1] <- sub( + colname_spanner, + paste0(colname_spanner, " {^", mkr, "}"), + colheader[1] + ) + } + marked_footnote <- paste0("{\\super ", mkr, "} ", footnote$content[i]) + footnotes <- if (is.null(footnotes)) marked_footnote else { + paste0(footnotes, "\\line", marked_footnote) } } ## if it is non-binding design if (x_non_binding && (x_alpha < full_alpha)) { - alpha_utf_int <- alpha_utf_int + 1 + mkr <- marker() x[ (substring(x$Analysis, 1, 11) == paste0("Analysis: ", max(x_k))) & @@ -476,11 +478,11 @@ as_rtf.gs_design <- function( (substring(x$Analysis, 1, 11) == paste0("Analysis: ", max(x_k))) & x$Bound == display_bound[1], colname_spannersub[2] ], - " {^", intToUtf8(alpha_utf_int), "}" + " {^", mkr, "}" ) footnote_nb <- paste0( - "{\\super ", intToUtf8(alpha_utf_int), "} ", + "{\\super ", mkr, "} ", footnote_non_binding(x_alpha, full_alpha) ) From 709bc0535e22797943e9a059bbc103505d6bc78c Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 17:46:54 -0500 Subject: [PATCH 19/43] factor out the row/column indices to make [] thinner --- R/as_rtf.R | 16 ++++------------ 1 file changed, 4 insertions(+), 12 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index 3a5452ba..c829500d 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -469,23 +469,15 @@ as_rtf.gs_design <- function( ## if it is non-binding design if (x_non_binding && (x_alpha < full_alpha)) { mkr <- marker() - - x[ - (substring(x$Analysis, 1, 11) == paste0("Analysis: ", max(x_k))) & - x$Bound == display_bound[1], colname_spannersub[2] - ] <- paste0( - x[ - (substring(x$Analysis, 1, 11) == paste0("Analysis: ", max(x_k))) & - x$Bound == display_bound[1], colname_spannersub[2] - ], - " {^", mkr, "}" - ) + i <- substring(x$Analysis, 1, 11) == paste0("Analysis: ", max(x_k)) & + x$Bound == display_bound[1] + j <- colname_spannersub[2] + x[i, j] <- paste0(x[i, j], " {^", mkr, "}") footnote_nb <- paste0( "{\\super ", mkr, "} ", footnote_non_binding(x_alpha, full_alpha) ) - footnotes <- if (is.null(footnotes)) footnote_nb else { paste0(footnotes, "\\line", footnote_nb) } From a16e25c610256a80c80d1e1083f2ebaa77ce82dd Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 17:50:23 -0500 Subject: [PATCH 20/43] I don't think `footnotes` can be NULL --- R/as_rtf.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index c829500d..ab9c5a0e 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -147,9 +147,7 @@ as_rtf.fixed_design <- function( text_font_size = text_font_size ) - if (!is.null(footnote)) { - ans <- r2rtf::rtf_footnote(ans, footnote, text_font_size = text_font_size) - } + ans <- r2rtf::rtf_footnote(ans, footnote, text_font_size = text_font_size) # Prepare output r2rtf::write_rtf(r2rtf::rtf_encode(ans), file) From f705696b2281de64df4ba713121000fd2838bfb2 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 20:48:07 -0500 Subject: [PATCH 21/43] this element should be hard-coded as `"Null hypothesis"` (otherwise it will break a test), and I think we should do the same in as_gt() --- R/as_rtf.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index ab9c5a0e..317da5c1 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -294,7 +294,7 @@ as_rtf.gs_design <- function( orientation <- match.arg(orientation) method <- gs_design_method(x) - x_alpha <- max(filter(x, Bound == display_bound[1])[[colname_spannersub[2]]]) + x_alpha <- max(filter(x, Bound == display_bound[1])[["Null hypothesis"]]) x_non_binding <- inherits(x, "non_binding") x_k <- as.numeric(substr(x$Analysis, 11, 11)) if (!display_inf_bound) x <- filter(x, !is.infinite(Z)) From bb3397a515dfc4d00d43a205bb07a61f25b885de Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 20:48:54 -0500 Subject: [PATCH 22/43] factor out more strings into footnote_content() --- R/as_gt.R | 12 ++++++++++++ R/as_rtf.R | 43 +++++++++++++++++-------------------------- 2 files changed, 29 insertions(+), 26 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 23a1ee0f..8622dba6 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -391,6 +391,18 @@ gs_design_method <- function(x) { intersect(c("ahr", "wlr", "combo", "rd"), class(x))[1] } +footnote_content <- function(nominal_p, hazard_ratio, ...) { + c( + if (nominal_p) paste( + "One-sided p-value for experimental vs control treatment.", + "Value < 0.5 favors experimental, > 0.5 favors control." + ), + if (hazard_ratio) + "Approximate hazard ratio to cross bound.", + ... + ) +} + footnote_non_binding <- function(x_alpha, full_alpha) { a1 <- format(x_alpha, scientific = FALSE) a2 <- format(full_alpha, scientific = FALSE) diff --git a/R/as_rtf.R b/R/as_rtf.R index 317da5c1..f3278e09 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -340,43 +340,34 @@ as_rtf.gs_design <- function( if (is.null(footnote)) footnote <- switch( method, ahr = list( - content = c( - if (i1 <- "~HR at bound" %in% display_columns) - "Approximate hazard ratio to cross bound.", - if (i2 <- "Nominal p" %in% display_columns) - "One-sided p-value for experimental vs control treatment. - Value < 0.5 favors experimental, > 0.5 favors control." + content = footnote_content( + i1 <- "Nominal p" %in% display_columns, + i2 <- "~HR at bound" %in% display_columns ), - location = c(if (i1) "~HR at bound", if (i2) "Nominal p"), + location = c(if (i1) "Nominal p", if (i2) "~HR at bound"), attr = c(if (i1) "colname", if (i2) "colname") ), wlr = list( - content = c( - if (i1 <- "~wHR at bound" %in% display_columns) - "Approximate hazard ratio to cross bound.", - if (i2 <- "Nominal p" %in% display_columns) - "One-sided p-value for experimental vs control treatment. - Value < 0.5 favors experimental, > 0.5 favors control.", + content = footnote_content( + i1 <- "Nominal p" %in% display_columns, + i2 <- "~wHR at bound" %in% display_columns, "wAHR is the weighted AHR." ), - location = c(if (i1) "~wHR at bound", if (i2) "Nominal p"), + location = c(if (i1) "Nominal p", if (i2) "~wHR at bound"), attr = c(if (i1) "colname", if (i2) "colname", "analysis") ), combo = list( - content = c( - if (i2 <- "Nominal p" %in% display_columns) - "One-sided p-value for experimental vs control treatment. - Value < 0.5 favors experimental, > 0.5 favors control.", - "EF is event fraction. AHR is under regular weighted log rank test."), - location = if (i2) "Nominal p", - attr = c(if (i2) "colname", "analysis") + content = footnote_content( + i1 <- "Nominal p" %in% display_columns, FALSE, + "EF is event fraction. AHR is under regular weighted log rank test." + ), + location = if (i1) "Nominal p", + attr = c(if (i1) "colname", "analysis") ), rd = list( - content = if (i2 <- "Nominal p" %in% display_columns) - "One-sided p-value for experimental vs control treatment. - Value < 0.5 favors experimental, > 0.5 favors control.", - location = if (i2) "Nominal p", - attr = if (i2) "colname" + content = footnote_content(i1 <- "Nominal p" %in% display_columns, FALSE), + location = if (i1) "Nominal p", + attr = if (i1) "colname" ) ) From b0fb333bf0d450a634b832e4386886d4be2bd3a0 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 20:53:14 -0500 Subject: [PATCH 23/43] reuse footnote_content() and eliminate line breaks (which don't matter in LaTeX) --- R/as_gt.R | 43 +++++++++------------- tests/testthat/_snaps/independent_as_gt.md | 30 +++++---------- 2 files changed, 27 insertions(+), 46 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 8622dba6..a0fc5e69 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -295,43 +295,34 @@ as_gt.gs_design <- function( if (is.null(footnote)) footnote <- switch( method, ahr = list( - content = c( - if (i1 <- "~HR at bound" %in% display_columns) - "Approximate hazard ratio to cross bound.", - if (i2 <- "Nominal p" %in% display_columns) - "One-sided p-value for experimental vs control treatment. - Value < 0.5 favors experimental, > 0.5 favors control." + content = footnote_content( + i1 <- "Nominal p" %in% display_columns, + i2 <- "~HR at bound" %in% display_columns ), - location = c(if (i1) "~HR at bound", if (i2) "Nominal p"), + location = c(if (i1) "Nominal p", if (i2) "~HR at bound"), attr = c(if (i1) "colname", if (i2) "colname") ), wlr = list( - content = c( - if (i1 <- "~wHR at bound" %in% display_columns) - "Approximate hazard ratio to cross bound.", - if (i2 <- "Nominal p" %in% display_columns) - "One-sided p-value for experimental vs control treatment. - Value < 0.5 favors experimental, > 0.5 favors control.", + content = footnote_content( + i1 <- "Nominal p" %in% display_columns, + i2 <- "~wHR at bound" %in% display_columns, "wAHR is the weighted AHR." ), - location = c(if (i1) "~wHR at bound", if (i2) "Nominal p"), + location = c(if (i1) "Nominal p", if (i2) "~wHR at bound"), attr = c(if (i1) "colname", if (i2) "colname", "analysis") ), combo = list( - content = c( - if (i2 <- "Nominal p" %in% display_columns) - "One-sided p-value for experimental vs control treatment. - Value < 0.5 favors experimental, > 0.5 favors control.", - "EF is event fraction. AHR is under regular weighted log rank test."), - location = if (i2) "Nominal p", - attr = c(if (i2) "colname", "analysis") + content = footnote_content( + i1 <- "Nominal p" %in% display_columns, FALSE, + "EF is event fraction. AHR is under regular weighted log rank test." + ), + location = if (i1) "Nominal p", + attr = c(if (i1) "colname", "analysis") ), rd = list( - content = if (i2 <- "Nominal p" %in% display_columns) - "One-sided p-value for experimental vs control treatment. - Value < 0.5 favors experimental, > 0.5 favors control.", - location = if (i2) "Nominal p", - attr = if (i2) "colname" + content = footnote_content(i1 <- "Nominal p" %in% display_columns, FALSE), + location = if (i1) "Nominal p", + attr = if (i1) "colname" ) ) diff --git a/tests/testthat/_snaps/independent_as_gt.md b/tests/testthat/_snaps/independent_as_gt.md index bf8bf5a3..ff3a75c6 100644 --- a/tests/testthat/_snaps/independent_as_gt.md +++ b/tests/testthat/_snaps/independent_as_gt.md @@ -79,8 +79,7 @@ \bottomrule \end{longtable} \begin{minipage}{\linewidth} - \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. - Value < 0.5 favors experimental, > 0.5 favors control.\\ + \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. Value < 0.5 favors experimental, > 0.5 favors control.\\ \textsuperscript{\textit{2}}Approximate hazard ratio to cross bound.\\ \end{minipage} \endgroup @@ -117,8 +116,7 @@ \bottomrule \end{longtable} \begin{minipage}{\linewidth} - \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. - Value < 0.5 favors experimental, > 0.5 favors control.\\ + \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. Value < 0.5 favors experimental, > 0.5 favors control.\\ \textsuperscript{\textit{2}}Approximate hazard ratio to cross bound.\\ \end{minipage} \endgroup @@ -144,8 +142,7 @@ \bottomrule \end{longtable} \begin{minipage}{\linewidth} - \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. - Value < 0.5 favors experimental, > 0.5 favors control.\\ + \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. Value < 0.5 favors experimental, > 0.5 favors control.\\ \textsuperscript{\textit{2}}Approximate hazard ratio to cross bound.\\ \textsuperscript{\textit{3}}wAHR is the weighted AHR.\\ \end{minipage} @@ -222,8 +219,7 @@ \bottomrule \end{longtable} \begin{minipage}{\linewidth} - \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. - Value < 0.5 favors experimental, > 0.5 favors control.\\ + \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. Value < 0.5 favors experimental, > 0.5 favors control.\\ \textsuperscript{\textit{2}}EF is event fraction. AHR is under regular weighted log rank test.\\ \end{minipage} \endgroup @@ -249,8 +245,7 @@ \bottomrule \end{longtable} \begin{minipage}{\linewidth} - \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. - Value < 0.5 favors experimental, > 0.5 favors control.\\ + \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. Value < 0.5 favors experimental, > 0.5 favors control.\\ \end{minipage} \endgroup @@ -284,8 +279,7 @@ \bottomrule \end{longtable} \begin{minipage}{\linewidth} - \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. - Value < 0.5 favors experimental, > 0.5 favors control.\\ + \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. Value < 0.5 favors experimental, > 0.5 favors control.\\ \textsuperscript{\textit{2}}Cumulative alpha for final analysis (0.0238) is less than the full alpha (0.025) when the futility bound is non-binding. The smaller value subtracts the probability of crossing a futility bound before crossing an efficacy bound at a later analysis (0.025 - 0.0012 = 0.0238) under the null hypothesis.\\ \end{minipage} \endgroup @@ -322,8 +316,7 @@ \bottomrule \end{longtable} \begin{minipage}{\linewidth} - \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. - Value < 0.5 favors experimental, > 0.5 favors control.\\ + \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. Value < 0.5 favors experimental, > 0.5 favors control.\\ \textsuperscript{\textit{2}}Approximate hazard ratio to cross bound.\\ \textsuperscript{\textit{3}}wAHR is the weighted AHR.\\ \end{minipage} @@ -361,8 +354,7 @@ \bottomrule \end{longtable} \begin{minipage}{\linewidth} - \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. - Value < 0.5 favors experimental, > 0.5 favors control.\\ + \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. Value < 0.5 favors experimental, > 0.5 favors control.\\ \textsuperscript{\textit{2}}Approximate hazard ratio to cross bound.\\ \textsuperscript{\textit{3}}wAHR is the weighted AHR.\\ \textsuperscript{\textit{4}}Cumulative alpha for final analysis (-Inf) is less than the full alpha (0.025) when the futility bound is non-binding. The smaller value subtracts the probability of crossing a futility bound before crossing an efficacy bound at a later analysis (0.025 - Inf = -Inf) under the null hypothesis.\\ @@ -437,8 +429,7 @@ \bottomrule \end{longtable} \begin{minipage}{\linewidth} - \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. - Value < 0.5 favors experimental, > 0.5 favors control.\\ + \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. Value < 0.5 favors experimental, > 0.5 favors control.\\ \textsuperscript{\textit{2}}Approximate hazard ratio to cross bound.\\ \textsuperscript{\textit{3}}wAHR is the weighted AHR.\\ \end{minipage} @@ -476,8 +467,7 @@ \bottomrule \end{longtable} \begin{minipage}{\linewidth} - \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. - Value < 0.5 favors experimental, > 0.5 favors control.\\ + \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. Value < 0.5 favors experimental, > 0.5 favors control.\\ \textsuperscript{\textit{2}}wAHR is the weighted AHR.\\ \end{minipage} \endgroup From 73370df27d84584877c2e6b4fa56193f23b16aa0 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 23:56:56 -0500 Subject: [PATCH 24/43] amend c2c640e5306ed5e9c4002f14ac6c68ef2ac91d11: factor out the default footnote content --- R/as_gt.R | 60 +++++++++++++++++++----------------------------------- R/as_rtf.R | 34 +------------------------------ R/utils.R | 8 ++++++++ 3 files changed, 30 insertions(+), 72 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index a0fc5e69..eca219ab 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -292,39 +292,7 @@ as_gt.gs_design <- function( x <- x[, display_columns] # set different default footnotes to different methods - if (is.null(footnote)) footnote <- switch( - method, - ahr = list( - content = footnote_content( - i1 <- "Nominal p" %in% display_columns, - i2 <- "~HR at bound" %in% display_columns - ), - location = c(if (i1) "Nominal p", if (i2) "~HR at bound"), - attr = c(if (i1) "colname", if (i2) "colname") - ), - wlr = list( - content = footnote_content( - i1 <- "Nominal p" %in% display_columns, - i2 <- "~wHR at bound" %in% display_columns, - "wAHR is the weighted AHR." - ), - location = c(if (i1) "Nominal p", if (i2) "~wHR at bound"), - attr = c(if (i1) "colname", if (i2) "colname", "analysis") - ), - combo = list( - content = footnote_content( - i1 <- "Nominal p" %in% display_columns, FALSE, - "EF is event fraction. AHR is under regular weighted log rank test." - ), - location = if (i1) "Nominal p", - attr = c(if (i1) "colname", "analysis") - ), - rd = list( - content = footnote_content(i1 <- "Nominal p" %in% display_columns, FALSE), - location = if (i1) "Nominal p", - attr = if (i1) "colname" - ) - ) + footnote <- footnote %||% footnote_content(method, display_columns) # Filter out inf bound ---- x <- subset(x, !is.na(`Alternate hypothesis`) & !is.na(`Null hypothesis`)) @@ -382,15 +350,29 @@ gs_design_method <- function(x) { intersect(c("ahr", "wlr", "combo", "rd"), class(x))[1] } -footnote_content <- function(nominal_p, hazard_ratio, ...) { - c( - if (nominal_p) paste( +footnote_content <- function(method, display_columns) { + n <- c("Nominal p", "~HR at bound", "~wHR at bound") + i <- n %in% display_columns + res <- if (i[1]) list( + content = paste( "One-sided p-value for experimental vs control treatment.", "Value < 0.5 favors experimental, > 0.5 favors control." ), - if (hazard_ratio) - "Approximate hazard ratio to cross bound.", - ... + location = n[1], attr = "colname" + ) else { + list(content = NULL, location = NULL, attr = NULL) + } + x <- "Approximate hazard ratio to cross bound." + switch( + method, + ahr = res %+% if (i[2]) list(x, n[2], "colname"), + wlr = res %+% (if (i[3]) list(x, n[3], "colname")) %+% + list("wAHR is the weighted AHR.", NULL, "analysis"), + combo = res %+% list( + "EF is event fraction. AHR is under regular weighted log rank test.", + NULL, "analysis" + ), + rd = res ) } diff --git a/R/as_rtf.R b/R/as_rtf.R index f3278e09..dd22e902 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -337,39 +337,7 @@ as_rtf.gs_design <- function( x <- x[, display_columns] # set different default footnotes to different methods - if (is.null(footnote)) footnote <- switch( - method, - ahr = list( - content = footnote_content( - i1 <- "Nominal p" %in% display_columns, - i2 <- "~HR at bound" %in% display_columns - ), - location = c(if (i1) "Nominal p", if (i2) "~HR at bound"), - attr = c(if (i1) "colname", if (i2) "colname") - ), - wlr = list( - content = footnote_content( - i1 <- "Nominal p" %in% display_columns, - i2 <- "~wHR at bound" %in% display_columns, - "wAHR is the weighted AHR." - ), - location = c(if (i1) "Nominal p", if (i2) "~wHR at bound"), - attr = c(if (i1) "colname", if (i2) "colname", "analysis") - ), - combo = list( - content = footnote_content( - i1 <- "Nominal p" %in% display_columns, FALSE, - "EF is event fraction. AHR is under regular weighted log rank test." - ), - location = if (i1) "Nominal p", - attr = c(if (i1) "colname", "analysis") - ), - rd = list( - content = footnote_content(i1 <- "Nominal p" %in% display_columns, FALSE), - location = if (i1) "Nominal p", - attr = if (i1) "colname" - ) - ) + footnote <- footnote %||% footnote_content(method, display_columns) # Filter out inf bound ---- x <- subset(x, !is.na(`Alternate hypothesis`) & !is.na(`Null hypothesis`)) diff --git a/R/utils.R b/R/utils.R index 841eb12a..bca42fde 100644 --- a/R/utils.R +++ b/R/utils.R @@ -2,3 +2,11 @@ if (!exists('%||%', baseenv(), inherits = FALSE)) `%||%` <- function(x, y) { if (is.null(x)) y else x } + +# append elements from y to x +`%+%` <- function(x, y) { + # append by names if available, otherwise append by integer indices + idx <- names(y) %||% seq_along(y) + for (i in idx) x[[i]] <- c(x[[i]], y[[i]]) + x +} From 9c7308a33420d6662f8984dd2133940542da91cb Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 13 Aug 2024 00:05:12 -0500 Subject: [PATCH 25/43] it may be more readable without using a closure from local() --- R/as_rtf.R | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index dd22e902..877257c8 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -386,14 +386,12 @@ as_rtf.gs_design <- function( # Add footnotes ---- # initialization for footnote footnotes <- NULL - # footnote markers (a, b, c, ...) - marker <- local({ - i <- 0L - function() { - i <<- i + 1L - letters[i] - } - }) + # footnote markers (a, b, c, ... from letters[idx]) + idx <- 0L + marker <- function() { + idx <<- idx + 1L + letters[idx] + } for (i in seq_along(footnote$content)) { att <- footnote$attr[i] From ebfb90457e6f28976250062eb6e190ea5958a75d Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 13 Aug 2024 00:14:37 -0500 Subject: [PATCH 26/43] rename `method_title` to `fixed_method_title`, and add `gs_method_title` / `gs_method_subtitle` --- R/as_gt.R | 41 ++++++++++++++++++++++++----------------- R/as_rtf.R | 19 +++---------------- 2 files changed, 27 insertions(+), 33 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index eca219ab..089a038c 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -81,7 +81,7 @@ as_gt <- function(x, ...) { as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) { method <- fixed_design_method(x) ans <- gt::gt(x) %>% - gt::tab_header(title = title %||% method_title(method)) %>% + gt::tab_header(title = title %||% fixed_method_title(method)) %>% gt::tab_footnote( footnote = footnote %||% method_footnote(x, method), locations = gt::cells_title(group = "title") @@ -96,7 +96,7 @@ fixed_design_method <- function(x) { } # get the default title -method_title <- function(method) { +fixed_method_title <- function(method) { sprintf("Fixed Design %s Method", switch( method, ahr = "under AHR", fh = "under Fleming-Harrington", mb = "under Magirr-Burman", @@ -259,21 +259,8 @@ as_gt.gs_design <- function( x_old <- x # Set defaults ---- - # set different default title to different methods - if (is.null(title)) title <- paste("Bound summary", switch( - method, - ahr = "for AHR design", wlr = "for WLR design", - combo = "for MaxCombo design", rd = "of Binary Endpoint" - )) - - # set different default subtitle to different methods - if (is.null(subtitle)) subtitle <- switch( - method, - ahr = "AHR approximations of ~HR at bound", - wlr = "WLR approximation of ~wHR at bound", - combo = "MaxCombo approximation", - rd = "measured by risk difference" - ) + title <- title %||% gs_method_title(method) + subtitle <- subtitle %||% gs_method_subtitle(method) # set different default columns to display if (is.null(display_columns)) display_columns <- c( @@ -350,6 +337,26 @@ gs_design_method <- function(x) { intersect(c("ahr", "wlr", "combo", "rd"), class(x))[1] } +# get different default title for different gs_design methods +gs_method_title <- function(method) { + paste("Bound summary", switch( + method, + ahr = "for AHR design", wlr = "for WLR design", + combo = "for MaxCombo design", rd = "of Binary Endpoint" + )) +} + +# get different default subtitle for different gs_design methods +gs_method_subtitle <- function(method) { + switch( + method, + ahr = "AHR approximations of ~HR at bound", + wlr = "WLR approximation of ~wHR at bound", + combo = "MaxCombo approximation", + rd = "measured by risk difference" + ) +} + footnote_content <- function(method, display_columns) { n <- c("Nominal p", "~HR at bound", "~wHR at bound") i <- n %in% display_columns diff --git a/R/as_rtf.R b/R/as_rtf.R index 877257c8..f8474dec 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -102,7 +102,7 @@ as_rtf.fixed_design <- function( ...) { orientation <- match.arg(orientation) method <- fixed_design_method(x) - title <- title %||% paste(method_title(method), "{^a}") + title <- title %||% paste(fixed_method_title(method), "{^a}") footnote <- footnote %||% paste("{^a}", method_footnote(x, method)) # set default column width @@ -304,21 +304,6 @@ as_rtf.gs_design <- function( names(x) <- names(x_old) # Set defaults ---- - # set different default title to different methods - if (is.null(title)) title <- paste("Bound summary", switch( - method, - ahr = "for AHR design", wlr = "for WLR design", - combo = "for MaxCombo design", rd = "of Binary Endpoint" - )) - - # set different default subtitle to different methods - if (is.null(subtitle)) subtitle <- switch( - method, - ahr = "AHR approximations of ~HR at bound", - wlr = "WLR approximation of ~wHR at bound", - combo = "MaxCombo approximation", - rd = "measured by risk difference" - ) # set different default columns to display if (is.null(display_columns)) display_columns <- c( @@ -334,6 +319,8 @@ as_rtf.gs_design <- function( if (!all(display_columns %in% names(x))) stop( "not all variable names in 'display_columns' are in the summary_bound object!" ) + title <- title %||% gs_method_title(method) + subtitle <- subtitle %||% gs_method_subtitle(method) x <- x[, display_columns] # set different default footnotes to different methods From 7899504aacf307f4d24d33289b8dcc91a86328ea Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 13 Aug 2024 00:23:42 -0500 Subject: [PATCH 27/43] factor out the code to get/transform `display_columns` --- R/as_gt.R | 35 ++++++++++++++++++++--------------- R/as_rtf.R | 16 +--------------- 2 files changed, 21 insertions(+), 30 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 089a038c..63a65185 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -261,21 +261,7 @@ as_gt.gs_design <- function( # Set defaults ---- title <- title %||% gs_method_title(method) subtitle <- subtitle %||% gs_method_subtitle(method) - - # set different default columns to display - if (is.null(display_columns)) display_columns <- c( - "Analysis", "Bound", "Z", "Nominal p", - sprintf("%s at bound", switch(method, ahr = "~HR", wlr = "~wHR", rd = "~Risk difference")), - "Alternate hypothesis", "Null hypothesis" - ) - # filter the columns to display as the output - ## if `Probability` is selected to output, then transform it to `c("Alternate hypothesis", "Null hypothesis")` - if (any(i <- display_columns == "Probability")) - display_columns <- c(display_columns[!i], "Alternate hypothesis", "Null hypothesis") - ## check if the `display_columns` are included in `x` output - if (!all(display_columns %in% names(x))) stop( - "not all variable names in 'display_columns' are in the summary_bound object!" - ) + display_columns <- get_display_columns(display_columns, method, x) x <- x[, display_columns] # set different default footnotes to different methods @@ -357,6 +343,25 @@ gs_method_subtitle <- function(method) { ) } +# get different default columns to display +get_display_columns <- function(cols, method, x) { + # set different default columns to display + if (is.null(cols)) cols <- c( + "Analysis", "Bound", "Z", "Nominal p", + sprintf("%s at bound", switch(method, ahr = "~HR", wlr = "~wHR", rd = "~Risk difference")), + "Alternate hypothesis", "Null hypothesis" + ) + # filter the columns to display as the output: if `Probability` is selected to + # output, transform it to `c("Alternate hypothesis", "Null hypothesis")` + if (any(i <- cols == "Probability")) + cols <- c(cols[!i], "Alternate hypothesis", "Null hypothesis") + ## check if the `display_columns` are included in `x` output + if (!all(cols %in% names(x))) stop( + "not all variable names in 'display_columns' are in the summary_bound object!" + ) + cols +} + footnote_content <- function(method, display_columns) { n <- c("Nominal p", "~HR at bound", "~wHR at bound") i <- n %in% display_columns diff --git a/R/as_rtf.R b/R/as_rtf.R index f8474dec..8752f1fa 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -304,23 +304,9 @@ as_rtf.gs_design <- function( names(x) <- names(x_old) # Set defaults ---- - - # set different default columns to display - if (is.null(display_columns)) display_columns <- c( - "Analysis", "Bound", "Z", "Nominal p", - sprintf("%s at bound", switch(method, ahr = "~HR", wlr = "~wHR", rd = "~Risk difference")), - "Alternate hypothesis", "Null hypothesis" - ) - # filter the columns to display as the output - ## if `Probability` is selected to output, then transform it to `c("Alternate hypothesis", "Null hypothesis")` - if (any(i <- display_columns == "Probability")) - display_columns <- c(display_columns[!i], "Alternate hypothesis", "Null hypothesis") - ## check if the `display_columns` are included in `x` output - if (!all(display_columns %in% names(x))) stop( - "not all variable names in 'display_columns' are in the summary_bound object!" - ) title <- title %||% gs_method_title(method) subtitle <- subtitle %||% gs_method_subtitle(method) + display_columns <- get_display_columns(display_columns, method, x) x <- x[, display_columns] # set different default footnotes to different methods From 0da4be1d0a25a5a9dd7faa7c806d5e981a8aad6c Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 13 Aug 2024 00:29:16 -0500 Subject: [PATCH 28/43] shorten function names --- R/as_gt.R | 20 ++++++++++---------- R/as_rtf.R | 10 +++++----- 2 files changed, 15 insertions(+), 15 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 63a65185..2c10809b 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -79,9 +79,9 @@ as_gt <- function(x, ...) { #' summary() %>% #' as_gt() as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) { - method <- fixed_design_method(x) + method <- fixed_method(x) ans <- gt::gt(x) %>% - gt::tab_header(title = title %||% fixed_method_title(method)) %>% + gt::tab_header(title = title %||% fixed_title(method)) %>% gt::tab_footnote( footnote = footnote %||% method_footnote(x, method), locations = gt::cells_title(group = "title") @@ -90,13 +90,13 @@ as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) { } # get the fixed design method -fixed_design_method <- function(x) { +fixed_method <- function(x) { methods <- c("ahr", "fh", "mb", "lf", "rd", "maxcombo", "milestone", "rmst") intersect(methods, class(x))[1] } # get the default title -fixed_method_title <- function(method) { +fixed_title <- function(method) { sprintf("Fixed Design %s Method", switch( method, ahr = "under AHR", fh = "under Fleming-Harrington", mb = "under Magirr-Burman", @@ -250,7 +250,7 @@ as_gt.gs_design <- function( display_inf_bound = FALSE, ...) { - method <- gs_design_method(x) + method <- gs_method(x) full_alpha <- attr(x, "full_alpha") x_alpha <- max(filter(x, Bound == display_bound[1])[[colname_spannersub[2]]]) x_non_binding <- inherits(x, "non_binding") @@ -259,8 +259,8 @@ as_gt.gs_design <- function( x_old <- x # Set defaults ---- - title <- title %||% gs_method_title(method) - subtitle <- subtitle %||% gs_method_subtitle(method) + title <- title %||% gs_title(method) + subtitle <- subtitle %||% gs_subtitle(method) display_columns <- get_display_columns(display_columns, method, x) x <- x[, display_columns] @@ -319,12 +319,12 @@ as_gt.gs_design <- function( return(x) } -gs_design_method <- function(x) { +gs_method <- function(x) { intersect(c("ahr", "wlr", "combo", "rd"), class(x))[1] } # get different default title for different gs_design methods -gs_method_title <- function(method) { +gs_title <- function(method) { paste("Bound summary", switch( method, ahr = "for AHR design", wlr = "for WLR design", @@ -333,7 +333,7 @@ gs_method_title <- function(method) { } # get different default subtitle for different gs_design methods -gs_method_subtitle <- function(method) { +gs_subtitle <- function(method) { switch( method, ahr = "AHR approximations of ~HR at bound", diff --git a/R/as_rtf.R b/R/as_rtf.R index 8752f1fa..e006a1e7 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -101,8 +101,8 @@ as_rtf.fixed_design <- function( file, ...) { orientation <- match.arg(orientation) - method <- fixed_design_method(x) - title <- title %||% paste(fixed_method_title(method), "{^a}") + method <- fixed_method(x) + title <- title %||% paste(fixed_title(method), "{^a}") footnote <- footnote %||% paste("{^a}", method_footnote(x, method)) # set default column width @@ -293,7 +293,7 @@ as_rtf.gs_design <- function( ...) { orientation <- match.arg(orientation) - method <- gs_design_method(x) + method <- gs_method(x) x_alpha <- max(filter(x, Bound == display_bound[1])[["Null hypothesis"]]) x_non_binding <- inherits(x, "non_binding") x_k <- as.numeric(substr(x$Analysis, 11, 11)) @@ -304,8 +304,8 @@ as_rtf.gs_design <- function( names(x) <- names(x_old) # Set defaults ---- - title <- title %||% gs_method_title(method) - subtitle <- subtitle %||% gs_method_subtitle(method) + title <- title %||% gs_title(method) + subtitle <- subtitle %||% gs_subtitle(method) display_columns <- get_display_columns(display_columns, method, x) x <- x[, display_columns] From b5ba260a611e7dbec8a66959f14691130bc5fe72 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 13 Aug 2024 09:00:17 -0500 Subject: [PATCH 29/43] make this function a one-liner based on the fact that an assignment will return the value assigned --- R/as_rtf.R | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index e006a1e7..440d6146 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -361,10 +361,7 @@ as_rtf.gs_design <- function( footnotes <- NULL # footnote markers (a, b, c, ... from letters[idx]) idx <- 0L - marker <- function() { - idx <<- idx + 1L - letters[idx] - } + marker <- function() letters[idx <<- idx + 1L] for (i in seq_along(footnote$content)) { att <- footnote$attr[i] From 584f485e6516e80f0a39468475c4333122c0450c Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 13 Aug 2024 09:11:05 -0500 Subject: [PATCH 30/43] cosmetic changes --- R/as_rtf.R | 44 ++++++++++++-------------------------------- 1 file changed, 12 insertions(+), 32 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index 440d6146..5880ad84 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -131,13 +131,9 @@ as_rtf.fixed_design <- function( ans <- x %>% r2rtf::rtf_page(orientation = orientation) %>% r2rtf::rtf_title(title) %>% - r2rtf::rtf_colheader( - colheader = colheader, - col_rel_width = rel_width, - text_font_size = text_font_size - ) %>% + r2rtf::rtf_colheader(colheader, rel_width, text_font_size = text_font_size) %>% r2rtf::rtf_body( - col_rel_width = rel_width, + rel_width, border_left = border_left, border_top = border_top, text_justification = text_justification, @@ -412,27 +408,17 @@ as_rtf.gs_design <- function( # use r2rtf ans <- x %>% r2rtf::rtf_page(orientation = orientation) %>% - r2rtf::rtf_title( - title = title, - subtitle = subtitle, - text_convert = FALSE - ) %>% + r2rtf::rtf_title(title, subtitle, text_convert = FALSE) %>% r2rtf::rtf_colheader( - colheader = colheader[1], - col_rel_width = rel_width_head[[1]], - text_font_size = text_font_size, - border_left = border_left_head[[1]] + colheader[1], rel_width_head[[1]], border_left_head[[1]], + text_font_size = text_font_size ) %>% r2rtf::rtf_colheader( - colheader = colheader[2], - border_top = border_top_head, - border_left = border_left_head[[2]], - col_rel_width = rel_width_head[[2]], - text_font_size = text_font_size + colheader[2], rel_width_head[[2]], border_left_head[[2]], + border_top = border_top_head, text_font_size = text_font_size ) %>% r2rtf::rtf_body( - page_by = "Analysis", - col_rel_width = rel_width_body, + rel_width_body, page_by = "Analysis", border_left = border_left_body, border_top = border_top_body, border_bottom = border_bottom, @@ -443,18 +429,12 @@ as_rtf.gs_design <- function( text_font_size = text_font_size ) - if (!is.null(footnotes)) { - ans <- ans %>% - r2rtf::rtf_footnote(footnotes, - text_font_size = text_font_size, - text_convert = FALSE - ) - } + if (!is.null(footnotes)) ans <- r2rtf::rtf_footnote( + ans, footnotes, text_font_size = text_font_size, text_convert = FALSE + ) # Prepare output - ans %>% - r2rtf::rtf_encode() %>% - r2rtf::write_rtf(file = file) + r2rtf::write_rtf(r2rtf::rtf_encode(ans), file) invisible(x_old) } From 4e321d273928ef57d806b0e4234093e04ba1c2a2 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 13 Aug 2024 09:21:06 -0500 Subject: [PATCH 31/43] factor out the code to add footnotes and write RTF --- R/as_rtf.R | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index 5880ad84..230e353b 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -143,10 +143,8 @@ as_rtf.fixed_design <- function( text_font_size = text_font_size ) - ans <- r2rtf::rtf_footnote(ans, footnote, text_font_size = text_font_size) - # Prepare output - r2rtf::write_rtf(r2rtf::rtf_encode(ans), file) + rtf_write(ans, file, footnote, text_font_size) invisible(x) } @@ -429,12 +427,15 @@ as_rtf.gs_design <- function( text_font_size = text_font_size ) - if (!is.null(footnotes)) ans <- r2rtf::rtf_footnote( - ans, footnotes, text_font_size = text_font_size, text_convert = FALSE - ) - # Prepare output - r2rtf::write_rtf(r2rtf::rtf_encode(ans), file) + rtf_write(ans, file, footnotes, text_font_size, text_convert = FALSE) invisible(x_old) } + +# write RTF with (optional footnotes) +rtf_write <- function(x, file, footnote = NULL, size, ...) { + if (!is.null(footnote)) + x <- r2rtf::rtf_footnote( x, footnote, text_font_size = size, ...) + r2rtf::write_rtf(r2rtf::rtf_encode(x), file) +} From 998ef29c5da3ceeb3b2f3d128d4aa0158199bd13 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 13 Aug 2024 09:28:12 -0500 Subject: [PATCH 32/43] delete an extra space (nobody has discovered this before? unbelievable) --- R/as_gt.R | 2 +- tests/testthat/_snaps/independent_as_gt.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 2c10809b..73cb27a9 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -381,7 +381,7 @@ footnote_content <- function(method, display_columns) { wlr = res %+% (if (i[3]) list(x, n[3], "colname")) %+% list("wAHR is the weighted AHR.", NULL, "analysis"), combo = res %+% list( - "EF is event fraction. AHR is under regular weighted log rank test.", + "EF is event fraction. AHR is under regular weighted log rank test.", NULL, "analysis" ), rd = res diff --git a/tests/testthat/_snaps/independent_as_gt.md b/tests/testthat/_snaps/independent_as_gt.md index ff3a75c6..1ee9b113 100644 --- a/tests/testthat/_snaps/independent_as_gt.md +++ b/tests/testthat/_snaps/independent_as_gt.md @@ -220,7 +220,7 @@ \end{longtable} \begin{minipage}{\linewidth} \textsuperscript{\textit{1}}One-sided p-value for experimental vs control treatment. Value < 0.5 favors experimental, > 0.5 favors control.\\ - \textsuperscript{\textit{2}}EF is event fraction. AHR is under regular weighted log rank test.\\ + \textsuperscript{\textit{2}}EF is event fraction. AHR is under regular weighted log rank test.\\ \end{minipage} \endgroup From bd00877632c67bc67c616f82c78d1fa9e88e78ba Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 13 Aug 2024 09:52:33 -0500 Subject: [PATCH 33/43] factor out the code to check the `col_rel_width` --- R/as_rtf.R | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index 230e353b..47a15855 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -108,10 +108,7 @@ as_rtf.fixed_design <- function( # set default column width n_row <- nrow(x) n_col <- ncol(x) - if (!is.null(col_rel_width) && n_col != length(col_rel_width)) stop( - "The length of 'col_rel_width' (", length(col_rel_width), ") differs with ", - "the number of columns in 'x' (", n_col, ")." - ) + check_rel_width(col_rel_width, n_col) # set column header colheader <- paste(names(x), collapse = " | ") @@ -149,6 +146,13 @@ as_rtf.fixed_design <- function( invisible(x) } +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 ", + "the number of columns in 'x' (", n_col, ")." + ) +} + #' @rdname as_rtf #' #' @param title A string to specify the title of the RTF table. @@ -317,10 +321,7 @@ as_rtf.gs_design <- function( # Set rtf parameters ---- n_col <- ncol(x) n_row <- nrow(x) - if (!is.null(col_rel_width) && n_col != length(col_rel_width)) stop( - "The length of 'col_rel_width' (", length(col_rel_width), ") differs with ", - "the number of columns in 'x' (", n_col, ")." - ) + check_rel_width(col_rel_width, n_col) # set column header i <- match(c("Alternate hypothesis", "Null hypothesis"), names(x)) From 247b00eb87e247825a440fa81c1e0cbdc6affc57 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 13 Aug 2024 11:50:24 -0500 Subject: [PATCH 34/43] factor out more common code from as_gt.gs_design() and as_rtf.gs_design() --- R/as_gt.R | 82 ++++++++++++++++++++++++++++-------------------------- R/as_rtf.R | 49 +++++++++++--------------------- 2 files changed, 59 insertions(+), 72 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 73cb27a9..1218913f 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -250,42 +250,24 @@ as_gt.gs_design <- function( display_inf_bound = FALSE, ...) { - method <- gs_method(x) - full_alpha <- attr(x, "full_alpha") - x_alpha <- max(filter(x, Bound == display_bound[1])[[colname_spannersub[2]]]) - x_non_binding <- inherits(x, "non_binding") - x_k <- as.numeric(substr(x$Analysis, 11, 11)) - if (!display_inf_bound) x <- filter(x, !is.infinite(Z)) x_old <- x + full_alpha <- attr(x, "full_alpha") + info <- gs_design_info( + x, title, subtitle, colname_spannersub, footnote, + display_bound, display_columns, display_inf_bound + ) - # Set defaults ---- - title <- title %||% gs_title(method) - subtitle <- subtitle %||% gs_subtitle(method) - display_columns <- get_display_columns(display_columns, method, x) - x <- x[, display_columns] - - # set different default footnotes to different methods - footnote <- footnote %||% footnote_content(method, display_columns) - - # Filter out inf bound ---- - x <- subset(x, !is.na(`Alternate hypothesis`) & !is.na(`Null hypothesis`)) - - # Add spanner ---- - i <- match(c("Alternate hypothesis", "Null hypothesis"), names(x)) - names(x)[i] <- colname_spannersub - - x <- x %>% - subset(Bound %in% display_bound) %>% - dplyr::arrange(Analysis) %>% + x <- info$x %>% dplyr::group_by(Analysis) %>% gt::gt() %>% gt::tab_spanner( columns = dplyr::all_of(colname_spannersub), label = colname_spanner ) %>% - gt::tab_header(title = title, subtitle = subtitle) + gt::tab_header(title = info$title, subtitle = info$subtitle) # Add footnotes ---- + footnote <- info$footnote for (i in seq_along(footnote$content)) { att <- footnote$attr[i] loc <- if (att == "colname") { @@ -306,12 +288,12 @@ as_gt.gs_design <- function( } ## if it is non-binding design - if (x_non_binding && x_alpha < full_alpha) x <- gt::tab_footnote( + if (inherits(x_old, "non_binding") && info$alpha < full_alpha) x <- gt::tab_footnote( x, - footnote = footnote_non_binding(x_alpha, full_alpha), + footnote = footnote_non_binding(info$alpha, full_alpha), locations = gt::cells_body( columns = colname_spannersub[2], - rows = substr(x_old$Analysis, 1, 11) == paste0("Analysis: ", max(x_k)) & + rows = substr(x_old$Analysis, 1, 11) == paste0("Analysis: ", max(info$k)) & x_old$Bound == display_bound[1] ) ) @@ -319,10 +301,6 @@ as_gt.gs_design <- function( return(x) } -gs_method <- function(x) { - intersect(c("ahr", "wlr", "combo", "rd"), class(x))[1] -} - # get different default title for different gs_design methods gs_title <- function(method) { paste("Bound summary", switch( @@ -344,22 +322,22 @@ gs_subtitle <- function(method) { } # get different default columns to display -get_display_columns <- function(cols, method, x) { +get_display_columns <- function(columns, method, x) { # set different default columns to display - if (is.null(cols)) cols <- c( + if (is.null(columns)) columns <- c( "Analysis", "Bound", "Z", "Nominal p", sprintf("%s at bound", switch(method, ahr = "~HR", wlr = "~wHR", rd = "~Risk difference")), "Alternate hypothesis", "Null hypothesis" ) # filter the columns to display as the output: if `Probability` is selected to # output, transform it to `c("Alternate hypothesis", "Null hypothesis")` - if (any(i <- cols == "Probability")) - cols <- c(cols[!i], "Alternate hypothesis", "Null hypothesis") + if (any(i <- columns == "Probability")) + columns <- c(columns[!i], "Alternate hypothesis", "Null hypothesis") ## check if the `display_columns` are included in `x` output - if (!all(cols %in% names(x))) stop( + if (!all(columns %in% names(x))) stop( "not all variable names in 'display_columns' are in the summary_bound object!" ) - cols + columns } footnote_content <- function(method, display_columns) { @@ -401,3 +379,29 @@ footnote_non_binding <- function(x_alpha, full_alpha) { "(", a2, " - ", a3, " = ", a1, ") ", "under the null hypothesis." ) } + +gs_design_info <- function( + x, title, subtitle, spannersub, footnote, bound, columns, inf_bound, + alpha_column = spannersub[2], transform = identity +) { + method <- intersect(c("ahr", "wlr", "combo", "rd"), class(x))[1] + if (!inf_bound) x <- filter(x, !is.infinite(Z)) + x2 <- transform(x) + + columns <- get_display_columns(columns, method, x2) + x2 <- x2[, columns] + x2 <- subset(x2, !is.na(`Alternate hypothesis`) & !is.na(`Null hypothesis`)) + x2 <- subset(x2, Bound %in% bound) + + i <- match(c("Alternate hypothesis", "Null hypothesis"), names(x2)) + names(x2)[i] <- spannersub + + list( + x = dplyr::arrange(x2, Analysis), + title = title %||% gs_title(method), + subtitle = subtitle %||% gs_subtitle(method), + footnote = footnote %||% footnote_content(method, columns), + k = as.numeric(substr(x2$Analysis, 11, 11)), + alpha = max(filter(x, Bound == bound[1])[[alpha_column]]) + ) +} diff --git a/R/as_rtf.R b/R/as_rtf.R index 47a15855..529496ae 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -290,43 +290,25 @@ as_rtf.gs_design <- function( file, ...) { orientation <- match.arg(orientation) - - method <- gs_method(x) - x_alpha <- max(filter(x, Bound == display_bound[1])[["Null hypothesis"]]) - x_non_binding <- inherits(x, "non_binding") - x_k <- as.numeric(substr(x$Analysis, 11, 11)) - if (!display_inf_bound) x <- filter(x, !is.infinite(Z)) x_old <- x - x <- data.frame(lapply(x, function(x) trimws(formatC(x, flag = "-"), "r"))) - names(x) <- names(x_old) - - # Set defaults ---- - title <- title %||% gs_title(method) - subtitle <- subtitle %||% gs_subtitle(method) - display_columns <- get_display_columns(display_columns, method, x) - x <- x[, display_columns] - - # set different default footnotes to different methods - footnote <- footnote %||% footnote_content(method, display_columns) - - # Filter out inf bound ---- - x <- subset(x, !is.na(`Alternate hypothesis`) & !is.na(`Null hypothesis`)) - - # organize data - x <- x %>% - subset(Bound %in% display_bound) %>% - dplyr::arrange(Analysis) + info <- gs_design_info( + x, title, subtitle, colname_spannersub, footnote, + display_bound, display_columns, display_inf_bound, "Null hypothesis", + function(x) { + x2 <- data.frame(lapply(x, function(x) trimws(formatC(x, flag = "-"), "r"))) + names(x2) <- names(x) + x2 + } + ) + x <- info$x + title <- info$title + subtitle <- info$subtitle # Set rtf parameters ---- n_col <- ncol(x) n_row <- nrow(x) check_rel_width(col_rel_width, n_col) - - # set column header - i <- match(c("Alternate hypothesis", "Null hypothesis"), names(x)) - names(x)[i] <- colname_spannersub - colheader <- c( paste0(" | ", colname_spanner), paste(names(x)[-1], collapse = " | ") @@ -354,6 +336,7 @@ as_rtf.gs_design <- function( # Add footnotes ---- # initialization for footnote footnotes <- NULL + footnote <- info$footnote # footnote markers (a, b, c, ... from letters[idx]) idx <- 0L marker <- function() letters[idx <<- idx + 1L] @@ -387,16 +370,16 @@ as_rtf.gs_design <- function( } ## if it is non-binding design - if (x_non_binding && (x_alpha < full_alpha)) { + if (inherits(x_old, "non_binding") && info$alpha < full_alpha) { mkr <- marker() - i <- substring(x$Analysis, 1, 11) == paste0("Analysis: ", max(x_k)) & + i <- substring(x$Analysis, 1, 11) == paste0("Analysis: ", max(info$k)) & x$Bound == display_bound[1] j <- colname_spannersub[2] x[i, j] <- paste0(x[i, j], " {^", mkr, "}") footnote_nb <- paste0( "{\\super ", mkr, "} ", - footnote_non_binding(x_alpha, full_alpha) + footnote_non_binding(info$alpha, full_alpha) ) footnotes <- if (is.null(footnotes)) footnote_nb else { paste0(footnotes, "\\line", footnote_nb) From 476a635ca7ba9468adf04b2a83f90847575cef7d Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 13 Aug 2024 12:49:46 -0500 Subject: [PATCH 35/43] collect footnotes using c() and concatenate all with paste(..., collapse) in the end --- R/as_rtf.R | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index 529496ae..505d2305 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -364,9 +364,7 @@ as_rtf.gs_design <- function( ) } marked_footnote <- paste0("{\\super ", mkr, "} ", footnote$content[i]) - footnotes <- if (is.null(footnotes)) marked_footnote else { - paste0(footnotes, "\\line", marked_footnote) - } + footnotes <- c(footnotes, marked_footnote) } ## if it is non-binding design @@ -381,9 +379,7 @@ as_rtf.gs_design <- function( "{\\super ", mkr, "} ", footnote_non_binding(info$alpha, full_alpha) ) - footnotes <- if (is.null(footnotes)) footnote_nb else { - paste0(footnotes, "\\line", footnote_nb) - } + footnotes <- c(footnotes, footnote_nb) } # Output ---- @@ -419,7 +415,9 @@ as_rtf.gs_design <- function( # write RTF with (optional footnotes) rtf_write <- function(x, file, footnote = NULL, size, ...) { - if (!is.null(footnote)) - x <- r2rtf::rtf_footnote( x, footnote, text_font_size = size, ...) + if (!is.null(footnote)) { + footnote <- paste(footnote, collapse = "\\line") + x <- r2rtf::rtf_footnote(x, footnote, text_font_size = size, ...) + } r2rtf::write_rtf(r2rtf::rtf_encode(x), file) } From ac4a83d4fea648b38bd459f1cf117df35a166350 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 13 Aug 2024 13:06:39 -0500 Subject: [PATCH 36/43] move the logic `inherits('non_binding') & x_alpha < full_alpha` into `footnote_non_binding()` --- R/as_gt.R | 10 ++++++---- R/as_rtf.R | 12 ++++-------- 2 files changed, 10 insertions(+), 12 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 1218913f..15ff1f7d 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -287,10 +287,11 @@ as_gt.gs_design <- function( x <- gt::tab_footnote(x, footnote = footnote$content[i], locations = loc) } - ## if it is non-binding design - if (inherits(x_old, "non_binding") && info$alpha < full_alpha) x <- gt::tab_footnote( + # add footnote for non-binding design + footnote_nb <- footnote_non_binding(x_old, info$alpha, full_alpha) + if (!is.null(footnote_nb)) x <- gt::tab_footnote( x, - footnote = footnote_non_binding(info$alpha, full_alpha), + footnote = footnote_nb, locations = gt::cells_body( columns = colname_spannersub[2], rows = substr(x_old$Analysis, 1, 11) == paste0("Analysis: ", max(info$k)) & @@ -366,7 +367,8 @@ footnote_content <- function(method, display_columns) { ) } -footnote_non_binding <- function(x_alpha, full_alpha) { +footnote_non_binding <- function(x, x_alpha, full_alpha) { + if (!inherits(x, "non_binding") || x_alpha >= full_alpha) return() a1 <- format(x_alpha, scientific = FALSE) a2 <- format(full_alpha, scientific = FALSE) a3 <- format(full_alpha - x_alpha, scientific = FALSE) diff --git a/R/as_rtf.R b/R/as_rtf.R index 505d2305..9a5a07b7 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -367,19 +367,15 @@ as_rtf.gs_design <- function( footnotes <- c(footnotes, marked_footnote) } - ## if it is non-binding design - if (inherits(x_old, "non_binding") && info$alpha < full_alpha) { + # add footnote for non-binding design + footnote_nb <- footnote_non_binding(x_old, info$alpha, full_alpha) + if (!is.null(footnote_nb)) { mkr <- marker() i <- substring(x$Analysis, 1, 11) == paste0("Analysis: ", max(info$k)) & x$Bound == display_bound[1] j <- colname_spannersub[2] x[i, j] <- paste0(x[i, j], " {^", mkr, "}") - - footnote_nb <- paste0( - "{\\super ", mkr, "} ", - footnote_non_binding(info$alpha, full_alpha) - ) - footnotes <- c(footnotes, footnote_nb) + footnotes <- c(footnotes, paste0("{\\super ", mkr, "} ", footnote_nb)) } # Output ---- From 49b23a9de71b9b5395d6f645ec22ddbc412fca9b Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 13 Aug 2024 13:37:31 -0500 Subject: [PATCH 37/43] factor out `substr(Analysis, 1, 11) == 'Analysis: N'`, which is potentially buggy (when `N >= 10`) --- R/as_gt.R | 15 ++++++++++++--- R/as_rtf.R | 3 +-- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 15ff1f7d..3b03e339 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -294,8 +294,7 @@ as_gt.gs_design <- function( footnote = footnote_nb, locations = gt::cells_body( columns = colname_spannersub[2], - rows = substr(x_old$Analysis, 1, 11) == paste0("Analysis: ", max(info$k)) & - x_old$Bound == display_bound[1] + rows = footnote_row(x_old, display_bound[1]) ) ) @@ -382,6 +381,17 @@ footnote_non_binding <- function(x, x_alpha, full_alpha) { ) } +footnote_row <- function(x, bound) { + # for a vector of "Analysis: N", get a logical vector `i`, in which `TRUE` + # indicates the position of the largest `N` + a <- x$Analysis + r <- "^Analysis: ([0-9]+).*" + i <- grepl(r, a) + k <- as.numeric(sub(r, '\\1', a[i])) + i[i] <- k == max(k) + i & x$Bound == bound +} + gs_design_info <- function( x, title, subtitle, spannersub, footnote, bound, columns, inf_bound, alpha_column = spannersub[2], transform = identity @@ -403,7 +413,6 @@ gs_design_info <- function( title = title %||% gs_title(method), subtitle = subtitle %||% gs_subtitle(method), footnote = footnote %||% footnote_content(method, columns), - k = as.numeric(substr(x2$Analysis, 11, 11)), alpha = max(filter(x, Bound == bound[1])[[alpha_column]]) ) } diff --git a/R/as_rtf.R b/R/as_rtf.R index 9a5a07b7..5aeb993e 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -371,8 +371,7 @@ as_rtf.gs_design <- function( footnote_nb <- footnote_non_binding(x_old, info$alpha, full_alpha) if (!is.null(footnote_nb)) { mkr <- marker() - i <- substring(x$Analysis, 1, 11) == paste0("Analysis: ", max(info$k)) & - x$Bound == display_bound[1] + i <- footnote_row(x, display_bound[1]) j <- colname_spannersub[2] x[i, j] <- paste0(x[i, j], " {^", mkr, "}") footnotes <- c(footnotes, paste0("{\\super ", mkr, "} ", footnote_nb)) From 9522d70c0064c7b060f7c03c3f49ce293d706f72 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 13 Aug 2024 13:46:50 -0500 Subject: [PATCH 38/43] the functions `gs_[sub]title` are simple enough and not used elsewhere, so move them into `gs_design_info()` --- R/as_gt.R | 36 ++++++++++++++---------------------- 1 file changed, 14 insertions(+), 22 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 3b03e339..7a70c14f 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -301,26 +301,6 @@ as_gt.gs_design <- function( return(x) } -# get different default title for different gs_design methods -gs_title <- function(method) { - paste("Bound summary", switch( - method, - ahr = "for AHR design", wlr = "for WLR design", - combo = "for MaxCombo design", rd = "of Binary Endpoint" - )) -} - -# get different default subtitle for different gs_design methods -gs_subtitle <- function(method) { - switch( - method, - ahr = "AHR approximations of ~HR at bound", - wlr = "WLR approximation of ~wHR at bound", - combo = "MaxCombo approximation", - rd = "measured by risk difference" - ) -} - # get different default columns to display get_display_columns <- function(columns, method, x) { # set different default columns to display @@ -408,10 +388,22 @@ gs_design_info <- function( i <- match(c("Alternate hypothesis", "Null hypothesis"), names(x2)) names(x2)[i] <- spannersub + title <- title %||% paste("Bound summary", switch( + method, + ahr = "for AHR design", wlr = "for WLR design", + combo = "for MaxCombo design", rd = "of Binary Endpoint" + )) + subtitle <- subtitle %||% switch( + method, + ahr = "AHR approximations of ~HR at bound", + wlr = "WLR approximation of ~wHR at bound", + combo = "MaxCombo approximation", + rd = "measured by risk difference" + ) + list( x = dplyr::arrange(x2, Analysis), - title = title %||% gs_title(method), - subtitle = subtitle %||% gs_subtitle(method), + title = title, subtitle = subtitle, footnote = footnote %||% footnote_content(method, columns), alpha = max(filter(x, Bound == bound[1])[[alpha_column]]) ) From a598ec6ee5b4c705fda9bb9f62786003f0f499b0 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 13 Aug 2024 14:22:45 -0500 Subject: [PATCH 39/43] use the processed `x` from `info` so that the length of `footnote_row()` can match the number of rows in the data --- R/as_gt.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/as_gt.R b/R/as_gt.R index 7a70c14f..8afa6c43 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -294,7 +294,7 @@ as_gt.gs_design <- function( footnote = footnote_nb, locations = gt::cells_body( columns = colname_spannersub[2], - rows = footnote_row(x_old, display_bound[1]) + rows = footnote_row(info$x, display_bound[1]) ) ) From 3654e0f822338d55da5200addd32ec942236ed4c Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 13 Aug 2024 14:28:05 -0500 Subject: [PATCH 40/43] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index bbdbb8f5..e9504a70 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: gsDesign2 Title: Group Sequential Design with Non-Constant Effect -Version: 1.1.2.20 +Version: 1.1.2.21 Authors@R: c( person("Keaven", "Anderson", email = "keaven_anderson@merck.com", role = c("aut")), person("Yilong", "Zhang", email = "elong0527@gmail.com", role = c("aut")), From 539719893032f1351be568d5ef38633efa333e38 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Wed, 14 Aug 2024 14:10:57 -0500 Subject: [PATCH 41/43] more comments --- R/as_gt.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/as_gt.R b/R/as_gt.R index 8afa6c43..9df6e036 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -320,6 +320,7 @@ get_display_columns <- function(columns, method, x) { columns } +# default footnotes for 'gs_design' tables footnote_content <- function(method, display_columns) { n <- c("Nominal p", "~HR at bound", "~wHR at bound") i <- n %in% display_columns @@ -346,6 +347,7 @@ footnote_content <- function(method, display_columns) { ) } +# footnote for non-binding designs footnote_non_binding <- function(x, x_alpha, full_alpha) { if (!inherits(x, "non_binding") || x_alpha >= full_alpha) return() a1 <- format(x_alpha, scientific = FALSE) @@ -361,6 +363,7 @@ footnote_non_binding <- function(x, x_alpha, full_alpha) { ) } +# where to add the non-binding design footnote footnote_row <- function(x, bound) { # for a vector of "Analysis: N", get a logical vector `i`, in which `TRUE` # indicates the position of the largest `N` @@ -372,12 +375,14 @@ footnote_row <- function(x, bound) { i & x$Bound == bound } +# a list of information for `as_[gt|rtf].gs_design()` methods gs_design_info <- function( x, title, subtitle, spannersub, footnote, bound, columns, inf_bound, alpha_column = spannersub[2], transform = identity ) { method <- intersect(c("ahr", "wlr", "combo", "rd"), class(x))[1] if (!inf_bound) x <- filter(x, !is.infinite(Z)) + # `x` needs a custom transformation in as_rtf() x2 <- transform(x) columns <- get_display_columns(columns, method, x2) From 954a2267e189417d62673dd037abc8f704ab82d3 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Wed, 14 Aug 2024 16:42:00 -0500 Subject: [PATCH 42/43] misplaced ) [ci skip] --- R/as_rtf.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/as_rtf.R b/R/as_rtf.R index 5aeb993e..d860463e 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -408,7 +408,7 @@ as_rtf.gs_design <- function( invisible(x_old) } -# write RTF with (optional footnotes) +# write RTF with (optional) footnotes rtf_write <- function(x, file, footnote = NULL, size, ...) { if (!is.null(footnote)) { footnote <- paste(footnote, collapse = "\\line") From 12cec74eeb9eb20198eb2112ff2aee0308143872 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 16 Aug 2024 10:13:55 -0500 Subject: [PATCH 43/43] renaming using the prefixes `fd_` and `gsd_` --- R/as_gt.R | 43 ++++++++++++++++++++++--------------------- R/as_rtf.R | 20 ++++++++++---------- 2 files changed, 32 insertions(+), 31 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 9df6e036..c31e3880 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -79,24 +79,24 @@ as_gt <- function(x, ...) { #' summary() %>% #' as_gt() as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) { - method <- fixed_method(x) + method <- fd_method(x) ans <- gt::gt(x) %>% - gt::tab_header(title = title %||% fixed_title(method)) %>% + gt::tab_header(title = title %||% fd_title(method)) %>% gt::tab_footnote( - footnote = footnote %||% method_footnote(x, method), + footnote = footnote %||% fd_footnote(x, method), locations = gt::cells_title(group = "title") ) return(ans) } # get the fixed design method -fixed_method <- function(x) { +fd_method <- function(x) { methods <- c("ahr", "fh", "mb", "lf", "rd", "maxcombo", "milestone", "rmst") intersect(methods, class(x))[1] } # get the default title -fixed_title <- function(method) { +fd_title <- function(method) { sprintf("Fixed Design %s Method", switch( method, ahr = "under AHR", fh = "under Fleming-Harrington", mb = "under Magirr-Burman", @@ -107,7 +107,7 @@ fixed_title <- function(method) { } # get the default footnote -method_footnote <- function(x, method) { +fd_footnote <- function(x, method) { switch( method, ahr = "Power computed with average hazard ratio method.", @@ -252,22 +252,22 @@ as_gt.gs_design <- function( x_old <- x full_alpha <- attr(x, "full_alpha") - info <- gs_design_info( + parts <- gsd_parts( x, title, subtitle, colname_spannersub, footnote, display_bound, display_columns, display_inf_bound ) - x <- info$x %>% + x <- parts$x %>% dplyr::group_by(Analysis) %>% gt::gt() %>% gt::tab_spanner( columns = dplyr::all_of(colname_spannersub), label = colname_spanner ) %>% - gt::tab_header(title = info$title, subtitle = info$subtitle) + gt::tab_header(title = parts$title, subtitle = parts$subtitle) # Add footnotes ---- - footnote <- info$footnote + footnote <- parts$footnote for (i in seq_along(footnote$content)) { att <- footnote$attr[i] loc <- if (att == "colname") { @@ -288,13 +288,13 @@ as_gt.gs_design <- function( } # add footnote for non-binding design - footnote_nb <- footnote_non_binding(x_old, info$alpha, full_alpha) + footnote_nb <- gsd_footnote_nb(x_old, parts$alpha, full_alpha) if (!is.null(footnote_nb)) x <- gt::tab_footnote( x, footnote = footnote_nb, locations = gt::cells_body( columns = colname_spannersub[2], - rows = footnote_row(info$x, display_bound[1]) + rows = gsd_footnote_row(parts$x, display_bound[1]) ) ) @@ -302,7 +302,7 @@ as_gt.gs_design <- function( } # get different default columns to display -get_display_columns <- function(columns, method, x) { +gsd_columns <- function(columns, method, x) { # set different default columns to display if (is.null(columns)) columns <- c( "Analysis", "Bound", "Z", "Nominal p", @@ -321,9 +321,9 @@ get_display_columns <- function(columns, method, x) { } # default footnotes for 'gs_design' tables -footnote_content <- function(method, display_columns) { +gsd_footnote <- function(method, columns) { n <- c("Nominal p", "~HR at bound", "~wHR at bound") - i <- n %in% display_columns + i <- n %in% columns res <- if (i[1]) list( content = paste( "One-sided p-value for experimental vs control treatment.", @@ -348,7 +348,7 @@ footnote_content <- function(method, display_columns) { } # footnote for non-binding designs -footnote_non_binding <- function(x, x_alpha, full_alpha) { +gsd_footnote_nb <- function(x, x_alpha, full_alpha) { if (!inherits(x, "non_binding") || x_alpha >= full_alpha) return() a1 <- format(x_alpha, scientific = FALSE) a2 <- format(full_alpha, scientific = FALSE) @@ -364,7 +364,7 @@ footnote_non_binding <- function(x, x_alpha, full_alpha) { } # where to add the non-binding design footnote -footnote_row <- function(x, bound) { +gsd_footnote_row <- function(x, bound) { # for a vector of "Analysis: N", get a logical vector `i`, in which `TRUE` # indicates the position of the largest `N` a <- x$Analysis @@ -375,8 +375,9 @@ footnote_row <- function(x, bound) { i & x$Bound == bound } -# a list of information for `as_[gt|rtf].gs_design()` methods -gs_design_info <- function( +# a list of information for `as_[gt|rtf].gs_design()` methods: the transformed +# data, title, and footnote, etc. +gsd_parts <- function( x, title, subtitle, spannersub, footnote, bound, columns, inf_bound, alpha_column = spannersub[2], transform = identity ) { @@ -385,7 +386,7 @@ gs_design_info <- function( # `x` needs a custom transformation in as_rtf() x2 <- transform(x) - columns <- get_display_columns(columns, method, x2) + columns <- gsd_columns(columns, method, x2) x2 <- x2[, columns] x2 <- subset(x2, !is.na(`Alternate hypothesis`) & !is.na(`Null hypothesis`)) x2 <- subset(x2, Bound %in% bound) @@ -409,7 +410,7 @@ gs_design_info <- function( list( x = dplyr::arrange(x2, Analysis), title = title, subtitle = subtitle, - footnote = footnote %||% footnote_content(method, columns), + footnote = footnote %||% gsd_footnote(method, columns), alpha = max(filter(x, Bound == bound[1])[[alpha_column]]) ) } diff --git a/R/as_rtf.R b/R/as_rtf.R index d860463e..e317aff4 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -101,9 +101,9 @@ as_rtf.fixed_design <- function( file, ...) { orientation <- match.arg(orientation) - method <- fixed_method(x) - title <- title %||% paste(fixed_title(method), "{^a}") - footnote <- footnote %||% paste("{^a}", method_footnote(x, method)) + method <- fd_method(x) + title <- title %||% paste(fd_title(method), "{^a}") + footnote <- footnote %||% paste("{^a}", fd_footnote(x, method)) # set default column width n_row <- nrow(x) @@ -292,7 +292,7 @@ as_rtf.gs_design <- function( orientation <- match.arg(orientation) x_old <- x - info <- gs_design_info( + parts <- gsd_parts( x, title, subtitle, colname_spannersub, footnote, display_bound, display_columns, display_inf_bound, "Null hypothesis", function(x) { @@ -301,9 +301,9 @@ as_rtf.gs_design <- function( x2 } ) - x <- info$x - title <- info$title - subtitle <- info$subtitle + x <- parts$x + title <- parts$title + subtitle <- parts$subtitle # Set rtf parameters ---- n_col <- ncol(x) @@ -336,7 +336,7 @@ as_rtf.gs_design <- function( # Add footnotes ---- # initialization for footnote footnotes <- NULL - footnote <- info$footnote + footnote <- parts$footnote # footnote markers (a, b, c, ... from letters[idx]) idx <- 0L marker <- function() letters[idx <<- idx + 1L] @@ -368,10 +368,10 @@ as_rtf.gs_design <- function( } # add footnote for non-binding design - footnote_nb <- footnote_non_binding(x_old, info$alpha, full_alpha) + footnote_nb <- gsd_footnote_nb(x_old, parts$alpha, full_alpha) if (!is.null(footnote_nb)) { mkr <- marker() - i <- footnote_row(x, display_bound[1]) + i <- gsd_footnote_row(x, display_bound[1]) j <- colname_spannersub[2] x[i, j] <- paste0(x[i, j], " {^", mkr, "}") footnotes <- c(footnotes, paste0("{\\super ", mkr, "} ", footnote_nb))