From 943121db91b7697f1266940841bd23ca41c871a2 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Thu, 29 Aug 2024 23:01:13 -0500 Subject: [PATCH 01/43] purely cosmetic changes --- R/summary.R | 41 ++++++++++++++--------------------------- 1 file changed, 14 insertions(+), 27 deletions(-) diff --git a/R/summary.R b/R/summary.R index 122ee9c2..9d6b57a8 100644 --- a/R/summary.R +++ b/R/summary.R @@ -79,39 +79,26 @@ #' summary.fixed_design <- function(object, ...) { x <- object - x_design <- switch(x$design, - "ahr" = { - "Average hazard ratio" - }, - "lf" = { - "Lachin and Foulkes" - }, - "rd" = { - "Risk difference" - }, - "milestone" = { - paste0("Milestone: tau = ", x$design_par$tau) - }, - "rmst" = { - paste0("RMST: tau = ", x$design_par$tau) - }, - "mb" = { - paste0("Modestly weighted LR: tau = ", x$design_par$tau) - }, - "fh" = { - if (x$design_par$rho == 0 & x$design_par$gamma == 0) { - paste0("Fleming-Harrington FH(0, 0) (logrank)") - } else { - paste0("Fleming-Harrington FH(", x$design_par$rho, ", ", x$design_par$gamma, ")") - } + x_design <- switch( + x$design, + ahr = "Average hazard ratio", + lf = "Lachin and Foulkes", + rd = "Risk difference", + milestone = paste0("Milestone: tau = ", x$design_par$tau), + rmst = paste0("RMST: tau = ", x$design_par$tau), + mb = paste0("Modestly weighted LR: tau = ", x$design_par$tau), + fh = if (x$design_par$rho == 0 & x$design_par$gamma == 0) { + paste0("Fleming-Harrington FH(0, 0) (logrank)") + } else { + paste0("Fleming-Harrington FH(", x$design_par$rho, ", ", x$design_par$gamma, ")") }, - "maxcombo" = { + maxcombo = { temp <- paste0( "MaxCombo: FH(", paste(apply(do.call(rbind, x$design_par[c(1:2)]), 2, paste, collapse = ", "), collapse = "), FH("), ")" ) - gsub(pattern = "FH\\(0, 0\\)", replacement = "logrank", x = temp) + gsub("FH\\(0, 0\\)", "logrank", temp) } ) From 6de4e78547f34c92e2ba56719bbc4b255f4fbb13 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Thu, 29 Aug 2024 23:10:08 -0500 Subject: [PATCH 02/43] use a single paste0() --- R/summary.R | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/R/summary.R b/R/summary.R index 9d6b57a8..ef074614 100644 --- a/R/summary.R +++ b/R/summary.R @@ -87,11 +87,10 @@ summary.fixed_design <- function(object, ...) { milestone = paste0("Milestone: tau = ", x$design_par$tau), rmst = paste0("RMST: tau = ", x$design_par$tau), mb = paste0("Modestly weighted LR: tau = ", x$design_par$tau), - fh = if (x$design_par$rho == 0 & x$design_par$gamma == 0) { - paste0("Fleming-Harrington FH(0, 0) (logrank)") - } else { - paste0("Fleming-Harrington FH(", x$design_par$rho, ", ", x$design_par$gamma, ")") - }, + fh = paste0( + "Fleming-Harrington FH(", x$design_par$rho, ", ", x$design_par$gamma, ")", + if (x$design_par$rho == 0 && x$design_par$gamma == 0) " (logrank)" + ), maxcombo = { temp <- paste0( "MaxCombo: FH(", From b26ed329bf856fae064e5737e8f102770351f69b Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Thu, 29 Aug 2024 23:24:36 -0500 Subject: [PATCH 03/43] no need ot do.call(rbind, ...) or apply(..., paste): just paste the first and second elements in x$design_par; also use gsub(fixed = TRUE) to avoid escaping parentheses as \(\) --- R/summary.R | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/R/summary.R b/R/summary.R index ef074614..eabe29a8 100644 --- a/R/summary.R +++ b/R/summary.R @@ -91,14 +91,10 @@ summary.fixed_design <- function(object, ...) { "Fleming-Harrington FH(", x$design_par$rho, ", ", x$design_par$gamma, ")", if (x$design_par$rho == 0 && x$design_par$gamma == 0) " (logrank)" ), - maxcombo = { - temp <- paste0( - "MaxCombo: FH(", - paste(apply(do.call(rbind, x$design_par[c(1:2)]), 2, paste, collapse = ", "), collapse = "), FH("), - ")" - ) - gsub("FH\\(0, 0\\)", "logrank", temp) - } + maxcombo = gsub("FH(0, 0)", "logrank", paste( + "MaxCombo:", + paste0("FHC(", x$design_par[[1]], ", ", x$design_par[[2]], ")", collapse = ", "), + ), fixed = TRUE) ) ans <- x$analysis %>% mutate(design = x_design) From 59047f33d31cd7fe76d06735c9a386c3c1bfd348 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Thu, 29 Aug 2024 23:43:18 -0500 Subject: [PATCH 04/43] use a regular expression \\U to capitalize the first letter an alternative way is a loop: for (i in c("design", "n", "event", "time", "bound", "power")) { # special case: Event -> Events names(ans)[names(ans) == i] <- if (i == "event") "Events" else { # capitalize the first letter sub("^(.)", "\\U\\1", i, perl = TRUE) } } --- R/summary.R | 30 ++++++++---------------------- 1 file changed, 8 insertions(+), 22 deletions(-) diff --git a/R/summary.R b/R/summary.R index eabe29a8..95cea2ff 100644 --- a/R/summary.R +++ b/R/summary.R @@ -97,28 +97,14 @@ summary.fixed_design <- function(object, ...) { ), fixed = TRUE) ) - ans <- x$analysis %>% mutate(design = x_design) - ans <- ans %>% dplyr::rename(Design = design) - - if ("n" %in% names(ans)) { - ans <- ans %>% dplyr::rename(N = n) - } - - if ("event" %in% names(ans)) { - ans <- ans %>% dplyr::rename(Events = event) - } - - if ("time" %in% names(ans)) { - ans <- ans %>% dplyr::rename(Time = time) - } - - if ("bound" %in% names(ans)) { - ans <- ans %>% dplyr::rename(Bound = bound) - } - - if ("power" %in% names(ans)) { - ans <- ans %>% dplyr::rename(Power = power) - } + ans <- within(x$analysis, design <- x_design) + nms <- c("design", "n", "event", "time", "bound", "power") + i <- names(ans) %in% nms + # capitalize the first letter + names(ans)[i] <- sub("^(.)", "\\U\\1", names(ans)[i], perl = TRUE) + # special case: Event -> Events + i <- names(ans) == "Event" + names(ans)[i] <- "Events" class(ans) <- c("fixed_design", x$design, class(ans)) return(ans) From f163e05d78afa8c902a9bdeae63329f9e8604f3c Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 30 Aug 2024 07:56:58 -0500 Subject: [PATCH 05/43] extra , --- R/summary.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/summary.R b/R/summary.R index 95cea2ff..3a0e91d7 100644 --- a/R/summary.R +++ b/R/summary.R @@ -93,7 +93,7 @@ summary.fixed_design <- function(object, ...) { ), maxcombo = gsub("FH(0, 0)", "logrank", paste( "MaxCombo:", - paste0("FHC(", x$design_par[[1]], ", ", x$design_par[[2]], ")", collapse = ", "), + paste0("FHC(", x$design_par[[1]], ", ", x$design_par[[2]], ")", collapse = ", ") ), fixed = TRUE) ) From 45f7a590f93a1f2953a98e7b3501df83afb631ac Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 30 Aug 2024 08:08:50 -0500 Subject: [PATCH 06/43] factor out `class(x) <- c(..., class(x))` to add_class() --- R/gs_design_ahr.R | 6 +----- R/gs_design_rd.R | 6 +----- R/gs_design_wlr.R | 6 +----- R/gs_power_ahr.R | 6 +----- R/gs_power_rd.R | 6 +----- R/gs_power_wlr.R | 6 +----- R/gs_update_ahr.R | 2 +- R/summary.R | 2 +- R/to_integer.R | 6 +++--- R/utils.R | 6 ++++++ 10 files changed, 17 insertions(+), 35 deletions(-) diff --git a/R/gs_design_ahr.R b/R/gs_design_ahr.R index 9f966093..60aa328b 100644 --- a/R/gs_design_ahr.R +++ b/R/gs_design_ahr.R @@ -380,10 +380,6 @@ gs_design_ahr <- function( analysis = analysis ) - class(ans) <- c("ahr", "gs_design", class(ans)) - if (!binding) { - class(ans) <- c("non_binding", class(ans)) - } - + ans <- add_class(ans, if (!binding) "non_binding", "ahr", "gs_design") return(ans) } diff --git a/R/gs_design_rd.R b/R/gs_design_rd.R index 9300d590..6da38710 100644 --- a/R/gs_design_rd.R +++ b/R/gs_design_rd.R @@ -281,10 +281,6 @@ gs_design_rd <- function(p_c = tibble::tibble(stratum = "All", rate = .2), analysis = analysis ) - class(ans) <- c("rd", "gs_design", class(ans)) - if (!binding) { - class(ans) <- c("non_binding", class(ans)) - } - + ans <- add_class(ans, if (!binding) "non_binding", "rd", "gs_design") return(ans) } diff --git a/R/gs_design_wlr.R b/R/gs_design_wlr.R index d6f57c18..12f9e597 100644 --- a/R/gs_design_wlr.R +++ b/R/gs_design_wlr.R @@ -268,10 +268,6 @@ gs_design_wlr <- function( analysis = analysis ) - class(ans) <- c("wlr", "gs_design", class(ans)) - if (!binding) { - class(ans) <- c("non_binding", class(ans)) - } - + ans <- add_class(ans, if (!binding) "non_binding", "wlr", "gs_design") return(ans) } diff --git a/R/gs_power_ahr.R b/R/gs_power_ahr.R index ab16f403..7fb84e0a 100644 --- a/R/gs_power_ahr.R +++ b/R/gs_power_ahr.R @@ -280,10 +280,6 @@ gs_power_ahr <- function( analysis = analysis ) - class(ans) <- c("ahr", "gs_design", class(ans)) - if (!binding) { - class(ans) <- c("non_binding", class(ans)) - } - + ans <- add_class(ans, if (!binding) "non_binding", "ahr", "gs_design") return(ans) } diff --git a/R/gs_power_rd.R b/R/gs_power_rd.R index 3f2e26e8..a0c1502f 100644 --- a/R/gs_power_rd.R +++ b/R/gs_power_rd.R @@ -348,10 +348,6 @@ gs_power_rd <- function( analysis = analysis ) - class(ans) <- c("rd", "gs_design", class(ans)) - if (!binding) { - class(ans) <- c("non_binding", class(ans)) - } - + ans <- add_class(ans, if (!binding) "non_binding", "rd", "gs_design") return(ans) } diff --git a/R/gs_power_wlr.R b/R/gs_power_wlr.R index 2d65b3cd..94759c15 100644 --- a/R/gs_power_wlr.R +++ b/R/gs_power_wlr.R @@ -306,11 +306,7 @@ gs_power_wlr <- function(enroll_rate = define_enroll_rate(duration = c(2, 2, 10) analysis = analysis ) - class(ans) <- c("wlr", "gs_design", class(ans)) - if (!binding) { - class(ans) <- c("non_binding", class(ans)) - } - + ans <- add_class(ans, if (!binding) "non_binding", "wlr", "gs_design") return(ans) } diff --git a/R/gs_update_ahr.R b/R/gs_update_ahr.R index d8c9fddc..a4320eb0 100644 --- a/R/gs_update_ahr.R +++ b/R/gs_update_ahr.R @@ -466,7 +466,7 @@ gs_update_ahr <- function( } ) - class(ans) <- c(class(x), "updated_design") + ans <- add_class(ans, "updated_design") return(ans) } diff --git a/R/summary.R b/R/summary.R index 3a0e91d7..cd3d21f7 100644 --- a/R/summary.R +++ b/R/summary.R @@ -106,7 +106,7 @@ summary.fixed_design <- function(object, ...) { i <- names(ans) == "Event" names(ans)[i] <- "Events" - class(ans) <- c("fixed_design", x$design, class(ans)) + ans <- add_class(ans, "fixed_design", x$design) return(ans) } diff --git a/R/to_integer.R b/R/to_integer.R index f358c6be..6512794e 100644 --- a/R/to_integer.R +++ b/R/to_integer.R @@ -126,7 +126,7 @@ to_integer.fixed_design <- function(x, sample_size = TRUE, ...) { analysis = analysis, design = "ahr" ) - class(ans) <- c("fixed_design", class(ans)) + ans <- add_class(ans, "fixed_design") } else if ((x$design == "fh") && (input_n != output_n)) { x_new <- gs_power_wlr( enroll_rate = enroll_rate_new, @@ -159,7 +159,7 @@ to_integer.fixed_design <- function(x, sample_size = TRUE, ...) { analysis = analysis, design = "fh", design_par = x$design_par ) - class(ans) <- c("fixed_design", class(ans)) + ans <- add_class(ans, "fixed_design") } else if ((x$design == "mb") && (input_n != output_n)) { x_new <- gs_power_wlr( enroll_rate = enroll_rate_new, @@ -192,7 +192,7 @@ to_integer.fixed_design <- function(x, sample_size = TRUE, ...) { analysis = analysis, design = "mb", design_par = x$design_par ) - class(ans) <- c("fixed_design", class(ans)) + ans <- add_class(ans, "fixed_design") } else { message("The input object is not applicable to get an integer sample size.") ans <- x diff --git a/R/utils.R b/R/utils.R index bca42fde..4731d28e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -10,3 +10,9 @@ if (!exists('%||%', baseenv(), inherits = FALSE)) `%||%` <- function(x, y) { for (i in idx) x[[i]] <- c(x[[i]], y[[i]]) x } + +# add more classes to an object +add_class <- function(x, ...) { + class(x) <- c(..., class(x)) + x +} From a0830bd7f0abc5717bf28888bad619094bd9894a Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 30 Aug 2024 08:09:08 -0500 Subject: [PATCH 07/43] always add newline to files --- gsDesign2.Rproj | 1 + 1 file changed, 1 insertion(+) diff --git a/gsDesign2.Rproj b/gsDesign2.Rproj index 1440aa06..270314b8 100644 --- a/gsDesign2.Rproj +++ b/gsDesign2.Rproj @@ -12,6 +12,7 @@ Encoding: UTF-8 RnwWeave: Sweave LaTeX: pdfLaTeX +AutoAppendNewline: Yes StripTrailingWhitespace: Yes BuildType: Package From 23f4207081b41533575164fe0f4c465e9a2dcef3 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 30 Aug 2024 08:26:53 -0500 Subject: [PATCH 08/43] factor out get_method() --- R/as_gt.R | 5 +++-- R/summary.R | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/R/as_gt.R b/R/as_gt.R index c31e3880..e6ee55fa 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -89,10 +89,11 @@ as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) { return(ans) } +get_method <- function(x, methods) intersect(methods, class(x))[1] + # get the fixed design method fd_method <- function(x) { - methods <- c("ahr", "fh", "mb", "lf", "rd", "maxcombo", "milestone", "rmst") - intersect(methods, class(x))[1] + get_method(x, c("ahr", "fh", "mb", "lf", "rd", "maxcombo", "milestone", "rmst")) } # get the default title diff --git a/R/summary.R b/R/summary.R index cd3d21f7..6ee61a38 100644 --- a/R/summary.R +++ b/R/summary.R @@ -289,7 +289,7 @@ summary.gs_design <- function(object, bound_names = c("Efficacy", "Futility"), ...) { x <- object - method <- class(x)[class(x) %in% c("ahr", "wlr", "combo", "rd")] + method <- get_method(x, c("ahr", "wlr", "combo", "rd")) x_bound <- x$bound x_analysis <- x$analysis n_analysis <- max(x_analysis$analysis) From ea50328ad25b601901bf551e5bf31fbb1a33cde6 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 30 Aug 2024 08:44:08 -0500 Subject: [PATCH 09/43] merge all these `if` statements --- R/summary.R | 33 ++++++--------------------------- 1 file changed, 6 insertions(+), 27 deletions(-) diff --git a/R/summary.R b/R/summary.R index 6ee61a38..3d8e5c7d 100644 --- a/R/summary.R +++ b/R/summary.R @@ -295,33 +295,12 @@ summary.gs_design <- function(object, n_analysis <- max(x_analysis$analysis) # Prepare the columns decimals ---- - if (method == "ahr") { - col_vars_default <- c( - "analysis", "bound", "z", "~hr at bound", "nominal p", - "Alternate hypothesis", "Null hypothesis" - ) - col_decimals_default <- c(NA, NA, 2, 4, 4, 4, 4) - } else if (method == "wlr") { - col_vars_default <- c( - "analysis", "bound", "z", "~whr at bound", "nominal p", - "Alternate hypothesis", "Null hypothesis" - ) - col_decimals_default <- c(NA, NA, 2, 4, 4, 4, 4) - } else if (method == "combo") { - col_vars_default <- c( - "analysis", "bound", "z", "nominal p", - "Alternate hypothesis", "Null hypothesis" - ) - col_decimals_default <- c(NA, NA, 2, 4, 4, 4) - } else if (method == "rd") { - col_vars_default <- c( - "analysis", "bound", "z", "~risk difference at bound", - "nominal p", "Alternate hypothesis", "Null hypothesis" - ) - col_decimals_default <- c(NA, NA, 2, 4, 4, 4, 4) - } else { - stop("Invalid method: ", method) - } + col_decimals_default <- c(NA, NA, 2, if (method != "combo") 4, 4, 4, 4) + col_vars_default <- c( + "analysis", "bound", "z", + sprintf("~%s at bound", switch(method, ahr = "hr", wlr = "whr", rd = "risk difference")), + "nominal p", "Alternate hypothesis", "Null hypothesis" + ) # Filter columns and update decimal places names(col_decimals_default) <- col_vars_default From 0c3190ef103fe0f0c99ca2ccaa37781432d6d414 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 30 Aug 2024 09:16:15 -0500 Subject: [PATCH 10/43] `ans` should inherit classes from `x` instead of `ans` --- R/gs_update_ahr.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/gs_update_ahr.R b/R/gs_update_ahr.R index a4320eb0..d8c9fddc 100644 --- a/R/gs_update_ahr.R +++ b/R/gs_update_ahr.R @@ -466,7 +466,7 @@ gs_update_ahr <- function( } ) - ans <- add_class(ans, "updated_design") + class(ans) <- c(class(x), "updated_design") return(ans) } From cefeb5f518787392243aac0de6de1f87d811227e Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 30 Aug 2024 09:16:58 -0500 Subject: [PATCH 11/43] no need to create the object `x_design`; just assign to `ans$design` --- R/summary.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/summary.R b/R/summary.R index 3d8e5c7d..3e359735 100644 --- a/R/summary.R +++ b/R/summary.R @@ -79,7 +79,8 @@ #' summary.fixed_design <- function(object, ...) { x <- object - x_design <- switch( + ans <- x$analysis + ans$design <- switch( x$design, ahr = "Average hazard ratio", lf = "Lachin and Foulkes", @@ -97,7 +98,6 @@ summary.fixed_design <- function(object, ...) { ), fixed = TRUE) ) - ans <- within(x$analysis, design <- x_design) nms <- c("design", "n", "event", "time", "bound", "power") i <- names(ans) %in% nms # capitalize the first letter From e3eaa16d7b6085bad61e38e1cefd015649711de3 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 30 Aug 2024 11:14:47 -0500 Subject: [PATCH 12/43] untangle this complicated if-else hairball the pattern `x[match(y, names(x))]` could win an unmatched award... it should have been simply `x[y]` --- R/summary.R | 52 +++++++------------------ tests/testthat/test-developer-summary.R | 4 +- 2 files changed, 17 insertions(+), 39 deletions(-) diff --git a/R/summary.R b/R/summary.R index 3e359735..3423a916 100644 --- a/R/summary.R +++ b/R/summary.R @@ -295,49 +295,27 @@ summary.gs_design <- function(object, n_analysis <- max(x_analysis$analysis) # Prepare the columns decimals ---- - col_decimals_default <- c(NA, NA, 2, if (method != "combo") 4, 4, 4, 4) - col_vars_default <- c( + default_decimals <- c(NA, NA, 2, if (method != "combo") 4, 4, 4, 4) + default_vars <- c( "analysis", "bound", "z", sprintf("~%s at bound", switch(method, ahr = "hr", wlr = "whr", rd = "risk difference")), "nominal p", "Alternate hypothesis", "Null hypothesis" ) # Filter columns and update decimal places - names(col_decimals_default) <- col_vars_default - if (is.null(col_vars) && is.null(col_decimals)) { - # Use default values - col_vars <- col_vars_default - col_decimals <- col_decimals_default - } else if (!is.null(col_vars) && is.null(col_decimals)) { - # Only drop/rearrange variables - col_decimals <- col_decimals_default[ - match(col_vars, names(col_decimals_default)) - ] - } else if (is.null(col_vars) && !is.null(col_decimals)) { - # Only update decimals - must be named vector - if (is.null(names(col_decimals))) { - stop("summary: col_decimals must be a named vector if col_vars is not provided") - } - col_vars <- col_vars_default - col_decimals_tmp <- col_decimals_default - col_decimals_tmp[names(col_decimals)] <- col_decimals - col_decimals <- col_decimals_tmp - } else if (!is.null(col_vars) && !is.null(col_decimals)) { - # Update variables and decimals - if (is.null(names(col_decimals))) { - # vectors must be same length if col_decimals is unnamed - if (length(col_vars) != length(col_decimals)) { - stop("summary: please input col_vars and col_decimals in pairs!") - } - } else { - col_decimals_tmp <- col_decimals_default - col_decimals_tmp[names(col_decimals)] <- col_decimals - col_decimals <- col_decimals_tmp - col_decimals <- col_decimals[ - match(col_vars, names(col_decimals)) - ] - } - } + names(default_decimals) <- default_vars + # Merge user-provided named decimals into default + decimals_vars <- names(col_decimals) + default_decimals[decimals_vars] <- col_decimals + + if (is.null(col_vars)) { + if (!is.null(col_decimals) && is.null(decimals_vars)) + stop("'col_decimals' must be a named vector if 'col_vars' is not provided") + col_vars <- default_vars + } + col_decimals <- (if (is.null(decimals_vars)) col_decimals) %||% default_decimals[col_vars] + if (length(col_vars) != length(col_decimals)) + stop("'col_vars' and 'col_decimals' must be of the same length") # "bound" is a required column if (!"bound" %in% col_vars) { diff --git a/tests/testthat/test-developer-summary.R b/tests/testthat/test-developer-summary.R index 7d8dd985..13d1a250 100644 --- a/tests/testthat/test-developer-summary.R +++ b/tests/testthat/test-developer-summary.R @@ -235,7 +235,7 @@ test_that("summary.gs_design() accepts same-length vectors for col_vars and col_ col_vars = c("Null hypothesis", "Alternate hypothesis", "nominal p"), col_decimals = c(0, 0), ), - "summary: please input col_vars and col_decimals in pairs!" + "'col_vars' and 'col_decimals' must be of the same length" ) }) @@ -284,6 +284,6 @@ test_that("summary.gs_design() accepts a named vector for col_decimals", { # Throw error is col_decimals is unnamed expect_error( summary(x, col_decimals = c(4, 4)), - "summary: col_decimals must be a named vector if col_vars is not provided" + "'col_decimals' must be a named vector if 'col_vars' is not provided" ) }) From a40583257742552fea6d2156fab92ad59899c5be Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 30 Aug 2024 12:07:49 -0500 Subject: [PATCH 13/43] factor out replace_values() --- R/summary.R | 13 ++++++------- R/utils.R | 12 ++++++++++++ 2 files changed, 18 insertions(+), 7 deletions(-) diff --git a/R/summary.R b/R/summary.R index 3423a916..22975112 100644 --- a/R/summary.R +++ b/R/summary.R @@ -98,13 +98,12 @@ summary.fixed_design <- function(object, ...) { ), fixed = TRUE) ) - nms <- c("design", "n", "event", "time", "bound", "power") - i <- names(ans) %in% nms - # capitalize the first letter - names(ans)[i] <- sub("^(.)", "\\U\\1", names(ans)[i], perl = TRUE) - # special case: Event -> Events - i <- names(ans) == "Event" - names(ans)[i] <- "Events" + names(ans) <- replace_values( + names(ans), c("design", "n", "event", "time", "bound", "power"), function(x) { + # capitalize words with special case of Event -> Events + ifelse(x == "event", "Events", cap_initial(x)) + } + ) ans <- add_class(ans, "fixed_design", x$design) return(ans) diff --git a/R/utils.R b/R/utils.R index 4731d28e..9821c07e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -16,3 +16,15 @@ add_class <- function(x, ...) { class(x) <- c(..., class(x)) x } + +# capitalize initial letters +cap_initial <- function(x) { + sub("^(.)", "\\U\\1", x, perl = TRUE) +} + +# replace elements with values transformed by new() +replace_values <- function(x, old, new = identity) { + i <- x %in% old + x[i] <- new(x[i]) + x +} From fdf14ae3afaeaaf1abf1d0702161007e31e78c39 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 30 Aug 2024 12:08:50 -0500 Subject: [PATCH 14/43] batch capitalize variable names --- R/summary.R | 55 ++++++++++++++--------------------------------------- 1 file changed, 14 insertions(+), 41 deletions(-) diff --git a/R/summary.R b/R/summary.R index 22975112..3e48b03a 100644 --- a/R/summary.R +++ b/R/summary.R @@ -322,11 +322,6 @@ summary.gs_design <- function(object, col_decimals <- c(NA, col_decimals) } - x_decimals <- tibble::tibble( - col_vars = col_vars, - col_decimals = col_decimals - ) - # Prepare the analysis summary row ---- # get the # (1) analysis variables to be displayed on the header @@ -570,43 +565,21 @@ summary.gs_design <- function(object, } # Set the decimals to display ---- - if ("analysis" %in% x_decimals$col_vars) { - x_decimals <- x_decimals %>% mutate(col_vars = dplyr::if_else(col_vars == "analysis", "Analysis", col_vars)) - } - - if ("bound" %in% x_decimals$col_vars) { - x_decimals <- x_decimals %>% mutate(col_vars = dplyr::if_else(col_vars == "bound", "Bound", col_vars)) - } - - if ("z" %in% x_decimals$col_vars) { - x_decimals <- x_decimals %>% mutate(col_vars = dplyr::if_else(col_vars == "z", "Z", col_vars)) - } - - if ("~risk difference at bound" %in% x_decimals$col_vars) { - x_decimals <- x_decimals %>% - mutate(col_vars = dplyr::if_else(col_vars == "~risk difference at bound", - "~Risk difference at bound", col_vars - )) - } - - if ("~hr at bound" %in% x_decimals$col_vars) { - x_decimals <- x_decimals %>% - mutate(col_vars = dplyr::if_else(col_vars == "~hr at bound", - "~HR at bound", col_vars - )) - } - - if ("~whr at bound" %in% x_decimals$col_vars) { - x_decimals <- x_decimals %>% - mutate(col_vars = dplyr::if_else(col_vars == "~whr at bound", - "~wHR at bound", col_vars - )) - } - - if ("nominal p" %in% x_decimals$col_vars) { - x_decimals <- x_decimals %>% mutate(col_vars = dplyr::if_else(col_vars == "nominal p", "Nominal p", col_vars)) - } + col_vars <- replace_values( + col_vars, + c("analysis", "bound", "z", "~risk difference at bound", "~hr at bound", "~whr at bound", "nominal p"), + function(x) { + x <- cap_initial(x) + x <- gsub("^~risk ", "~Risk ", x) + x <- gsub("^(~w?)(hr) ", "\\1HR ", x, perl = TRUE) + x + } + ) + x_decimals <- tibble::tibble( + col_vars = col_vars, + col_decimals = col_decimals + ) output <- output %>% select(x_decimals$col_vars) if ("Z" %in% colnames(output)) { From df565fdd534664044307740038ca40ab3f4431ac Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 30 Aug 2024 13:47:08 -0500 Subject: [PATCH 15/43] the `mutate_at()` can be a simple `<-` assignment to column, and the `filter()` can be simply indexing by name from `col_decimals`; then all `if` statments can be merged into a `for` loop --- R/summary.R | 55 +++++++---------------------------------------------- R/utils.R | 5 +++++ 2 files changed, 12 insertions(+), 48 deletions(-) diff --git a/R/summary.R b/R/summary.R index 3e48b03a..0332ff25 100644 --- a/R/summary.R +++ b/R/summary.R @@ -564,7 +564,6 @@ summary.gs_design <- function(object, ) } - # Set the decimals to display ---- col_vars <- replace_values( col_vars, c("analysis", "bound", "z", "~risk difference at bound", "~hr at bound", "~whr at bound", "nominal p"), @@ -575,55 +574,15 @@ summary.gs_design <- function(object, x } ) + names(col_decimals) <- col_vars - x_decimals <- tibble::tibble( - col_vars = col_vars, - col_decimals = col_decimals + output <- select(output, all_of(col_vars)) + # Set the decimals to display ---- + round_vars <- c( + "Z", "~HR at bound", "~Risk difference at bound", "Nominal p", + "Alternate hypothesis", "Null hypothesis" ) - - output <- output %>% select(x_decimals$col_vars) - if ("Z" %in% colnames(output)) { - output <- output %>% dplyr::mutate_at( - "Z", - round, - (x_decimals %>% filter(col_vars == "Z"))$col_decimals - ) - } - if ("~HR at bound" %in% colnames(output)) { - output <- output %>% dplyr::mutate_at( - "~HR at bound", - round, - (x_decimals %>% filter(col_vars == "~HR at bound"))$col_decimals - ) - } - if ("~Risk difference at bound" %in% colnames(output)) { - output <- output %>% dplyr::mutate_at( - "~Risk difference at bound", - round, - (x_decimals %>% filter(col_vars == "~Risk difference at bound"))$col_decimals - ) - } - if ("Nominal p" %in% colnames(output)) { - output <- output %>% dplyr::mutate_at( - "Nominal p", - round, - (x_decimals %>% filter(col_vars == "Nominal p"))$col_decimals - ) - } - if ("Alternate hypothesis" %in% colnames(output)) { - output <- output %>% dplyr::mutate_at( - "Alternate hypothesis", - round, - (x_decimals %>% filter(col_vars == "Alternate hypothesis"))$col_decimals - ) - } - if ("Null hypothesis" %in% colnames(output) && is.vector(output[["Null hypothesis"]], mode = "numeric")) { - output <- output %>% dplyr::mutate_at( - "Null hypothesis", - round, - (x_decimals %>% filter(col_vars == "Null hypothesis"))$col_decimals - ) - } + for (j in round_vars) output[[j]] <- round2(output[[j]], col_decimals[j]) class(output) <- c(method, "gs_design", class(output)) if ("non_binding" %in% class(object)) { diff --git a/R/utils.R b/R/utils.R index 9821c07e..8f9c282e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -28,3 +28,8 @@ replace_values <- function(x, old, new = identity) { x[i] <- new(x[i]) x } + +# round only if input is numeric +round2 <- function(x, ...) { + if (is.numeric(x)) round(x, ...) else x +} From 84a2754bae0b8892137db17146a679829c342171 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 30 Aug 2024 13:49:44 -0500 Subject: [PATCH 16/43] use add_class() --- R/summary.R | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/R/summary.R b/R/summary.R index 0332ff25..b12b0a75 100644 --- a/R/summary.R +++ b/R/summary.R @@ -584,10 +584,9 @@ summary.gs_design <- function(object, ) for (j in round_vars) output[[j]] <- round2(output[[j]], col_decimals[j]) - class(output) <- c(method, "gs_design", class(output)) - if ("non_binding" %in% class(object)) { - class(output) <- c("non_binding", class(output)) - } + output <- add_class( + output, method, intersect("non_binding", class(object)), method, "gs_design" + ) # Save the full alpha as an attribute of the output summary table attr(output, "full_alpha") <- From 920b18cbca69520ac5109961b065844a424372f2 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 30 Aug 2024 13:55:50 -0500 Subject: [PATCH 17/43] use %||% --- R/summary.R | 17 +++++------------ 1 file changed, 5 insertions(+), 12 deletions(-) diff --git a/R/summary.R b/R/summary.R index b12b0a75..e445f9ba 100644 --- a/R/summary.R +++ b/R/summary.R @@ -589,18 +589,11 @@ summary.gs_design <- function(object, ) # Save the full alpha as an attribute of the output summary table - attr(output, "full_alpha") <- - if (is.null(object$input$alpha)) { - # case when given sample size to calculate power - if (!is.list(object$input$upar)) { - 0.025 - } else { - object$input$upar$total_spend - } - } else { - # case when given power to calcuate sample size - object$input$alpha - } + # Use input$alpha when given power to calculate sample size + attr(output, "full_alpha") <- object$input$alpha %||% { + # when given sample size to calculate power + if (is.list(object$input$upar)) object$input$upar$total_spend else 0.025 + } return(output) } From b263d07a7928c90e04044ae7921ef667a6a1f5b7 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 30 Aug 2024 15:07:40 -0500 Subject: [PATCH 18/43] store col_vars in the names of col_decimals, and use names when we need to access the col_vars --- R/summary.R | 31 ++++++++++++++----------------- 1 file changed, 14 insertions(+), 17 deletions(-) diff --git a/R/summary.R b/R/summary.R index e445f9ba..6b8a3b0e 100644 --- a/R/summary.R +++ b/R/summary.R @@ -316,11 +316,20 @@ summary.gs_design <- function(object, if (length(col_vars) != length(col_decimals)) stop("'col_vars' and 'col_decimals' must be of the same length") + col_vars <- replace_values( + col_vars, + c("analysis", "bound", "z", "~risk difference at bound", "~hr at bound", "~whr at bound", "nominal p"), + function(x) { + x <- cap_initial(x) + x <- gsub("^~risk ", "~Risk ", x) + x <- gsub("^(~w?)(hr) ", "\\1HR ", x, perl = TRUE) + x + } + ) + names(col_decimals) <- col_vars + # "bound" is a required column - if (!"bound" %in% col_vars) { - col_vars <- c("bound", col_vars) - col_decimals <- c(NA, col_decimals) - } + if (!"Bound" %in% names(col_decimals)) col_decimals <- c(Bound = NA, col_decimals) # Prepare the analysis summary row ---- # get the @@ -564,19 +573,7 @@ summary.gs_design <- function(object, ) } - col_vars <- replace_values( - col_vars, - c("analysis", "bound", "z", "~risk difference at bound", "~hr at bound", "~whr at bound", "nominal p"), - function(x) { - x <- cap_initial(x) - x <- gsub("^~risk ", "~Risk ", x) - x <- gsub("^(~w?)(hr) ", "\\1HR ", x, perl = TRUE) - x - } - ) - names(col_decimals) <- col_vars - - output <- select(output, all_of(col_vars)) + output <- select(output, all_of(names(col_decimals))) # Set the decimals to display ---- round_vars <- c( "Z", "~HR at bound", "~Risk difference at bound", "Nominal p", From 84c46db357174e72af3300945e5456665b9af7c3 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 30 Aug 2024 15:30:44 -0500 Subject: [PATCH 19/43] factor out get_decimals() --- R/summary.R | 50 ++++++++++++++++++++++++++++++-------------------- 1 file changed, 30 insertions(+), 20 deletions(-) diff --git a/R/summary.R b/R/summary.R index 6b8a3b0e..9520f9b7 100644 --- a/R/summary.R +++ b/R/summary.R @@ -302,31 +302,18 @@ summary.gs_design <- function(object, ) # Filter columns and update decimal places - names(default_decimals) <- default_vars - # Merge user-provided named decimals into default - decimals_vars <- names(col_decimals) - default_decimals[decimals_vars] <- col_decimals - - if (is.null(col_vars)) { - if (!is.null(col_decimals) && is.null(decimals_vars)) - stop("'col_decimals' must be a named vector if 'col_vars' is not provided") - col_vars <- default_vars - } - col_decimals <- (if (is.null(decimals_vars)) col_decimals) %||% default_decimals[col_vars] - if (length(col_vars) != length(col_decimals)) - stop("'col_vars' and 'col_decimals' must be of the same length") - - col_vars <- replace_values( - col_vars, - c("analysis", "bound", "z", "~risk difference at bound", "~hr at bound", "~whr at bound", "nominal p"), - function(x) { + col_decimals <- get_decimals(col_vars, col_decimals, default_vars, default_decimals, list( + names = c( + "analysis", "bound", "z", "~risk difference at bound", "~hr at bound", + "~whr at bound", "nominal p" + ), + fun = function(x) { x <- cap_initial(x) x <- gsub("^~risk ", "~Risk ", x) x <- gsub("^(~w?)(hr) ", "\\1HR ", x, perl = TRUE) x } - ) - names(col_decimals) <- col_vars + )) # "bound" is a required column if (!"Bound" %in% names(col_decimals)) col_decimals <- c(Bound = NA, col_decimals) @@ -594,3 +581,26 @@ summary.gs_design <- function(object, return(output) } + +# get a named vector of decimals (names are variable names) +get_decimals <- function(vars, decs, vars_default, decs_default, replace) { + names(decs_default) <- vars_default + # Merge user-provided named decimals into default + decs_vars <- names(decs) + decs_default[decs_vars] <- decs + + vars_name <- as.character(substitute(vars)) + decs_name <- as.character(substitute(decs)) + if (is.null(vars)) { + if (!is.null(decs) && is.null(decs_vars)) + stop("'", decs_name, "' must be a named vector if '", vars_name, "' is not provided") + vars <- vars_default + } + decs <- (if (is.null(decs_vars)) decs) %||% decs_default[vars] + if (length(vars) != length(decs)) + stop("'", vars_name, "' and '", decs_name, "' must be of the same length") + attr(decs, "old_names") <- vars + vars <- replace_values(vars, replace$names, replace$fun) + names(decs) <- vars + decs +} From 08674f999bdf391856f37f9db0434ad7b0f04614 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Fri, 30 Aug 2024 21:09:41 -0500 Subject: [PATCH 20/43] also apply get_decimals() to analysis variables and decimals, and rename columns in `analyses` --- R/summary.R | 110 ++++-------------------- tests/testthat/test-developer-summary.R | 4 +- 2 files changed, 21 insertions(+), 93 deletions(-) diff --git a/R/summary.R b/R/summary.R index 9520f9b7..59865da0 100644 --- a/R/summary.R +++ b/R/summary.R @@ -322,59 +322,24 @@ summary.gs_design <- function(object, # get the # (1) analysis variables to be displayed on the header # (2) decimals to be displayed for the analysis variables in (3) - if (method == "ahr") { - analysis_vars_default <- c("time", "n", "event", "ahr", "info_frac0") - analysis_decimals_default <- c(1, 1, 1, 2, 2) - } - if (method == "wlr") { - analysis_vars_default <- c("time", "n", "event", "ahr", "info_frac") - analysis_decimals_default <- c(1, 1, 1, 2, 2) - } - if (method == "combo") { - analysis_vars_default <- c("time", "n", "event", "ahr", "event_frac") - analysis_decimals_default <- c(1, 1, 1, 2, 2) - } - if (method == "rd") { - analysis_vars_default <- c("n", "rd", "info_frac") - analysis_decimals_default <- c(1, 4, 2) - } + default_vars <- if (method == "rd") c("n", "rd", "info_frac") else c( + "time", "n", "event", "ahr", + switch(method, ahr = "info_frac0", wlr = "info_frac", combo = "event_frac") + ) + default_decimals <- if (method == "rd") c(1, 4, 2) else c(1, 1, 1, 2, 2) # Filter analysis variables and update decimal places - names(analysis_decimals_default) <- analysis_vars_default - if (is.null(analysis_vars) && is.null(analysis_decimals)) { - # Use default values - analysis_vars <- analysis_vars_default - analysis_decimals <- analysis_decimals_default - } else if (!is.null(analysis_vars) && is.null(analysis_decimals)) { - # Only drop/rearrange variables - analysis_decimals <- analysis_decimals_default[ - match(analysis_vars, names(analysis_decimals_default)) - ] - } else if (is.null(analysis_vars) && !is.null(analysis_decimals)) { - # Only update decimals - must be named vector - if (is.null(names(analysis_decimals))) { - stop("summary: analysis_decimals must be a named vector if analysis_vars is not provided") - } - analysis_vars <- analysis_vars_default - analysis_decimals_tmp <- analysis_decimals_default - analysis_decimals_tmp[names(analysis_decimals)] <- analysis_decimals - analysis_decimals <- analysis_decimals_tmp - } else if (!is.null(analysis_vars) && !is.null(analysis_decimals)) { - # Update variables and decimals - if (is.null(names(analysis_decimals))) { - # vectors must be same length if analysis_decimals is unnamed - if (length(analysis_vars) != length(analysis_decimals)) { - stop("summary: please input analysis_vars and analysis_decimals in pairs!") - } - } else { - analysis_decimals_tmp <- analysis_decimals_default - analysis_decimals_tmp[names(analysis_decimals)] <- analysis_decimals - analysis_decimals <- analysis_decimals_tmp - analysis_decimals <- analysis_decimals[ - match(analysis_vars, names(analysis_decimals)) - ] - } - } + old_vars <- c("analysis", "time", "event", "ahr", "n", "info_frac0", "info_frac", "event_frac") + map_vars <- setNames(cap_initial(old_vars), old_vars) # map old to new names + map_vars[c("ahr", "info_frac0", "info_frac", "event_frac")] <- c( + "AHR", "Information fraction", "Information fraction", "Event fraction" + ) + analysis_decimals <- get_decimals( + analysis_vars, analysis_decimals, default_vars, default_decimals, list( + names = old_vars, fun = function(x) map_vars[x] + ) + ) + analysis_vars <- attr(analysis_decimals, "old_names") # (lowercase) old names # set the analysis summary header analyses <- x_analysis %>% @@ -382,46 +347,9 @@ summary.gs_design <- function(object, dplyr::filter(dplyr::row_number() == 1) %>% dplyr::select(all_of(c("analysis", analysis_vars))) %>% dplyr::arrange(analysis) - - if ("analysis" %in% names(analyses)) { - analyses <- analyses %>% dplyr::rename(Analysis = analysis) - } - - if ("time" %in% names(analyses)) { - analyses <- analyses %>% dplyr::rename(Time = time) - analysis_vars <- replace(analysis_vars, analysis_vars == "time", "Time") - } - - if ("event" %in% names(analyses)) { - analyses <- analyses %>% dplyr::rename(Event = event) - analysis_vars <- replace(analysis_vars, analysis_vars == "event", "Event") - } - - if ("ahr" %in% names(analyses)) { - analyses <- analyses %>% dplyr::rename(AHR = ahr) - analysis_vars <- replace(analysis_vars, analysis_vars == "ahr", "AHR") - } - - if ("n" %in% names(analyses)) { - analyses <- analyses %>% dplyr::rename(N = n) - analysis_vars <- replace(analysis_vars, analysis_vars == "n", "N") - } - - if ("info_frac0" %in% names(analyses)) { - analyses <- analyses %>% dplyr::rename(`Information fraction` = info_frac0) - analysis_vars <- replace(analysis_vars, analysis_vars == "info_frac0", "Information fraction") - } - - if ("info_frac" %in% names(analyses)) { - analyses <- analyses %>% dplyr::rename(`Information fraction` = info_frac) - analysis_vars <- replace(analysis_vars, analysis_vars == "info_frac", "Information fraction") - } - - - if ("event_frac" %in% names(analyses)) { - analyses <- analyses %>% dplyr::rename(`Event fraction` = event_frac) - analysis_vars <- replace(analysis_vars, analysis_vars == "event_frac", "Event fraction") - } + # rename to new names + names(analyses) <- replace_values(names(analyses), old_vars, function(x) map_vars[x]) + analysis_vars <- names(analysis_decimals) # update to new names # Merge 2 tables: # 1. Alternate hypothesis table. diff --git a/tests/testthat/test-developer-summary.R b/tests/testthat/test-developer-summary.R index 13d1a250..14f371d0 100644 --- a/tests/testthat/test-developer-summary.R +++ b/tests/testthat/test-developer-summary.R @@ -60,7 +60,7 @@ test_that("summary.gs_design() accepts same-length vectors for analysis_vars and analysis_vars = c("info_frac", "ahr", "event", "n", "time"), analysis_decimals = c(4, 4), ), - "summary: please input analysis_vars and analysis_decimals in pairs!" + "'analysis_vars' and 'analysis_decimals' must be of the same length" ) }) @@ -118,7 +118,7 @@ test_that("summary.gs_design() accepts a named vector for analysis_decimals", { # Throw error is analysis_decimals is unnamed expect_error( summary(x, analysis_decimals = c(4, 4)), - "summary: analysis_decimals must be a named vector if analysis_vars is not provided" + "'analysis_decimals' must be a named vector if 'analysis_vars' is not provided" ) }) From 7401dbe66dd0a0bfeef88f28115540e6033f88c1 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 3 Sep 2024 11:25:31 -0500 Subject: [PATCH 21/43] an alternative way to replace values in a vector --- R/summary.R | 7 +++---- R/utils.R | 13 ++++++++++--- 2 files changed, 13 insertions(+), 7 deletions(-) diff --git a/R/summary.R b/R/summary.R index 59865da0..088b45bb 100644 --- a/R/summary.R +++ b/R/summary.R @@ -335,9 +335,8 @@ summary.gs_design <- function(object, "AHR", "Information fraction", "Information fraction", "Event fraction" ) analysis_decimals <- get_decimals( - analysis_vars, analysis_decimals, default_vars, default_decimals, list( - names = old_vars, fun = function(x) map_vars[x] - ) + analysis_vars, analysis_decimals, default_vars, default_decimals, + list(names = map_vars) ) analysis_vars <- attr(analysis_decimals, "old_names") # (lowercase) old names @@ -348,7 +347,7 @@ summary.gs_design <- function(object, dplyr::select(all_of(c("analysis", analysis_vars))) %>% dplyr::arrange(analysis) # rename to new names - names(analyses) <- replace_values(names(analyses), old_vars, function(x) map_vars[x]) + names(analyses) <- replace_values(names(analyses), map_vars) analysis_vars <- names(analysis_decimals) # update to new names # Merge 2 tables: diff --git a/R/utils.R b/R/utils.R index 8f9c282e..03f89e2c 100644 --- a/R/utils.R +++ b/R/utils.R @@ -22,10 +22,17 @@ cap_initial <- function(x) { sub("^(.)", "\\U\\1", x, perl = TRUE) } -# replace elements with values transformed by new() +# replace elements with values from a named vector `old` (of the form +# `c(old_value = new_value)`); if `old` is unnamed, apply a function new() to +# the old values replace_values <- function(x, old, new = identity) { - i <- x %in% old - x[i] <- new(x[i]) + if (is.null(names(old))) { + i <- x %in% old + x[i] <- new(x[i]) + } else { + i <- x %in% names(old) + x[i] <- old[x[i]] + } x } From 59c939cc911f05e27f3052efa8b88ecb691a98f7 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 3 Sep 2024 11:36:35 -0500 Subject: [PATCH 22/43] a simple helper function rename_to() to rename objects --- R/summary.R | 17 ++++++++--------- R/utils.R | 6 ++++++ 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/R/summary.R b/R/summary.R index 088b45bb..2ced0011 100644 --- a/R/summary.R +++ b/R/summary.R @@ -345,9 +345,8 @@ summary.gs_design <- function(object, dplyr::group_by(analysis) %>% dplyr::filter(dplyr::row_number() == 1) %>% dplyr::select(all_of(c("analysis", analysis_vars))) %>% - dplyr::arrange(analysis) - # rename to new names - names(analyses) <- replace_values(names(analyses), map_vars) + dplyr::arrange(analysis) %>% + rename_to(map_vars) analysis_vars <- names(analysis_decimals) # update to new names # Merge 2 tables: @@ -355,12 +354,12 @@ summary.gs_design <- function(object, # 2. Null hypothesis table. # # Table A: a table under alternative hypothesis. - xy <- x_bound %>% - dplyr::rename("Alternate hypothesis" = probability) %>% - dplyr::rename("Null hypothesis" = probability0) %>% - # change Upper -> bound_names[1], e.g., Efficacy - # change Lower -> bound_names[2], e.g., Futility - dplyr::mutate(bound = dplyr::recode(bound, "upper" = bound_names[1], "lower" = bound_names[2])) + xy <- x_bound %>% rename_to(c( + probability = "Alternate hypothesis", probability0 = "Null hypothesis" + )) + # change Upper -> bound_names[1], e.g., Efficacy + # change Lower -> bound_names[2], e.g., Futility + xy$bound = replace_values(xy$bound, c("upper" = bound_names[1], "lower" = bound_names[2])) if ("probability0" %in% colnames(x_bound)) { xy <- x_bound %>% diff --git a/R/utils.R b/R/utils.R index 03f89e2c..facf3728 100644 --- a/R/utils.R +++ b/R/utils.R @@ -36,6 +36,12 @@ replace_values <- function(x, old, new = identity) { x } +# a shorthand based on replace_values() to rename an object +rename_to <- function(x, ...) { + names(x) <- replace_values(names(x), ...) + x +} + # round only if input is numeric round2 <- function(x, ...) { if (is.numeric(x)) round(x, ...) else x From 2b3de00e724f35cbbc09f931acbb31f3d7628960 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Tue, 3 Sep 2024 11:45:27 -0500 Subject: [PATCH 23/43] the columns have already been renamed before, and bound names have also been updated, so only need to add the `Null hypothesis` column --- R/summary.R | 16 ++-------------- 1 file changed, 2 insertions(+), 14 deletions(-) diff --git a/R/summary.R b/R/summary.R index 2ced0011..ab90f5cb 100644 --- a/R/summary.R +++ b/R/summary.R @@ -361,20 +361,8 @@ summary.gs_design <- function(object, # change Lower -> bound_names[2], e.g., Futility xy$bound = replace_values(xy$bound, c("upper" = bound_names[1], "lower" = bound_names[2])) - if ("probability0" %in% colnames(x_bound)) { - xy <- x_bound %>% - dplyr::rename("Alternate hypothesis" = probability) %>% - dplyr::rename("Null hypothesis" = probability0) - } else { - xy <- x_bound %>% - dplyr::rename("Alternate hypothesis" = probability) %>% - tibble::add_column("Null hypothesis" = "-") - } - # change Upper -> bound_names[1], e.g., Efficacy - # change Lower -> bound_names[2], e.g., Futility - xy <- xy %>% - dplyr::mutate(bound = dplyr::recode(bound, "upper" = bound_names[1], "lower" = bound_names[2])) %>% - dplyr::arrange(analysis, desc(bound)) + if (!"probability0" %in% names(x_bound)) xy$`Null hypothesis` <- "-" + xy <- xy %>% dplyr::arrange(analysis, desc(bound)) # Merge 2 tables: # (1) Analysis summary table From c18b5362582e8538d30edb7fec1d422ee0b454ab Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Wed, 4 Sep 2024 18:28:37 -0500 Subject: [PATCH 24/43] don't round() if digits is not provided --- R/utils.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/utils.R b/R/utils.R index facf3728..52353b26 100644 --- a/R/utils.R +++ b/R/utils.R @@ -42,7 +42,7 @@ rename_to <- function(x, ...) { x } -# round only if input is numeric -round2 <- function(x, ...) { - if (is.numeric(x)) round(x, ...) else x +# round only if input is numeric and digits is provided +round2 <- function(x, digits, ...) { + if (is.numeric(x) && !is.na(digits)) round(x, digits, ...) else x } From a54fcf205bc0db5b24c9783f63686df5f6900022 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Wed, 4 Sep 2024 18:33:54 -0500 Subject: [PATCH 25/43] simplify table_ab() --- R/utility_tidy_tbl.R | 29 +++++++++++------------------ 1 file changed, 11 insertions(+), 18 deletions(-) diff --git a/R/utility_tidy_tbl.R b/R/utility_tidy_tbl.R index 0135ec48..ef20e3cc 100644 --- a/R/utility_tidy_tbl.R +++ b/R/utility_tidy_tbl.R @@ -62,27 +62,20 @@ #' cells_row_groups(groups = 2) #' ) table_ab <- function(table_a, table_b, byvar, decimals = 1, aname = names(table_a)[1]) { - # Convert tibbles to data frames, if needed - if (tibble::is_tibble(table_a)) table_a <- data.frame(table_a, check.names = FALSE) - if (tibble::is_tibble(table_b)) table_b <- data.frame(table_b, check.names = FALSE) + anames <- names(table_a) # Round values in table_a - table_a <- table_a %>% rounddf(digits = decimals) - # Put names from table_a in a data frame - anames <- data.frame(t(paste0(names(table_a), ":"))) - # Bind columns from these 2 data frames together - xx <- cbind(table_a, anames) - # Get order of names to unite table_a columns together with names into a string - col_order <- c(rbind(names(anames), names(table_a))) - # Now unite columns of table_a into a string - astring <- xx %>% tidyr::unite("_alab", all_of(col_order), sep = " ") - # Bind this together with the byvar column - astring <- cbind(table_a %>% select(all_of(byvar)), astring) - # Now merge with table_b - ab <- left_join(astring, table_b, by = byvar) - # Remove column used for grouping + table_a <- rounddf(table_a, decimals) + # Unite table_a's names with values + astring <- apply(as.matrix(table_a), 1, function(row) { + paste(anames, row, sep = ": ", collapse = " ") + }) + table_a <- cbind(table_a[byvar], `_alab` = astring) + # Left-join a with b + ab <- merge(table_a, table_b, by = byvar, all.x = TRUE, suffixes = c(".a", "")) + ab <- ab[, c("_alab", names(table_b)), drop = FALSE] ab[[byvar]] <- NULL # Use the new column name from the argument `aname` - colnames(ab)[grep("_alab", colnames(ab))] <- aname + ab <- rename_to(ab, c(`_alab` = aname)) return(ab) } From d223dc08c8904c2b0c666031bea471456e25627c Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Wed, 4 Sep 2024 18:48:54 -0500 Subject: [PATCH 26/43] rewrite round_df() --- R/utility_tidy_tbl.R | 21 +++++++------------ tests/testthat/test-independent-utility_tbl.R | 6 +++--- 2 files changed, 10 insertions(+), 17 deletions(-) diff --git a/R/utility_tidy_tbl.R b/R/utility_tidy_tbl.R index ef20e3cc..f447d84d 100644 --- a/R/utility_tidy_tbl.R +++ b/R/utility_tidy_tbl.R @@ -64,7 +64,7 @@ table_ab <- function(table_a, table_b, byvar, decimals = 1, aname = names(table_a)[1]) { anames <- names(table_a) # Round values in table_a - table_a <- rounddf(table_a, decimals) + table_a <- round_df(table_a, decimals) # Unite table_a's names with values astring <- apply(as.matrix(table_a), 1, function(row) { paste(anames, row, sep = ": ", collapse = " ") @@ -79,19 +79,12 @@ table_ab <- function(table_a, table_b, byvar, decimals = 1, aname = names(table_ return(ab) } -#' From https://github.com/sashahafner/jumbled/blob/master/rounddf.R -#' @noRd -rounddf <- function(x, digits = rep(2, ncol(x)), func = round) { - if (length(digits) == 1) { - digits <- rep(digits, ncol(x)) - } else if (length(digits) != ncol(x)) { - digits <- c(digits, rep(digits[1], ncol(x) - length(digits))) - warning("First value in digits repeated to match length.") - } - - for (i in seq_len(ncol(x))) { - if (class(x[, i, drop = TRUE])[1] == "numeric") x[, i] <- func(x[, i], digits[i]) +round_df <- function(x, digits = 2) { + n1 <- ncol(x); n2 <- length(digits) + if (n2 != 1 && n2 != n1) { + warning("'digits' is recycled to the length of ncol(x)") } - + digits <- rep(digits, length.out = n1) + for (i in seq_len(n1)) x[, i] <- round2(x[, i, drop = TRUE], digits[i]) return(x) } diff --git a/tests/testthat/test-independent-utility_tbl.R b/tests/testthat/test-independent-utility_tbl.R index a1fbe6f9..5465c6d8 100644 --- a/tests/testthat/test-independent-utility_tbl.R +++ b/tests/testthat/test-independent-utility_tbl.R @@ -1,14 +1,14 @@ -test_that("test rounddf", { +test_that("test round_df", { x2 <- rnorm(3) x3 <- rnorm(3) tbl <- tibble::tibble(x1 = c("a", "b", "c"), x2 = x2, x3 = x3) - tbl_new <- rounddf(tbl, digits = 2) + tbl_new <- round_df(tbl, digits = 2) expect_equal(tbl_new$x1, tbl$x1) expect_equal(tbl_new$x2, round(x2, 2)) expect_equal(tbl_new$x3, round(x3, 2)) - tbl_new <- rounddf(tbl, digits = c(1, 1, 2)) + tbl_new <- round_df(tbl, digits = c(1, 1, 2)) expect_equal(tbl_new$x1, tbl$x1) expect_equal(tbl_new$x2, round(x2, 1)) expect_equal(tbl_new$x3, round(x3, 2)) From 004af38232a655d296d5a5fc6f76cc6a85880b60 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Wed, 4 Sep 2024 18:52:00 -0500 Subject: [PATCH 27/43] factor out huge amount of code for renaming, and I'm too tired to explain it... --- R/summary.R | 186 ++++++--------------- tests/testthat/_snaps/independent_as_gt.md | 56 +++---- 2 files changed, 81 insertions(+), 161 deletions(-) diff --git a/R/summary.R b/R/summary.R index ab90f5cb..3d1bf543 100644 --- a/R/summary.R +++ b/R/summary.R @@ -288,35 +288,9 @@ summary.gs_design <- function(object, bound_names = c("Efficacy", "Futility"), ...) { x <- object - method <- get_method(x, c("ahr", "wlr", "combo", "rd")) x_bound <- x$bound x_analysis <- x$analysis - n_analysis <- max(x_analysis$analysis) - - # Prepare the columns decimals ---- - default_decimals <- c(NA, NA, 2, if (method != "combo") 4, 4, 4, 4) - default_vars <- c( - "analysis", "bound", "z", - sprintf("~%s at bound", switch(method, ahr = "hr", wlr = "whr", rd = "risk difference")), - "nominal p", "Alternate hypothesis", "Null hypothesis" - ) - - # Filter columns and update decimal places - col_decimals <- get_decimals(col_vars, col_decimals, default_vars, default_decimals, list( - names = c( - "analysis", "bound", "z", "~risk difference at bound", "~hr at bound", - "~whr at bound", "nominal p" - ), - fun = function(x) { - x <- cap_initial(x) - x <- gsub("^~risk ", "~Risk ", x) - x <- gsub("^(~w?)(hr) ", "\\1HR ", x, perl = TRUE) - x - } - )) - - # "bound" is a required column - if (!"Bound" %in% names(col_decimals)) col_decimals <- c(Bound = NA, col_decimals) + method <- get_method(x, c("ahr", "wlr", "combo", "rd")) # Prepare the analysis summary row ---- # get the @@ -329,25 +303,17 @@ summary.gs_design <- function(object, default_decimals <- if (method == "rd") c(1, 4, 2) else c(1, 1, 1, 2, 2) # Filter analysis variables and update decimal places - old_vars <- c("analysis", "time", "event", "ahr", "n", "info_frac0", "info_frac", "event_frac") - map_vars <- setNames(cap_initial(old_vars), old_vars) # map old to new names - map_vars[c("ahr", "info_frac0", "info_frac", "event_frac")] <- c( - "AHR", "Information fraction", "Information fraction", "Event fraction" - ) analysis_decimals <- get_decimals( - analysis_vars, analysis_decimals, default_vars, default_decimals, - list(names = map_vars) + analysis_vars, analysis_decimals, default_vars, default_decimals ) - analysis_vars <- attr(analysis_decimals, "old_names") # (lowercase) old names + analysis_vars <- names(analysis_decimals) # set the analysis summary header analyses <- x_analysis %>% dplyr::group_by(analysis) %>% dplyr::filter(dplyr::row_number() == 1) %>% dplyr::select(all_of(c("analysis", analysis_vars))) %>% - dplyr::arrange(analysis) %>% - rename_to(map_vars) - analysis_vars <- names(analysis_decimals) # update to new names + dplyr::arrange(analysis) # Merge 2 tables: # 1. Alternate hypothesis table. @@ -366,121 +332,77 @@ summary.gs_design <- function(object, # Merge 2 tables: # (1) Analysis summary table - # (2) xy: bound_summary_detail table + # (2) xy: bound_details table # # Merge 3 tables: 1 line per analysis, alternate hypothesis table, null hypothesis table - # - # If the method is AHR - if (method == "ahr") { - # Header - analysis_summary_header <- analyses %>% dplyr::select(all_of(c("Analysis", analysis_vars))) - # Bound details - bound_summary_detail <- xy - } - # If the method is WLR, change AHR to wAHR + # Header + analysis_header <- analyses + # Bound details + bound_details <- xy + + # If the method is WLR, change HR to wHR if (method == "wlr") { - # Header - analysis_summary_header <- analyses %>% dplyr::select(all_of(c("Analysis", analysis_vars))) - if ("ahr" %in% analysis_vars) { - analysis_summary_header <- analysis_summary_header %>% dplyr::rename(wahr = ahr) - } - # Bound details - if ("~hr at bound" %in% names(xy)) { - bound_summary_detail <- xy %>% dplyr::rename("~whr at bound" = "~hr at bound") - } else { - bound_summary_detail <- xy - } + bound_details <- rename_to(xy, c("~hr at bound" = "~whr at bound")) } # If the method is COMBO, remove the column of "~HR at bound", and remove AHR from header - if (method == "combo") { - # Header - analysis_summary_header <- analyses %>% dplyr::select(all_of(c("Analysis", analysis_vars))) - # Bound details - if ("~hr at bound" %in% names(xy)) { - stop("summary: ~hr at bound can't be display!") - } else { - bound_summary_detail <- xy - } - } + if (method == "combo" && "~hr at bound" %in% names(xy)) + stop("'~hr at bound' can't be displayed!") - # If the method is RD - if (method == "rd") { - # Header - analysis_summary_header <- analyses %>% - dplyr::select(all_of(c("Analysis", analysis_vars))) %>% - dplyr::rename("Risk difference" = rd) - # Bound details - bound_summary_detail <- xy - } + old_vars <- c( + "analysis", "time", "event", "ahr", "rd", "n", "info_frac0", "info_frac", "event_frac" + ) + map_vars <- setNames(cap_initial(old_vars), old_vars) # map old to new names + map_vars[c("ahr", "rd", "info_frac0", "info_frac", "event_frac")] <- c( + "AHR", "Risk difference", "Information fraction", "Information fraction", "Event fraction" + ) + analysis_header <- rename_to(analysis_header, map_vars) - if ("analysis" %in% colnames(bound_summary_detail)) { - bound_summary_detail <- bound_summary_detail %>% dplyr::rename(Analysis = analysis) - } - if ("bound" %in% colnames(bound_summary_detail)) { - bound_summary_detail <- bound_summary_detail %>% dplyr::rename(Bound = bound) - } - if ("z" %in% colnames(bound_summary_detail)) { - bound_summary_detail <- bound_summary_detail %>% dplyr::rename(Z = z) - } - if ("nominal p" %in% colnames(bound_summary_detail)) { - bound_summary_detail <- bound_summary_detail %>% dplyr::rename("Nominal p" = "nominal p") - } - if ("~hr at bound" %in% colnames(bound_summary_detail)) { - bound_summary_detail <- bound_summary_detail %>% dplyr::rename("~HR at bound" = "~hr at bound") - } - if ("~whr at bound" %in% colnames(bound_summary_detail)) { - bound_summary_detail <- bound_summary_detail %>% dplyr::rename("~wHR at bound" = "~whr at bound") - } - if ("~risk difference at bound" %in% colnames(bound_summary_detail)) { - bound_summary_detail <- bound_summary_detail %>% - dplyr::rename("~Risk difference at bound" = "~risk difference at bound") - } + old_vars <- c( + "analysis", "bound", "z", "~risk difference at bound", "~hr at bound", + "~whr at bound", "nominal p" + ) + map_vars <- setNames(cap_initial(old_vars), old_vars) # map old to new names + map_vars <- gsub("^~risk ", "~Risk ", map_vars) + map_vars <- gsub("^(~w?)(hr) ", "\\1HR ", map_vars, perl = TRUE) + bound_details <- rename_to(bound_details, map_vars) output <- table_ab( # A data frame to be show as the summary header # It has only ONE record for each value of `byvar` - table_a = analysis_summary_header, + table_a = analysis_header, # A data frame to be shown as the listing details # It has >= 1 records for each value of `byvar` - table_b = bound_summary_detail, + table_b = bound_details, decimals = c(0, analysis_decimals), byvar = "Analysis" ) %>% dplyr::group_by(Analysis) + # Prepare the columns decimals ---- + default_decimals <- c(NA, NA, 2, if (method != "combo") 4, 4, 4, 4) + default_vars <- c( + "analysis", "bound", "z", + sprintf("~%s at bound", switch(method, ahr = "hr", wlr = "whr", rd = "risk difference")), + "nominal p", "Alternate hypothesis", "Null hypothesis" + ) - if (method == "ahr") { - output <- output %>% select( - Analysis, Bound, Z, - `~HR at bound`, `Nominal p`, `Alternate hypothesis`, `Null hypothesis` - ) - } else if (method == "wlr") { - output <- output %>% select( - Analysis, Bound, Z, - `~wHR at bound`, `Nominal p`, `Alternate hypothesis`, `Null hypothesis` - ) - } else if (method == "combo") { - output <- output %>% select( - Analysis, Bound, Z, - `Nominal p`, `Alternate hypothesis`, `Null hypothesis` - ) - } else if (method == "rd") { - output <- output %>% select( - Analysis, Bound, Z, - `~Risk difference at bound`, `Nominal p`, - `Alternate hypothesis`, `Null hypothesis` - ) - } + # Filter columns and update decimal places + col_decimals <- get_decimals(col_vars, col_decimals, default_vars, default_decimals) + + # "bound" is a required column + if (!"bound" %in% names(col_decimals)) col_decimals <- c(bound = NA, col_decimals) + + map_vars <- setNames(cap_initial(default_vars), default_vars) + map_vars <- gsub("^~risk ", "~Risk ", map_vars) + map_vars <- gsub("^(~w?)(hr) ", "\\1HR ", map_vars, perl = TRUE) + col_vars <- replace_values(names(col_decimals), map_vars) + names(col_decimals) <- col_vars - output <- select(output, all_of(names(col_decimals))) + output <- select(output, all_of(col_vars)) # Set the decimals to display ---- - round_vars <- c( - "Z", "~HR at bound", "~Risk difference at bound", "Nominal p", - "Alternate hypothesis", "Null hypothesis" - ) - for (j in round_vars) output[[j]] <- round2(output[[j]], col_decimals[j]) + for (j in col_vars) output[[j]] <- round2(output[[j]], col_decimals[j]) output <- add_class( output, method, intersect("non_binding", class(object)), method, "gs_design" @@ -497,7 +419,7 @@ summary.gs_design <- function(object, } # get a named vector of decimals (names are variable names) -get_decimals <- function(vars, decs, vars_default, decs_default, replace) { +get_decimals <- function(vars, decs, vars_default, decs_default) { names(decs_default) <- vars_default # Merge user-provided named decimals into default decs_vars <- names(decs) @@ -513,8 +435,6 @@ get_decimals <- function(vars, decs, vars_default, decs_default, replace) { decs <- (if (is.null(decs_vars)) decs) %||% decs_default[vars] if (length(vars) != length(decs)) stop("'", vars_name, "' and '", decs_name, "' must be of the same length") - attr(decs, "old_names") <- vars - vars <- replace_values(vars, replace$names, replace$fun) names(decs) <- vars decs } diff --git a/tests/testthat/_snaps/independent_as_gt.md b/tests/testthat/_snaps/independent_as_gt.md index 1ee9b113..7b9ce7be 100644 --- a/tests/testthat/_snaps/independent_as_gt.md +++ b/tests/testthat/_snaps/independent_as_gt.md @@ -138,7 +138,7 @@ \midrule\addlinespace[2.5pt] \multicolumn{6}{l}{Analysis: 1 Time: 36 N: 471.1 Event: 289 AHR: 0.68 Information fraction: 1\textsuperscript{\textit{3}}} \\[2.5pt] \midrule\addlinespace[2.5pt] - Efficacy & 1.96 & 0.025 & 0.7940584 & 0.9 & 0.025 \\ + Efficacy & 1.96 & 0.025 & 0.7941 & 0.9 & 0.025 \\ \bottomrule \end{longtable} \begin{minipage}{\linewidth} @@ -165,18 +165,18 @@ \midrule\addlinespace[2.5pt] \multicolumn{6}{l}{Analysis: 1 Time: 14.9 N: 108 Event: 30 AHR: 0.79 Information fraction: 0.6\textsuperscript{\textit{4}}} \\[2.5pt] \midrule\addlinespace[2.5pt] - Futility & -1.17 & 0.8798 & 1.5352803 & 0.0341 & 0.1202 \\ - Efficacy & 2.68 & 0.0037 & 0.3765151 & 0.0217 & 0.0037 \\ + Futility & -1.17 & 0.8798 & 1.5353 & 0.0341 & 0.1202 \\ + Efficacy & 2.68 & 0.0037 & 0.3765 & 0.0217 & 0.0037 \\ \midrule\addlinespace[2.5pt] \multicolumn{6}{l}{Analysis: 2 Time: 19.2 N: 108 Event: 40 AHR: 0.75 Information fraction: 0.8\textsuperscript{\textit{4}}} \\[2.5pt] \midrule\addlinespace[2.5pt] - Futility & -0.66 & 0.7452 & 1.2318826 & 0.0664 & 0.2664 \\ - Efficacy & 2.29 & 0.0110 & 0.4846213 & 0.0886 & 0.0121 \\ + Futility & -0.66 & 0.7452 & 1.2319 & 0.0664 & 0.2664 \\ + Efficacy & 2.29 & 0.0110 & 0.4846 & 0.0886 & 0.0121 \\ \midrule\addlinespace[2.5pt] \multicolumn{6}{l}{Analysis: 3 Time: 24.5 N: 108 Event: 50 AHR: 0.71 Information fraction: 1\textsuperscript{\textit{4}}} \\[2.5pt] \midrule\addlinespace[2.5pt] - Futility & -0.22 & 0.5881 & 1.0650300 & 0.1002 & 0.4319 \\ - Efficacy & 2.03 & 0.0212 & 0.5631414 & 0.2071 & 0.0250 \\ + Futility & -0.22 & 0.5881 & 1.0650 & 0.1002 & 0.4319 \\ + Efficacy & 2.03 & 0.0212 & 0.5631 & 0.2071 & 0.0250 \\ \bottomrule \end{longtable} \begin{minipage}{\linewidth} @@ -301,18 +301,18 @@ \midrule\addlinespace[2.5pt] \multicolumn{6}{l}{Analysis: 1 Time: 14.9 N: 108 Event: 30 AHR: 0.79 Information fraction: 0.6\textsuperscript{\textit{3}}} \\[2.5pt] \midrule\addlinespace[2.5pt] - Futility & -1.17 & 0.8798 & 1.5352803 & 0.0341 & 0.1202 \\ - Efficacy & 2.68 & 0.0037 & 0.3765151 & 0.0217 & 0.0037 \\ + Futility & -1.17 & 0.8798 & 1.5353 & 0.0341 & 0.1202 \\ + Efficacy & 2.68 & 0.0037 & 0.3765 & 0.0217 & 0.0037 \\ \midrule\addlinespace[2.5pt] \multicolumn{6}{l}{Analysis: 2 Time: 19.2 N: 108 Event: 40 AHR: 0.75 Information fraction: 0.8\textsuperscript{\textit{3}}} \\[2.5pt] \midrule\addlinespace[2.5pt] - Futility & -0.66 & 0.7452 & 1.2318826 & 0.0664 & 0.2664 \\ - Efficacy & 2.29 & 0.0110 & 0.4846213 & 0.0886 & 0.0121 \\ + Futility & -0.66 & 0.7452 & 1.2319 & 0.0664 & 0.2664 \\ + Efficacy & 2.29 & 0.0110 & 0.4846 & 0.0886 & 0.0121 \\ \midrule\addlinespace[2.5pt] \multicolumn{6}{l}{Analysis: 3 Time: 24.5 N: 108 Event: 50 AHR: 0.71 Information fraction: 1\textsuperscript{\textit{3}}} \\[2.5pt] \midrule\addlinespace[2.5pt] - Futility & -0.22 & 0.5881 & 1.0650300 & 0.1002 & 0.4319 \\ - Efficacy & 2.03 & 0.0212 & 0.5631414 & 0.2071 & 0.0250 \\ + Futility & -0.22 & 0.5881 & 1.0650 & 0.1002 & 0.4319 \\ + Efficacy & 2.03 & 0.0212 & 0.5631 & 0.2071 & 0.0250 \\ \bottomrule \end{longtable} \begin{minipage}{\linewidth} @@ -339,18 +339,18 @@ \midrule\addlinespace[2.5pt] \multicolumn{6}{l}{Analysis: 1 Time: 14.9 N: 108 Event: 30 AHR: 0.79 Information fraction: 0.6\textsuperscript{\textit{3}}} \\[2.5pt] \midrule\addlinespace[2.5pt] - Futility & -1.17 & 0.8798 & 1.5352803 & 0.0341 & 0.1202 \\ - Efficacy & 2.68 & 0.0037 & 0.3765151 & 0.0217 & 0.0037 \\ + Futility & -1.17 & 0.8798 & 1.5353 & 0.0341 & 0.1202 \\ + Efficacy & 2.68 & 0.0037 & 0.3765 & 0.0217 & 0.0037 \\ \midrule\addlinespace[2.5pt] \multicolumn{6}{l}{Analysis: 2 Time: 19.2 N: 108 Event: 40 AHR: 0.75 Information fraction: 0.8\textsuperscript{\textit{3}}} \\[2.5pt] \midrule\addlinespace[2.5pt] - Futility & -0.66 & 0.7452 & 1.2318826 & 0.0664 & 0.2664 \\ - Efficacy & 2.29 & 0.0110 & 0.4846213 & 0.0886 & 0.0121 \\ + Futility & -0.66 & 0.7452 & 1.2319 & 0.0664 & 0.2664 \\ + Efficacy & 2.29 & 0.0110 & 0.4846 & 0.0886 & 0.0121 \\ \midrule\addlinespace[2.5pt] \multicolumn{6}{l}{Analysis: 3 Time: 24.5 N: 108 Event: 50 AHR: 0.71 Information fraction: 1\textsuperscript{\textit{3}}} \\[2.5pt] \midrule\addlinespace[2.5pt] - Futility & -0.22 & 0.5881 & 1.0650300 & 0.1002 & 0.4319 \\ - Efficacy & 2.03 & 0.0212 & 0.5631414 & 0.2071 & 0.0250\textsuperscript{\textit{4}} \\ + Futility & -0.22 & 0.5881 & 1.0650 & 0.1002 & 0.4319 \\ + Efficacy & 2.03 & 0.0212 & 0.5631 & 0.2071 & 0.0250\textsuperscript{\textit{4}} \\ \bottomrule \end{longtable} \begin{minipage}{\linewidth} @@ -378,18 +378,18 @@ \midrule\addlinespace[2.5pt] \multicolumn{6}{l}{Analysis: 1 Time: 14.9 N: 108 Event: 30 AHR: 0.79 Information fraction: 0.6\textsuperscript{\textit{4}}} \\[2.5pt] \midrule\addlinespace[2.5pt] - Futility & -1.17 & 0.8798 & 1.5352803 & 0.0341 & 0.1202 \\ - Efficacy & 2.68 & 0.0037 & 0.3765151 & 0.0217 & 0.0037 \\ + Futility & -1.17 & 0.8798 & 1.5353 & 0.0341 & 0.1202 \\ + Efficacy & 2.68 & 0.0037 & 0.3765 & 0.0217 & 0.0037 \\ \midrule\addlinespace[2.5pt] \multicolumn{6}{l}{Analysis: 2 Time: 19.2 N: 108 Event: 40 AHR: 0.75 Information fraction: 0.8\textsuperscript{\textit{4}}} \\[2.5pt] \midrule\addlinespace[2.5pt] - Futility & -0.66 & 0.7452 & 1.2318826 & 0.0664 & 0.2664 \\ - Efficacy & 2.29 & 0.0110 & 0.4846213 & 0.0886 & 0.0121 \\ + Futility & -0.66 & 0.7452 & 1.2319 & 0.0664 & 0.2664 \\ + Efficacy & 2.29 & 0.0110 & 0.4846 & 0.0886 & 0.0121 \\ \midrule\addlinespace[2.5pt] \multicolumn{6}{l}{Analysis: 3 Time: 24.5 N: 108 Event: 50 AHR: 0.71 Information fraction: 1\textsuperscript{\textit{4}}} \\[2.5pt] \midrule\addlinespace[2.5pt] - Futility & -0.22 & 0.5881 & 1.0650300 & 0.1002 & 0.4319 \\ - Efficacy & 2.03 & 0.0212 & 0.5631414 & 0.2071 & 0.0250 \\ + Futility & -0.22 & 0.5881 & 1.0650 & 0.1002 & 0.4319 \\ + Efficacy & 2.03 & 0.0212 & 0.5631 & 0.2071 & 0.0250 \\ \bottomrule \end{longtable} \begin{minipage}{\linewidth} @@ -417,15 +417,15 @@ \midrule\addlinespace[2.5pt] \multicolumn{6}{l}{Analysis: 1 Time: 14.9 N: 108 Event: 30 AHR: 0.79 Information fraction: 0.6\textsuperscript{\textit{3}}} \\[2.5pt] \midrule\addlinespace[2.5pt] - Efficacy & 2.68 & 0.0037 & 0.3765151 & 0.0217 & 0.0037 \\ + Efficacy & 2.68 & 0.0037 & 0.3765 & 0.0217 & 0.0037 \\ \midrule\addlinespace[2.5pt] \multicolumn{6}{l}{Analysis: 2 Time: 19.2 N: 108 Event: 40 AHR: 0.75 Information fraction: 0.8\textsuperscript{\textit{3}}} \\[2.5pt] \midrule\addlinespace[2.5pt] - Efficacy & 2.29 & 0.0110 & 0.4846213 & 0.0886 & 0.0121 \\ + Efficacy & 2.29 & 0.0110 & 0.4846 & 0.0886 & 0.0121 \\ \midrule\addlinespace[2.5pt] \multicolumn{6}{l}{Analysis: 3 Time: 24.5 N: 108 Event: 50 AHR: 0.71 Information fraction: 1\textsuperscript{\textit{3}}} \\[2.5pt] \midrule\addlinespace[2.5pt] - Efficacy & 2.03 & 0.0212 & 0.5631414 & 0.2071 & 0.0250 \\ + Efficacy & 2.03 & 0.0212 & 0.5631 & 0.2071 & 0.0250 \\ \bottomrule \end{longtable} \begin{minipage}{\linewidth} From 2c704362fd4da4beff27c11bb0cbc0f20acc459c Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Wed, 4 Sep 2024 21:54:04 -0500 Subject: [PATCH 28/43] factor out x$design_par --- R/summary.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/R/summary.R b/R/summary.R index 3d1bf543..82462a9c 100644 --- a/R/summary.R +++ b/R/summary.R @@ -79,22 +79,22 @@ #' summary.fixed_design <- function(object, ...) { x <- object + p <- x$design_par ans <- x$analysis ans$design <- switch( x$design, ahr = "Average hazard ratio", lf = "Lachin and Foulkes", rd = "Risk difference", - milestone = paste0("Milestone: tau = ", x$design_par$tau), - rmst = paste0("RMST: tau = ", x$design_par$tau), - mb = paste0("Modestly weighted LR: tau = ", x$design_par$tau), + milestone = paste0("Milestone: tau = ", p$tau), + rmst = paste0("RMST: tau = ", p$tau), + mb = paste0("Modestly weighted LR: tau = ", p$tau), fh = paste0( - "Fleming-Harrington FH(", x$design_par$rho, ", ", x$design_par$gamma, ")", - if (x$design_par$rho == 0 && x$design_par$gamma == 0) " (logrank)" + "Fleming-Harrington FH(", p$rho, ", ", p$gamma, ")", + if (p$rho == 0 && p$gamma == 0) " (logrank)" ), maxcombo = gsub("FH(0, 0)", "logrank", paste( - "MaxCombo:", - paste0("FHC(", x$design_par[[1]], ", ", x$design_par[[2]], ")", collapse = ", ") + "MaxCombo:", paste0("FHC(", p[[1]], ", ", p[[2]], ")", collapse = ", ") ), fixed = TRUE) ) From 0a69d8b40e0571686b85e5b2176283ad261b821b Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Wed, 4 Sep 2024 21:56:12 -0500 Subject: [PATCH 29/43] use the rename function --- R/summary.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/summary.R b/R/summary.R index 82462a9c..e009b0b6 100644 --- a/R/summary.R +++ b/R/summary.R @@ -98,8 +98,8 @@ summary.fixed_design <- function(object, ...) { ), fixed = TRUE) ) - names(ans) <- replace_values( - names(ans), c("design", "n", "event", "time", "bound", "power"), function(x) { + ans <- rename_to( + ans, c("design", "n", "event", "time", "bound", "power"), function(x) { # capitalize words with special case of Event -> Events ifelse(x == "event", "Events", cap_initial(x)) } From b7c5c876691dbe1cab7fe7bf7a84d62c0301ed87 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Wed, 4 Sep 2024 22:02:15 -0500 Subject: [PATCH 30/43] rename_to -> replace_names --- R/summary.R | 10 +++++----- R/utility_tidy_tbl.R | 2 +- R/utils.R | 2 +- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/R/summary.R b/R/summary.R index e009b0b6..fcd26d80 100644 --- a/R/summary.R +++ b/R/summary.R @@ -98,7 +98,7 @@ summary.fixed_design <- function(object, ...) { ), fixed = TRUE) ) - ans <- rename_to( + ans <- replace_names( ans, c("design", "n", "event", "time", "bound", "power"), function(x) { # capitalize words with special case of Event -> Events ifelse(x == "event", "Events", cap_initial(x)) @@ -320,7 +320,7 @@ summary.gs_design <- function(object, # 2. Null hypothesis table. # # Table A: a table under alternative hypothesis. - xy <- x_bound %>% rename_to(c( + xy <- x_bound %>% replace_names(c( probability = "Alternate hypothesis", probability0 = "Null hypothesis" )) # change Upper -> bound_names[1], e.g., Efficacy @@ -343,7 +343,7 @@ summary.gs_design <- function(object, # If the method is WLR, change HR to wHR if (method == "wlr") { - bound_details <- rename_to(xy, c("~hr at bound" = "~whr at bound")) + bound_details <- replace_names(xy, c("~hr at bound" = "~whr at bound")) } # If the method is COMBO, remove the column of "~HR at bound", and remove AHR from header @@ -357,7 +357,7 @@ summary.gs_design <- function(object, map_vars[c("ahr", "rd", "info_frac0", "info_frac", "event_frac")] <- c( "AHR", "Risk difference", "Information fraction", "Information fraction", "Event fraction" ) - analysis_header <- rename_to(analysis_header, map_vars) + analysis_header <- replace_names(analysis_header, map_vars) old_vars <- c( "analysis", "bound", "z", "~risk difference at bound", "~hr at bound", @@ -366,7 +366,7 @@ summary.gs_design <- function(object, map_vars <- setNames(cap_initial(old_vars), old_vars) # map old to new names map_vars <- gsub("^~risk ", "~Risk ", map_vars) map_vars <- gsub("^(~w?)(hr) ", "\\1HR ", map_vars, perl = TRUE) - bound_details <- rename_to(bound_details, map_vars) + bound_details <- replace_names(bound_details, map_vars) output <- table_ab( # A data frame to be show as the summary header diff --git a/R/utility_tidy_tbl.R b/R/utility_tidy_tbl.R index f447d84d..fcc035cf 100644 --- a/R/utility_tidy_tbl.R +++ b/R/utility_tidy_tbl.R @@ -75,7 +75,7 @@ table_ab <- function(table_a, table_b, byvar, decimals = 1, aname = names(table_ ab <- ab[, c("_alab", names(table_b)), drop = FALSE] ab[[byvar]] <- NULL # Use the new column name from the argument `aname` - ab <- rename_to(ab, c(`_alab` = aname)) + ab <- replace_names(ab, c(`_alab` = aname)) return(ab) } diff --git a/R/utils.R b/R/utils.R index 52353b26..cc4ce3bf 100644 --- a/R/utils.R +++ b/R/utils.R @@ -37,7 +37,7 @@ replace_values <- function(x, old, new = identity) { } # a shorthand based on replace_values() to rename an object -rename_to <- function(x, ...) { +replace_names <- function(x, ...) { names(x) <- replace_values(names(x), ...) x } From d00be63b69c815237f9b079f4bbb4a884d7c763f Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Wed, 4 Sep 2024 22:08:50 -0500 Subject: [PATCH 31/43] get rid of the `dplyr::` qualifiers --- NAMESPACE | 1 + R/summary.R | 17 ++++++++--------- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index f1252662..31c90cae 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -75,6 +75,7 @@ importFrom(dplyr,left_join) importFrom(dplyr,mutate) importFrom(dplyr,one_of) importFrom(dplyr,rename) +importFrom(dplyr,row_number) importFrom(dplyr,select) importFrom(dplyr,summarize) importFrom(dplyr,ungroup) diff --git a/R/summary.R b/R/summary.R index fcd26d80..56fa1ad5 100644 --- a/R/summary.R +++ b/R/summary.R @@ -124,7 +124,7 @@ summary.fixed_design <- function(object, ...) { #' columns you want to be displayed differently than the defaults. #' @param bound_names Names for bounds; default is `c("Efficacy", "Futility")`. #' -#' @importFrom dplyr all_of +#' @importFrom dplyr all_of row_number #' #' @export #' @@ -310,10 +310,10 @@ summary.gs_design <- function(object, # set the analysis summary header analyses <- x_analysis %>% - dplyr::group_by(analysis) %>% - dplyr::filter(dplyr::row_number() == 1) %>% - dplyr::select(all_of(c("analysis", analysis_vars))) %>% - dplyr::arrange(analysis) + group_by(analysis) %>% + filter(row_number() == 1) %>% + select(all_of(c("analysis", analysis_vars))) %>% + arrange(analysis) # Merge 2 tables: # 1. Alternate hypothesis table. @@ -328,7 +328,7 @@ summary.gs_design <- function(object, xy$bound = replace_values(xy$bound, c("upper" = bound_names[1], "lower" = bound_names[2])) if (!"probability0" %in% names(x_bound)) xy$`Null hypothesis` <- "-" - xy <- xy %>% dplyr::arrange(analysis, desc(bound)) + xy <- xy %>% arrange(analysis, desc(bound)) # Merge 2 tables: # (1) Analysis summary table @@ -377,8 +377,7 @@ summary.gs_design <- function(object, table_b = bound_details, decimals = c(0, analysis_decimals), byvar = "Analysis" - ) %>% - dplyr::group_by(Analysis) + ) # Prepare the columns decimals ---- default_decimals <- c(NA, NA, 2, if (method != "combo") 4, 4, 4, 4) @@ -400,7 +399,7 @@ summary.gs_design <- function(object, col_vars <- replace_values(names(col_decimals), map_vars) names(col_decimals) <- col_vars - output <- select(output, all_of(col_vars)) + output <- output %>% group_by(Analysis) %>% select(all_of(col_vars)) # Set the decimals to display ---- for (j in col_vars) output[[j]] <- round2(output[[j]], col_decimals[j]) From 3c505d99b72e5d3ca6bd1f0f437c49e2a180812d Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Wed, 4 Sep 2024 22:19:58 -0500 Subject: [PATCH 32/43] cosmetic --- R/summary.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/summary.R b/R/summary.R index 56fa1ad5..babc738a 100644 --- a/R/summary.R +++ b/R/summary.R @@ -320,12 +320,12 @@ summary.gs_design <- function(object, # 2. Null hypothesis table. # # Table A: a table under alternative hypothesis. - xy <- x_bound %>% replace_names(c( + xy <- replace_names(x_bound, c( probability = "Alternate hypothesis", probability0 = "Null hypothesis" )) # change Upper -> bound_names[1], e.g., Efficacy # change Lower -> bound_names[2], e.g., Futility - xy$bound = replace_values(xy$bound, c("upper" = bound_names[1], "lower" = bound_names[2])) + xy$bound = replace_values(xy$bound, c(upper = bound_names[1], lower = bound_names[2])) if (!"probability0" %in% names(x_bound)) xy$`Null hypothesis` <- "-" xy <- xy %>% arrange(analysis, desc(bound)) From c7ab5bead2336c8784d2410b86d858ebbbc53c94 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Wed, 4 Sep 2024 22:23:43 -0500 Subject: [PATCH 33/43] I think group_by() has sorted the data implicitly, so no need to arrange() again --- R/summary.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/summary.R b/R/summary.R index babc738a..102dc6d1 100644 --- a/R/summary.R +++ b/R/summary.R @@ -312,8 +312,7 @@ summary.gs_design <- function(object, analyses <- x_analysis %>% group_by(analysis) %>% filter(row_number() == 1) %>% - select(all_of(c("analysis", analysis_vars))) %>% - arrange(analysis) + select(all_of(c("analysis", analysis_vars))) # Merge 2 tables: # 1. Alternate hypothesis table. From 9cde29a819c92d3f38623c0f3fc01493f0ad2c57 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Wed, 4 Sep 2024 22:47:34 -0500 Subject: [PATCH 34/43] one assignment --- R/summary.R | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/R/summary.R b/R/summary.R index 102dc6d1..07ee53a4 100644 --- a/R/summary.R +++ b/R/summary.R @@ -338,12 +338,10 @@ summary.gs_design <- function(object, # Header analysis_header <- analyses # Bound details - bound_details <- xy - - # If the method is WLR, change HR to wHR - if (method == "wlr") { - bound_details <- replace_names(xy, c("~hr at bound" = "~whr at bound")) - } + bound_details <- if (method == "wlr") { + # If the method is WLR, change HR to wHR + replace_names(xy, c("~hr at bound" = "~whr at bound")) + } else xy # If the method is COMBO, remove the column of "~HR at bound", and remove AHR from header if (method == "combo" && "~hr at bound" %in% names(xy)) From 494e354885bcf723f8eeb65110a38829d1306cef Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Wed, 4 Sep 2024 23:20:07 -0500 Subject: [PATCH 35/43] rename analysis header and bound details with the same function `cap_names()` --- R/summary.R | 43 ++++++++++++++++++++++--------------------- 1 file changed, 22 insertions(+), 21 deletions(-) diff --git a/R/summary.R b/R/summary.R index 07ee53a4..4718843d 100644 --- a/R/summary.R +++ b/R/summary.R @@ -319,14 +319,12 @@ summary.gs_design <- function(object, # 2. Null hypothesis table. # # Table A: a table under alternative hypothesis. - xy <- replace_names(x_bound, c( - probability = "Alternate hypothesis", probability0 = "Null hypothesis" - )) + xy <- x_bound # change Upper -> bound_names[1], e.g., Efficacy # change Lower -> bound_names[2], e.g., Futility xy$bound = replace_values(xy$bound, c(upper = bound_names[1], lower = bound_names[2])) - if (!"probability0" %in% names(x_bound)) xy$`Null hypothesis` <- "-" + if (!"probability0" %in% names(xy)) xy$probability0 <- "-" xy <- xy %>% arrange(analysis, desc(bound)) # Merge 2 tables: @@ -347,23 +345,8 @@ summary.gs_design <- function(object, if (method == "combo" && "~hr at bound" %in% names(xy)) stop("'~hr at bound' can't be displayed!") - old_vars <- c( - "analysis", "time", "event", "ahr", "rd", "n", "info_frac0", "info_frac", "event_frac" - ) - map_vars <- setNames(cap_initial(old_vars), old_vars) # map old to new names - map_vars[c("ahr", "rd", "info_frac0", "info_frac", "event_frac")] <- c( - "AHR", "Risk difference", "Information fraction", "Information fraction", "Event fraction" - ) - analysis_header <- replace_names(analysis_header, map_vars) - - old_vars <- c( - "analysis", "bound", "z", "~risk difference at bound", "~hr at bound", - "~whr at bound", "nominal p" - ) - map_vars <- setNames(cap_initial(old_vars), old_vars) # map old to new names - map_vars <- gsub("^~risk ", "~Risk ", map_vars) - map_vars <- gsub("^(~w?)(hr) ", "\\1HR ", map_vars, perl = TRUE) - bound_details <- replace_names(bound_details, map_vars) + analysis_header <- cap_names(analysis_header) + bound_details <- cap_names(bound_details) output <- table_ab( # A data frame to be show as the summary header @@ -434,3 +417,21 @@ get_decimals <- function(vars, decs, vars_default, decs_default) { names(decs) <- vars decs } + +# capitalize variable names +cap_names <- function(x) { + low_vars <- c( + "analysis", "time", "event", "n", "bound", "z", "~risk difference at bound", + "~hr at bound", "~whr at bound", "nominal p" + ) + # map lowercase names to capitalized names + map_vars <- setNames(cap_initial(low_vars), low_vars) + map_vars <- gsub("^~risk ", "~Risk ", map_vars) + map_vars <- gsub("^(~w?)(hr) ", "\\1HR ", map_vars, perl = TRUE) + map_vars <- c( + map_vars, ahr = "AHR", rd = "Risk difference", probability = "Alternate hypothesis", + probability0 = "Null hypothesis", info_frac0 = "Information fraction", + info_frac = "Information fraction", event_frac = "Event fraction" + ) + replace_names(x, map_vars) +} From df032ccb825828c86ee1e620fb0d5b3f14fcf8f9 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Wed, 4 Sep 2024 23:24:54 -0500 Subject: [PATCH 36/43] also use cap_names() for fixed design --- R/summary.R | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/R/summary.R b/R/summary.R index 4718843d..67a790b0 100644 --- a/R/summary.R +++ b/R/summary.R @@ -98,12 +98,8 @@ summary.fixed_design <- function(object, ...) { ), fixed = TRUE) ) - ans <- replace_names( - ans, c("design", "n", "event", "time", "bound", "power"), function(x) { - # capitalize words with special case of Event -> Events - ifelse(x == "event", "Events", cap_initial(x)) - } - ) + # capitalize names with special case of Event -> Events + ans <- replace_names(ans, c(event = "Events")) %>% cap_names() ans <- add_class(ans, "fixed_design", x$design) return(ans) @@ -421,8 +417,8 @@ get_decimals <- function(vars, decs, vars_default, decs_default) { # capitalize variable names cap_names <- function(x) { low_vars <- c( - "analysis", "time", "event", "n", "bound", "z", "~risk difference at bound", - "~hr at bound", "~whr at bound", "nominal p" + "analysis", "design", "power", "time", "event", "n", "bound", "z", + "~risk difference at bound", "~hr at bound", "~whr at bound", "nominal p" ) # map lowercase names to capitalized names map_vars <- setNames(cap_initial(low_vars), low_vars) From f724c3b9ace9f645f082ba1794f5350049b9175a Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Wed, 4 Sep 2024 23:31:29 -0500 Subject: [PATCH 37/43] unnecessary to create the two objects `analysis_header` and `bound_details`; just use `analyses` and `xy` --- R/summary.R | 18 +++++------------- 1 file changed, 5 insertions(+), 13 deletions(-) diff --git a/R/summary.R b/R/summary.R index 67a790b0..9916f6f6 100644 --- a/R/summary.R +++ b/R/summary.R @@ -325,32 +325,24 @@ summary.gs_design <- function(object, # Merge 2 tables: # (1) Analysis summary table - # (2) xy: bound_details table + # (2) xy: bound details table # # Merge 3 tables: 1 line per analysis, alternate hypothesis table, null hypothesis table - # Header - analysis_header <- analyses - # Bound details - bound_details <- if (method == "wlr") { - # If the method is WLR, change HR to wHR - replace_names(xy, c("~hr at bound" = "~whr at bound")) - } else xy + # If the method is WLR, change HR to wHR + if (method == "wlr") xy <- replace_names(xy, c("~hr at bound" = "~whr at bound")) # If the method is COMBO, remove the column of "~HR at bound", and remove AHR from header if (method == "combo" && "~hr at bound" %in% names(xy)) stop("'~hr at bound' can't be displayed!") - analysis_header <- cap_names(analysis_header) - bound_details <- cap_names(bound_details) - output <- table_ab( # A data frame to be show as the summary header # It has only ONE record for each value of `byvar` - table_a = analysis_header, + table_a = cap_names(analyses), # A data frame to be shown as the listing details # It has >= 1 records for each value of `byvar` - table_b = bound_details, + table_b = cap_names(xy), decimals = c(0, analysis_decimals), byvar = "Analysis" ) From 774e3e46cdff47f098bd82d84c51e98a525b6562 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Wed, 4 Sep 2024 23:35:42 -0500 Subject: [PATCH 38/43] remove unused argument of replace_values() --- R/utils.R | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/R/utils.R b/R/utils.R index cc4ce3bf..901c9281 100644 --- a/R/utils.R +++ b/R/utils.R @@ -23,16 +23,10 @@ cap_initial <- function(x) { } # replace elements with values from a named vector `old` (of the form -# `c(old_value = new_value)`); if `old` is unnamed, apply a function new() to -# the old values -replace_values <- function(x, old, new = identity) { - if (is.null(names(old))) { - i <- x %in% old - x[i] <- new(x[i]) - } else { - i <- x %in% names(old) - x[i] <- old[x[i]] - } +# `c(old_value = new_value)`) +replace_values <- function(x, map) { + i <- x %in% names(map) + x[i] <- map[x[i]] x } From 9d66828175993ed3a20457642b6950208f72eb08 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Wed, 4 Sep 2024 23:43:08 -0500 Subject: [PATCH 39/43] apply cap_names() on col_decimals --- R/summary.R | 21 +++++++++------------ 1 file changed, 9 insertions(+), 12 deletions(-) diff --git a/R/summary.R b/R/summary.R index 9916f6f6..15166024 100644 --- a/R/summary.R +++ b/R/summary.R @@ -361,11 +361,8 @@ summary.gs_design <- function(object, # "bound" is a required column if (!"bound" %in% names(col_decimals)) col_decimals <- c(bound = NA, col_decimals) - map_vars <- setNames(cap_initial(default_vars), default_vars) - map_vars <- gsub("^~risk ", "~Risk ", map_vars) - map_vars <- gsub("^(~w?)(hr) ", "\\1HR ", map_vars, perl = TRUE) - col_vars <- replace_values(names(col_decimals), map_vars) - names(col_decimals) <- col_vars + col_decimals <- cap_names(col_decimals) + col_vars <- names(col_decimals) output <- output %>% group_by(Analysis) %>% select(all_of(col_vars)) # Set the decimals to display ---- @@ -408,18 +405,18 @@ get_decimals <- function(vars, decs, vars_default, decs_default) { # capitalize variable names cap_names <- function(x) { - low_vars <- c( + low <- c( "analysis", "design", "power", "time", "event", "n", "bound", "z", "~risk difference at bound", "~hr at bound", "~whr at bound", "nominal p" ) # map lowercase names to capitalized names - map_vars <- setNames(cap_initial(low_vars), low_vars) - map_vars <- gsub("^~risk ", "~Risk ", map_vars) - map_vars <- gsub("^(~w?)(hr) ", "\\1HR ", map_vars, perl = TRUE) - map_vars <- c( - map_vars, ahr = "AHR", rd = "Risk difference", probability = "Alternate hypothesis", + map <- setNames(cap_initial(low), low) + map <- gsub("^~risk ", "~Risk ", map) + map <- gsub("^(~w?)(hr) ", "\\1HR ", map, perl = TRUE) + map <- c( + map, ahr = "AHR", rd = "Risk difference", probability = "Alternate hypothesis", probability0 = "Null hypothesis", info_frac0 = "Information fraction", info_frac = "Information fraction", event_frac = "Event fraction" ) - replace_names(x, map_vars) + replace_names(x, map) } From 92d2bfe727eb4c182bc1f67bdac820ff2cbb851e Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Thu, 5 Sep 2024 00:02:30 -0500 Subject: [PATCH 40/43] `<-` [ci skip] --- R/summary.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/summary.R b/R/summary.R index 15166024..03c66c08 100644 --- a/R/summary.R +++ b/R/summary.R @@ -318,7 +318,7 @@ summary.gs_design <- function(object, xy <- x_bound # change Upper -> bound_names[1], e.g., Efficacy # change Lower -> bound_names[2], e.g., Futility - xy$bound = replace_values(xy$bound, c(upper = bound_names[1], lower = bound_names[2])) + xy$bound <- replace_values(xy$bound, c(upper = bound_names[1], lower = bound_names[2])) if (!"probability0" %in% names(xy)) xy$probability0 <- "-" xy <- xy %>% arrange(analysis, desc(bound)) From 4f1de2a5bbf9d5cd7a470cc3015c9c3b4e5f23df Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Thu, 5 Sep 2024 14:11:59 -0500 Subject: [PATCH 41/43] import stats for setNames() --- NAMESPACE | 1 + R/gsDesign2-package.R | 7 ++----- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 31c90cae..06ac4ba3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -52,6 +52,7 @@ export(wlr_weight_1) export(wlr_weight_fh) export(wlr_weight_mb) export(wlr_weight_n) +import(stats) importFrom(Rcpp,sourceCpp) importFrom(data.table,":=") importFrom(data.table,as.data.table) diff --git a/R/gsDesign2-package.R b/R/gsDesign2-package.R index bb3416ad..ff1b65ab 100644 --- a/R/gsDesign2-package.R +++ b/R/gsDesign2-package.R @@ -17,10 +17,7 @@ # along with this program. If not, see . #' @keywords internal -"_PACKAGE" - #' @useDynLib gsDesign2, .registration = TRUE -NULL - +#' @import stats #' @importFrom Rcpp sourceCpp -NULL +"_PACKAGE" From b1a18fbebf472f0297b7ef0ed635bc1cc06cb0d4 Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Thu, 5 Sep 2024 14:13:55 -0500 Subject: [PATCH 42/43] explain the substitute() trick --- R/summary.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/summary.R b/R/summary.R index 03c66c08..52dccb9c 100644 --- a/R/summary.R +++ b/R/summary.R @@ -385,12 +385,13 @@ summary.gs_design <- function(object, # get a named vector of decimals (names are variable names) get_decimals <- function(vars, decs, vars_default, decs_default) { names(decs_default) <- vars_default - # Merge user-provided named decimals into default + # merge user-provided named decimals into default decs_vars <- names(decs) decs_default[decs_vars] <- decs - vars_name <- as.character(substitute(vars)) - decs_name <- as.character(substitute(decs)) + # get the variable names passed to the 'vars' and 'decs' arguments + vars_name <- as.character(substitute(vars)) # e.g., 'analysis_vars' + decs_name <- as.character(substitute(decs)) # e.g., 'analysis_decimals' if (is.null(vars)) { if (!is.null(decs) && is.null(decs_vars)) stop("'", decs_name, "' must be a named vector if '", vars_name, "' is not provided") From 9ba6c87b77adc0e363ac7aa31b5ac7ec75e980bd Mon Sep 17 00:00:00 2001 From: Yihui Xie Date: Thu, 5 Sep 2024 14:21:40 -0500 Subject: [PATCH 43/43] only import stats::setNames() since stats has filter(), which conflicts with dplyr::filter() --- NAMESPACE | 2 +- R/gsDesign2-package.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 06ac4ba3..d7545a4c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -52,7 +52,6 @@ export(wlr_weight_1) export(wlr_weight_fh) export(wlr_weight_mb) export(wlr_weight_n) -import(stats) importFrom(Rcpp,sourceCpp) importFrom(data.table,":=") importFrom(data.table,as.data.table) @@ -85,6 +84,7 @@ importFrom(gsDesign,sfLDOF) importFrom(mvtnorm,GenzBretz) importFrom(stats,pnorm) importFrom(stats,qnorm) +importFrom(stats,setNames) importFrom(stats,stepfun) importFrom(stats,uniroot) importFrom(survival,Surv) diff --git a/R/gsDesign2-package.R b/R/gsDesign2-package.R index ff1b65ab..76de28e5 100644 --- a/R/gsDesign2-package.R +++ b/R/gsDesign2-package.R @@ -18,6 +18,6 @@ #' @keywords internal #' @useDynLib gsDesign2, .registration = TRUE -#' @import stats +#' @importFrom stats setNames #' @importFrom Rcpp sourceCpp "_PACKAGE"