From c65e170485c9ed3efc4a9646b251f0f5b1798e04 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 10:39:33 -0500 Subject: [PATCH 01/24] use is.numeric() instead of is.vector(, 'numeric') --- R/ahr_blinded.R | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/R/ahr_blinded.R b/R/ahr_blinded.R index 644167e4..36135d30 100644 --- a/R/ahr_blinded.R +++ b/R/ahr_blinded.R @@ -84,14 +84,14 @@ ahr_blinded <- function( hr = c(1, .6), ratio = 1) { # Input checking - if (!is.vector(hr, mode = "numeric") || min(hr) <= 0) { - stop("ahr_blinded: hr must be a vector of positive numbers.") + if (!is.numeric(hr) || min(hr) <= 0) { + stop("'hr' must be a vector of positive numbers.") } - if (!is.vector(intervals, mode = "numeric") || min(intervals) <= 0) { - stop("ahr_blinded: intervals must be a vector of positive numbers.") + if (!is.numeric(intervals) || min(intervals) <= 0) { + stop("'intervals' must be a vector of positive numbers.") } if (length(intervals) != length(hr)) { - stop("ahr_blinded: the piecewise model specified hr and intervals are not aligned.") + stop("the piecewise model specified 'hr' and 'intervals' differ in lengths.") } # Set final element of "intervals" to Inf @@ -111,11 +111,10 @@ ahr_blinded <- function( # Compute adjustment for information q_e <- ratio / (1 + ratio) - ans <- tibble( + tibble( event = sum(event), ahr = exp(-theta), theta = theta, info0 = sum(event) * (1 - q_e) * q_e ) - return(ans) } From aaccf68f27fe413ec6585e152d86e4d93ab9fc0e Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 10:41:57 -0500 Subject: [PATCH 02/24] use intersect() to find the class name to make the code terse --- R/as_gt.R | 23 +++-------------------- 1 file changed, 3 insertions(+), 20 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 59e0fe20..50b6303b 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -80,26 +80,9 @@ as_gt <- function(x, ...) { #' as_gt() as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) { # 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" - } - + design_mtd <- intersect( + c("ahr", "fh", "mb", "lf", "rd", "maxcombo", "milestone", "rmst"), class(x) + )[1] # set the default title if (is.null(title)) { From 88d6650e996be050814e752f3f5c52dd984490a9 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 10:43:38 -0500 Subject: [PATCH 03/24] remove curly braces (note that 'rd' appeared twice in switch() in the original code, which is harmless but also unnecessary) --- R/as_gt.R | 43 +++++++++++-------------------------------- 1 file changed, 11 insertions(+), 32 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 50b6303b..364aede5 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -85,38 +85,17 @@ as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) { )[1] # set the default title - if (is.null(title)) { - title <- switch(design_mtd, - "ahr" = { - "Fixed Design under AHR Method" - }, - "fh" = { - "Fixed Design under Fleming-Harrington Method" - }, - "mb" = { - "Fixed Design under Magirr-Burman Method" - }, - "lf" = { - "Fixed Design under Lachin and Foulkes Method" - }, - "rd" = { - "Fixed Design of Risk Difference under Farrington-Manning Method" - }, - "maxcombo" = { - "Fixed Design under MaxCombo Method" - }, - "milestone" = { - "Fixed Design under Milestone Method" - }, - "rmst" = { - "Fixed Design under Restricted Mean Survival Time Method" - }, - "rd" = { - "Fixed Design of Risk Difference" - } - ) - } - + if (is.null(title)) title <- switch( + design_mtd, + "ahr" = "Fixed Design under AHR Method", + "fh" = "Fixed Design under Fleming-Harrington Method", + "mb" = "Fixed Design under Magirr-Burman Method", + "lf" = "Fixed Design under Lachin and Foulkes Method", + "rd" = "Fixed Design of Risk Difference under Farrington-Manning Method", + "maxcombo" = "Fixed Design under MaxCombo Method", + "milestone" = "Fixed Design under Milestone Method", + "rmst" = "Fixed Design under Restricted Mean Survival Time Method" + ) # set the default footnote if (is.null(footnote)) { From 768edcc04a19a726b1a4f285f9e428935cde5507 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 10:45:45 -0500 Subject: [PATCH 04/24] merge the cases for 'mb', 'milestone', and 'rmst' in switch() by putting their values in the last unnamed argument, which will be treated as the default --- R/as_gt.R | 67 +++++++++++++++++++------------------------------------ 1 file changed, 23 insertions(+), 44 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 364aede5..193040b3 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -98,53 +98,32 @@ as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) { ) # set the default footnote - if (is.null(footnote)) { - footnote <- switch(design_mtd, - "ahr" = { - "Power computed with average hazard ratio method." - }, - "fh" = { - paste0( - "Power for Fleming-Harrington test ", - substr(x$Design, 19, nchar(x$Design)), - " using method of Yung and Liu." - ) - }, - "mb" = { - paste0( - "Power for ", - x$Design, - " computed with method of Yung and Liu." - ) - }, - "lf" = { - "Power using Lachin and Foulkes method applied - using expected average hazard ratio (AHR) at time of planned analysis." - }, - "rd" = { - "Risk difference power without continuity correction using method of Farrington and Manning." - }, - "maxcombo" = { - paste0( - "Power for MaxCombo test with Fleming-Harrington tests", - substr(x$Design, 9, nchar(x$Design)), "." - ) - }, - "milestone" = { - paste0("Power for ", x$Design, " computed with method of Yung and Liu.") - }, - "rmst" = { - paste0("Power for ", x$Design, " computed with method of Yung and Liu.") - } - ) - } + if (is.null(footnote)) footnote <- switch( + design_mtd, + "ahr" = "Power computed with average hazard ratio method.", + "fh" = paste( + "Power for Fleming-Harrington test", substring(x$Design, 19), + "using method of Yung and Liu." + ), + "lf" = paste( + "Power using Lachin and Foulkes method applied using expected", + "average hazard ratio (AHR) at time of planned analysis." + ), + "rd" = paste( + "Risk difference power without continuity correction using method of", + "Farrington and Manning." + ), + "maxcombo" = paste0( + "Power for MaxCombo test with Fleming-Harrington tests ", + substring(x$Design, 9), "." + ), + # for mb, milestone, and rmst + paste("Power for", x$Design, "computed with method of Yung and Liu.") + ) - ans <- x %>% - gt::gt() %>% + gt::gt(x) %>% gt::tab_header(title = title) %>% gt::tab_footnote(footnote = footnote, locations = gt::cells_title(group = "title")) - - return(ans) } #' @rdname as_gt From 7e2e2e2b3741f122fa927ce0235671a8513956ed Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 10:47:48 -0500 Subject: [PATCH 05/24] use attr() to retrieve a specific attribute instead of retrieving all attributes() and then getting one from the list --- 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 193040b3..3c81a261 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -245,7 +245,7 @@ as_gt.gs_design <- function( ...) { method <- class(x)[class(x) %in% c("ahr", "wlr", "combo", "rd")] - full_alpha <- attributes(x)$full_alpha + full_alpha <- attr(x, "full_alpha") x_alpha <- max((x %>% dplyr::filter(Bound == display_bound[1]))[[colname_spannersub[2]]]) From caa87e1518e2d659166d91547991844a2232b26e Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 10:48:33 -0500 Subject: [PATCH 06/24] find the method by intersect(), similar to 691b5d4aa2908fe021018abd7828cda09d5988fd --- 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 3c81a261..55df907c 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -244,7 +244,7 @@ as_gt.gs_design <- function( display_inf_bound = FALSE, ...) { - method <- class(x)[class(x) %in% c("ahr", "wlr", "combo", "rd")] + method <- intersect(class(x), c("ahr", "wlr", "combo", "rd"))[1] full_alpha <- attr(x, "full_alpha") x_alpha <- max((x %>% dplyr::filter(Bound == display_bound[1]))[[colname_spannersub[2]]]) From e08779cda6094bc2aa118c8d157dd27f1a859eec Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 10:48:58 -0500 Subject: [PATCH 07/24] use inherits() instead of testing class() directly --- 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 55df907c..ca2f02df 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -249,7 +249,7 @@ as_gt.gs_design <- function( x_alpha <- max((x %>% dplyr::filter(Bound == display_bound[1]))[[colname_spannersub[2]]]) - x_non_binding <- "non_binding" %in% class(x) + x_non_binding <- inherits(x, "non_binding") x_k <- lapply(x$Analysis, function(x) { return(as.numeric(substring(x, 11, 11))) From cb4f64bc666533e479cf4d2e65c6d157ec780b60 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 11:03:07 -0500 Subject: [PATCH 08/24] substr() and substring() are vectorized, so no need to lapply() --- R/as_gt.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index ca2f02df..0cdf969f 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -251,9 +251,7 @@ as_gt.gs_design <- function( x_non_binding <- inherits(x, "non_binding") - x_k <- lapply(x$Analysis, function(x) { - return(as.numeric(substring(x, 11, 11))) - }) %>% unlist() + x_k <- as.numeric(substr(x$Analysis, 11, 11)) if (!display_inf_bound) { x <- x %>% filter(!is.infinite(Z)) From d39e657eb6321742e7d5a565a926335e0a8012d2 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 11:07:09 -0500 Subject: [PATCH 09/24] just merge the expressions since there are only two, and probably not worth using the pipe --- R/as_gt.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 0cdf969f..3abc07cd 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -247,15 +247,13 @@ as_gt.gs_design <- function( method <- intersect(class(x), c("ahr", "wlr", "combo", "rd"))[1] full_alpha <- attr(x, "full_alpha") - x_alpha <- max((x %>% dplyr::filter(Bound == display_bound[1]))[[colname_spannersub[2]]]) + 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 <- x %>% filter(!is.infinite(Z)) - } + if (!display_inf_bound) x <- filter(x, !is.infinite(Z)) x_old <- x From fd923a7226e4016c0fd26108a85bfa86b34f32c0 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 11:08:49 -0500 Subject: [PATCH 10/24] factor out `if (is.null(title | subtitle))`, and change `if (method)` to `switch(method)`; also factor out the phrase 'Bound summary' --- R/as_gt.R | 37 ++++++++++++------------------------- 1 file changed, 12 insertions(+), 25 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 3abc07cd..0d9eae2e 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -259,33 +259,20 @@ as_gt.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)) { From 9bf78b7678de96f1bf2e59a173ebb6fe798cd456 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 11:12:21 -0500 Subject: [PATCH 11/24] factor out the common elements in `display_columns` and add the only different element via `switch()` for the four methods --- R/as_gt.R | 28 +++++----------------------- 1 file changed, 5 insertions(+), 23 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 0d9eae2e..1561f88b 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -275,29 +275,11 @@ as_gt.gs_design <- function( ) # 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) { From ae7a8ce171ad8a17f9bfe57aea2fef599a896c38 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 11:13:56 -0500 Subject: [PATCH 12/24] the name 'display_columns' can appear 3 times instead of 6 --- R/as_gt.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 1561f88b..ed0d655f 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -282,10 +282,8 @@ as_gt.gs_design <- function( ) # 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_gt: the variable names in display_columns is not outputted in the summary_bound object!") From 747cdf3bda94ad6dfeb26fa8deb29cd73e02fe67 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 11:16:53 -0500 Subject: [PATCH 13/24] `sum(!cond) >= 1` is equivalent to `!all(cond)` and the latter is much more readable; also replace `select(all_of(vars))` with `[, vars]` --- R/as_gt.R | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index ed0d655f..5bc690f9 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -285,11 +285,10 @@ as_gt.gs_design <- function( 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_gt: 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)) { From e6f357c673286f4c36b0eac410812b123c057db0 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 11:23:47 -0500 Subject: [PATCH 14/24] store the conditions in `i1` and `i2` so that we don't have to repeat them in `content`, `location`, and `attr` for all four methods; also use `if` instead of `ifelse()`, so that we don't need to filter out NA values in the end note that this introduces whitespace changes in snapshot tests, which are harmless (these spaces are meaningless in LaTeX and HTML) --- R/as_gt.R | 98 +++++++--------------- tests/testthat/_snaps/independent_as_gt.md | 6 +- 2 files changed, 34 insertions(+), 70 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 5bc690f9..4d379360 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -291,84 +291,48 @@ as_gt.gs_design <- function( 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("~HR at bound" %in% display_columns, - "Approximate hazard ratio to cross bound.", NA - ), - ifelse("Nominal p" %in% display_columns, + 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.", NA - ) + Value < 0.5 favors experimental, > 0.5 favors control." ), - location = c( - ifelse("~HR at bound" %in% display_columns, "~HR at bound", NA), - ifelse("Nominal p" %in% display_columns, "Nominal p", NA) - ), - attr = c( - ifelse("~HR at bound" %in% display_columns, "colname", NA), - ifelse("Nominal p" %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("~wHR at bound" %in% display_columns, - "Approximate hazard ratio to cross bound.", NA - ), - ifelse("Nominal p" %in% display_columns, + 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.", NA - ), + Value < 0.5 favors experimental, > 0.5 favors control.", "wAHR is the weighted AHR." ), - location = c( - ifelse("~wHR at bound" %in% display_columns, "~wHR at bound", NA), - ifelse("Nominal p" %in% display_columns, "Nominal p", NA), - NA - ), - attr = c( - ifelse("~wHR at bound" %in% display_columns, "colname", NA), - ifelse("Nominal p" %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, + 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.", 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, + 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.", NA - )), - location = c(ifelse("Nominal p" %in% display_columns, "Nominal p", NA)), - attr = c(ifelse("Nominal p" %in% display_columns, "colname", NA)) + 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 %>% diff --git a/tests/testthat/_snaps/independent_as_gt.md b/tests/testthat/_snaps/independent_as_gt.md index 4568c13e..bf8bf5a3 100644 --- a/tests/testthat/_snaps/independent_as_gt.md +++ b/tests/testthat/_snaps/independent_as_gt.md @@ -223,7 +223,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.\\ + 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 @@ -250,7 +250,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.\\ + Value < 0.5 favors experimental, > 0.5 favors control.\\ \end{minipage} \endgroup @@ -285,7 +285,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.\\ + 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 From fbc081b9bb9ba13bbf7aff0ea5eed4a778775758 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 11:24:33 -0500 Subject: [PATCH 15/24] merge the two conditions by `&` in subset() --- R/as_gt.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 4d379360..f2ed54c5 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -335,9 +335,7 @@ as_gt.gs_design <- function( ) # 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`)) # Add spanner ---- names(x)[names(x) == "Alternate hypothesis"] <- colname_spannersub[1] From 812c3f55b6f30fce36a04ccab23eef465cf158a5 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 11:25:31 -0500 Subject: [PATCH 16/24] find the two names and substitute them via one operation --- R/as_gt.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index f2ed54c5..db66c2e0 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -338,8 +338,8 @@ as_gt.gs_design <- function( x <- subset(x, !is.na(`Alternate hypothesis`) & !is.na(`Null hypothesis`)) # Add spanner ---- - 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 x <- x %>% subset(Bound %in% display_bound) %>% From 78631943cae551e595140fae7c00bb7143d808f6 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 11:30:06 -0500 Subject: [PATCH 17/24] `if (!is.null(x)) if (length(x) != 0) for (i in seq_along(x))` is equivalent to simply `for (i in seq_along(x))`; the two `if` statements are unnecessary, because if `x` is `NULL` or of length 0, the `for` loop will be skipped also factor out the footnote location element to the object `loc`, so we don't have to repeat `x %>% gt::tab_footnote()` five times --- R/as_gt.R | 52 ++++++++++++++++------------------------------------ 1 file changed, 16 insertions(+), 36 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index db66c2e0..0c3cfe47 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -353,43 +353,23 @@ as_gt.gs_design <- function( gt::tab_header(title = title, subtitle = subtitle) # Add footnotes ---- - if (!is.null(footnote$content)) { - if (length(footnote$content) != 0) { - for (i in seq_along(footnote$content)) { - # if the footnotes is added on the colnames - if (footnote$attr[i] == "colname") { - x <- x %>% - gt::tab_footnote( - footnote = footnote$content[i], - locations = gt::cells_column_labels(columns = footnote$location[i]) - ) - } - # if the footnotes is added on the title/subtitle - if (footnote$attr[i] == "title" || footnote$attr[i] == "subtitle") { - x <- x %>% - gt::tab_footnote( - footnote = footnote$content[i], - locations = gt::cells_title(group = footnote$attr[i]) - ) - } - # if the footnotes is added on the analysis summary row, which is a grouping variable, i.e., Analysis - if (footnote$attr[i] == "analysis") { - x <- x %>% - gt::tab_footnote( - footnote = footnote$content[i], - locations = gt::cells_row_groups(groups = dplyr::starts_with("Analysis")) - ) - } - # if the footnotes is added on the column spanner - if (footnote$attr[i] == "spanner") { - x <- x %>% - gt::tab_footnote( - footnote = footnote$content[i], - locations = gt::cells_column_spanners(spanners = colname_spanner) - ) - } - } + for (i in seq_along(footnote$content)) { + att <- footnote$attr[i] + loc <- if (att == "colname") { + # footnotes are added on the colnames + gt::cells_column_labels(columns = footnote$location[i]) + } else if (att %in% c("title", "subtitle")) { + # on the title/subtitle + gt::cells_title(group = att) + } else if (att == "analysis") { + # on the analysis summary row, which is a grouping variable, i.e., Analysis + gt::cells_row_groups(groups = dplyr::starts_with("Analysis")) + } else if (att == "spanner") { + # on the column spanner + gt::cells_column_spanners(spanners = colname_spanner) } + if (!is.null(loc)) + x <- gt::tab_footnote(x, footnote = footnote$content[i], locations = loc) } ## if it is non-binding design From 8e4bad56b4b2c95bdf924a17d37330b8156ce5f2 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 11:56:25 -0500 Subject: [PATCH 18/24] factor out footnote_non_binding() so it can also be reused in as_rtf() --- R/as_gt.R | 53 ++++++++++++++++++++++++----------------------------- R/as_rtf.R | 25 ++++--------------------- 2 files changed, 28 insertions(+), 50 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 0c3cfe47..2a746f03 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -373,34 +373,29 @@ as_gt.gs_design <- function( } ## if it is non-binding design - if (x_non_binding && (x_alpha < full_alpha)) { - x <- x %>% - gt::tab_footnote( - footnote = paste0( - "Cumulative alpha for final analysis ", - "(", format(x_alpha, scientific = FALSE), ") ", - "is less than the full alpha ", - "(", format(full_alpha, scientific = FALSE), ") ", - "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 ", - "(", - format(full_alpha, scientific = FALSE), - " - ", - format(full_alpha - x_alpha, scientific = FALSE), - " = ", - format(x_alpha, scientific = FALSE), - ") ", - "under the null hypothesis." - ), - locations = gt::cells_body( - columns = colname_spannersub[2], - rows = (substring(x_old$Analysis, 1, 11) == paste0("Analysis: ", max(x_k))) & - (x_old$Bound == display_bound[1]) - ) - ) - } + if (x_non_binding && x_alpha < full_alpha) x <- gt::tab_footnote( + x, + footnote = footnote_non_binding(x_alpha, full_alpha), + locations = gt::cells_body( + columns = colname_spannersub[2], + rows = substr(x_old$Analysis, 1, 11) == paste0("Analysis: ", max(x_k)) & + x_old$Bound == display_bound[1] + ) + ) - return(x) + x +} + +footnote_non_binding <- function(x_alpha, full_alpha) { + a1 <- format(x_alpha, scientific = FALSE) + a2 <- format(full_alpha, scientific = FALSE) + a3 <- format(full_alpha - x_alpha, scientific = FALSE) + paste0( + "Cumulative alpha for final analysis ", + "(", a1, ") ", "is less than the full alpha ", "(", a2, ") ", + "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 ", + "(", a2, " - ", a3, " = ", a1, ") ", "under the null hypothesis." + ) } diff --git a/R/as_rtf.R b/R/as_rtf.R index 8e009d3e..b97997e8 100644 --- a/R/as_rtf.R +++ b/R/as_rtf.R @@ -708,30 +708,13 @@ as_rtf.gs_design <- function( " {^", intToUtf8(alpha_utf_int), "}" ) - footnote_non_binding <- paste0( + footnote_nb <- paste0( "{\\super ", intToUtf8(alpha_utf_int), "} ", - "Cumulative alpha for final analysis ", - "(", format(x_alpha, scientific = FALSE), ") ", - "is less than the full alpha ", - "(", format(full_alpha, scientific = FALSE), ") ", - "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 ", - "(", - format(full_alpha, scientific = FALSE), - " - ", - format(full_alpha - x_alpha, scientific = FALSE), - " = ", - format(x_alpha, scientific = FALSE), - ") ", - "under the null hypothesis." + footnote_non_binding(x_alpha, full_alpha) ) - if (!is.null(footnotes)) { - footnotes <- paste0(footnotes, "\\line", footnote_non_binding) - } else { - footnotes <- footnote_non_binding + footnotes <- if (is.null(footnotes)) footnote_nb else { + paste0(footnotes, "\\line", footnote_nb) } } From 17fce057c0ed0c269c6f1a2d4a1dcd495b3f090a Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 12:14:46 -0500 Subject: [PATCH 19/24] delete 's' [ci skip] --- R/ahr_blinded.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ahr_blinded.R b/R/ahr_blinded.R index 36135d30..47bea4d3 100644 --- a/R/ahr_blinded.R +++ b/R/ahr_blinded.R @@ -91,7 +91,7 @@ ahr_blinded <- function( stop("'intervals' must be a vector of positive numbers.") } if (length(intervals) != length(hr)) { - stop("the piecewise model specified 'hr' and 'intervals' differ in lengths.") + stop("the piecewise model specified 'hr' and 'intervals' differ in length.") } # Set final element of "intervals" to Inf From 22679986e9cdb6b0e228623e3059007b347769e1 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 12:25:11 -0500 Subject: [PATCH 20/24] use a string template instead --- R/as_gt.R | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 2a746f03..6d10f485 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -85,17 +85,13 @@ as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) { )[1] # set the default title - if (is.null(title)) title <- switch( + if (is.null(title)) title <- sprintf("Fixed Design under %s Method", switch( design_mtd, - "ahr" = "Fixed Design under AHR Method", - "fh" = "Fixed Design under Fleming-Harrington Method", - "mb" = "Fixed Design under Magirr-Burman Method", - "lf" = "Fixed Design under Lachin and Foulkes Method", - "rd" = "Fixed Design of Risk Difference under Farrington-Manning Method", - "maxcombo" = "Fixed Design under MaxCombo Method", - "milestone" = "Fixed Design under Milestone Method", - "rmst" = "Fixed Design under Restricted Mean Survival Time Method" - ) + ahr = "AHR", fh = "Fleming-Harrington", mb = "Magirr-Burman", + lf = "Lachin and Foulkes", maxcombo = "MaxCombo", milestone = "Milestone", + rd = "Fixed Design of Risk Difference under Farrington-Manning", + rmst = "Restricted Mean Survival Time" + )) # set the default footnote if (is.null(footnote)) footnote <- switch( From 24113fd1020a40a15fb015ba4394e037def6ec9b Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 12:26:11 -0500 Subject: [PATCH 21/24] get rid of optional quotes --- R/as_gt.R | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 6d10f485..2b4317e7 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -96,20 +96,20 @@ as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) { # set the default footnote if (is.null(footnote)) footnote <- switch( design_mtd, - "ahr" = "Power computed with average hazard ratio method.", - "fh" = paste( + ahr = "Power computed with average hazard ratio method.", + fh = paste( "Power for Fleming-Harrington test", substring(x$Design, 19), "using method of Yung and Liu." ), - "lf" = paste( + lf = paste( "Power using Lachin and Foulkes method applied using expected", "average hazard ratio (AHR) at time of planned analysis." ), - "rd" = paste( + rd = paste( "Risk difference power without continuity correction using method of", "Farrington and Manning." ), - "maxcombo" = paste0( + maxcombo = paste0( "Power for MaxCombo test with Fleming-Harrington tests ", substring(x$Design, 9), "." ), @@ -257,17 +257,17 @@ as_gt.gs_design <- function( # 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" + 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" + 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 @@ -289,7 +289,7 @@ as_gt.gs_design <- function( # set different default footnotes to different methods if (is.null(footnote)) footnote <- switch( method, - "ahr" = list( + ahr = list( content = c( if (i1 <- "~HR at bound" %in% display_columns) "Approximate hazard ratio to cross bound.", @@ -300,7 +300,7 @@ as_gt.gs_design <- function( location = c(if (i1) "~HR at bound", if (i2) "Nominal p"), attr = c(if (i1) "colname", if (i2) "colname") ), - "wlr" = list( + wlr = list( content = c( if (i1 <- "~wHR at bound" %in% display_columns) "Approximate hazard ratio to cross bound.", @@ -312,7 +312,7 @@ as_gt.gs_design <- function( location = c(if (i1) "~wHR at bound", if (i2) "Nominal p"), attr = c(if (i1) "colname", if (i2) "colname", "analysis") ), - "combo" = list( + combo = list( content = c( if (i2 <- "Nominal p" %in% display_columns) "One-sided p-value for experimental vs control treatment. @@ -321,7 +321,7 @@ as_gt.gs_design <- function( location = if (i2) "Nominal p", attr = c(if (i2) "colname", "analysis") ), - "rd" = list( + 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.", From 7168d2dbe45791abf8aa35dc6834845835b5391c Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 9 Aug 2024 12:46:17 -0500 Subject: [PATCH 22/24] bump version [ci skip] --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 935d639d..bbdbb8f5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: gsDesign2 Title: Group Sequential Design with Non-Constant Effect -Version: 1.1.2.19 +Version: 1.1.2.20 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 90352a04ad6d367b65777fd3915b5dc1ba5827fb Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 12:17:29 -0500 Subject: [PATCH 23/24] explicit return --- R/ahr_blinded.R | 3 ++- R/as_gt.R | 6 ++++-- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/R/ahr_blinded.R b/R/ahr_blinded.R index 47bea4d3..691afe59 100644 --- a/R/ahr_blinded.R +++ b/R/ahr_blinded.R @@ -111,10 +111,11 @@ ahr_blinded <- function( # Compute adjustment for information q_e <- ratio / (1 + ratio) - tibble( + ans <- tibble( event = sum(event), ahr = exp(-theta), theta = theta, info0 = sum(event) * (1 - q_e) * q_e ) + return(ans) } diff --git a/R/as_gt.R b/R/as_gt.R index 2b4317e7..4fd7ad0a 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -117,9 +117,11 @@ as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) { paste("Power for", x$Design, "computed with method of Yung and Liu.") ) - gt::gt(x) %>% + 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 @@ -379,7 +381,7 @@ as_gt.gs_design <- function( ) ) - x + return(x) } footnote_non_binding <- function(x_alpha, full_alpha) { From 2494e577234b2077d48fa303c2307ef91c46fe16 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Mon, 12 Aug 2024 14:08:31 -0500 Subject: [PATCH 24/24] fix title for the 'rd' method --- R/as_gt.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index 4fd7ad0a..89f1f6cb 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -85,12 +85,12 @@ as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) { )[1] # set the default title - if (is.null(title)) title <- sprintf("Fixed Design under %s Method", switch( + if (is.null(title)) title <- sprintf("Fixed Design %s Method", switch( design_mtd, - ahr = "AHR", fh = "Fleming-Harrington", mb = "Magirr-Burman", - lf = "Lachin and Foulkes", maxcombo = "MaxCombo", milestone = "Milestone", - rd = "Fixed Design of Risk Difference under Farrington-Manning", - rmst = "Restricted Mean Survival Time" + 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