From e411fa61137496ee4f61f2f0b7383905069fee77 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 30 Oct 2023 19:05:42 -0400 Subject: [PATCH 01/25] Refactor surv_time --- R/survival_time.R | 87 ++++++++++++++++++-------- R/utils_default_stats_formats_labels.R | 53 +++++++++++++--- 2 files changed, 105 insertions(+), 35 deletions(-) diff --git a/R/survival_time.R b/R/survival_time.R index e7d96d1d47..155a152b68 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -84,17 +84,55 @@ s_surv_time <- function(df, #' * `a_surv_time()` returns the corresponding list with formatted [rtables::CellValue()]. #' #' @keywords internal -a_surv_time <- make_afun( - s_surv_time, - .formats = c( - "median" = "xx.x", - "median_ci" = "(xx.x, xx.x)", - "quantiles" = "xx.x, xx.x", - "range_censor" = "xx.x to xx.x", - "range_event" = "xx.x to xx.x", - "range" = "xx.x to xx.x" +a_surv_time <- function(df, + labelstr = "", + .var = NULL, + is_event, + control = control_surv_time(), + .stats = NULL, + .formats = NULL, + .labels = NULL, + .indent_mods = NULL, + na_str = NA_character_) { + x_stats <- s_surv_time( + df = df, .var = .var, is_event = is_event, control = control ) -) + if (is.null(unlist(x_stats))) return(NULL) + rng_censor_upr <- x_stats[["range_censor"]][2] + + # Fill in with formatting defaults if needed + .stats <- get_stats("surv_time", stats_in = .stats) + .formats <- get_formats_from_stats(.stats, .formats, method = "surv_time") + .labels <- get_labels_from_stats(.stats, .labels, control = control) + .indent_mods <- get_indents_from_stats(.stats, .indent_mods) + + x_stats <- x_stats[.stats] + + # Auto format handling + fmt_is_auto <- vapply(.formats, function(ii) is.character(ii) && ii == "auto", logical(1)) + if (any(fmt_is_auto)) { + res_l_auto <- x_stats[fmt_is_auto] + tmp_dt_var <- .df_row[[.var]] # xxx this can be extended for the WHOLE data or single facets + .formats[fmt_is_auto] <- lapply(seq_along(res_l_auto), function(rla) { + format_auto(tmp_dt_var, names(res_l_auto)[rla]) + }) + } + + cell_fns <- setNames(vector("list", length = length(x_stats)), .labels) + if ("range" %in% names(x_stats) && x_stats[["range"]][2] == rng_censor_upr) { + cell_fns[[.labels[["range"]]]] <- "censored observation" + } + + in_rows( + .list = x_stats, + .formats = .formats, + .names = .labels, + .labels = .labels, + .indent_mods = .indent_mods, + .format_na_strs = na_str, + .cell_footnotes = cell_fns + ) +} #' @describeIn survival_time Layout-creating function which can take statistics function arguments #' and additional format arguments. This function is a wrapper for [rtables::analyze()]. @@ -127,30 +165,25 @@ surv_time <- function(lyt, nested = TRUE, ..., var_labels = "Time to Event", + show_labels = "visible", table_names = vars, .stats = c("median", "median_ci", "quantiles", "range_censor", "range_event"), .formats = NULL, .labels = NULL, - .indent_mods = c( - "median" = 0L, "median_ci" = 1L, "quantiles" = 0L, - "range_censor" = 0L, "range_event" = 0L, "range" = 0L - )) { - afun <- make_afun( - a_surv_time, - .stats = .stats, - .formats = .formats, - .labels = .labels, - .indent_mods = extract_by_name(.indent_mods, .stats) + .indent_mods = c("median_ci" = 1L)) { + extra_args <- list( + .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str ) + analyze( - lyt, - vars, - na_str = na_str, - nested = nested, + lyt = lyt, + vars = vars, + afun = a_surv_time, var_labels = var_labels, - show_labels = "visible", + show_labels = show_labels, table_names = table_names, - afun = afun, - extra_args = list(...) + na_str = na_str, + nested = nested, + extra_args = c(extra_args, list(...)) ) } diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 789442b99c..5ff849d616 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -77,6 +77,7 @@ get_stats <- function(method_groups = "analyze_vars_numeric", stats_in = NULL, a "range", "min", "max", "median_range", "cv", "geom_mean", "geom_mean_ci", "geom_cv" ), + "surv_time" = c("median", "median_ci", "quantiles", "range_censor", "range_event", "range"), stop( "The selected method group (", mgi, ") has no default statistical method." ) @@ -158,7 +159,7 @@ get_stats <- function(method_groups = "analyze_vars_numeric", stats_in = NULL, a #' @seealso [formatting_functions] #' #' @export -get_formats_from_stats <- function(stats, formats_in = NULL) { +get_formats_from_stats <- function(stats, formats_in = NULL, method = NULL) { checkmate::assert_character(stats, min.len = 1) # It may be a list if there is a function in the formats if (checkmate::test_list(formats_in, null.ok = TRUE)) { @@ -168,14 +169,22 @@ get_formats_from_stats <- function(stats, formats_in = NULL) { checkmate::assert_character(formats_in, null.ok = TRUE) } + out <- setNames(vector("list", length = length(stats)), stats) # Returning a list is simpler + # Extract global defaults which_fmt <- match(stats, names(tern_default_formats)) # Select only needed formats from stats - ret <- vector("list", length = length(stats)) # Returning a list is simpler - ret[!is.na(which_fmt)] <- tern_default_formats[which_fmt[!is.na(which_fmt)]] + out[!is.na(which_fmt)] <- tern_default_formats[which_fmt[!is.na(which_fmt)]] + + # Extract any method-specific formats + if (!is.null(method) && method %in% names(tern_default_formats)) { + which_mthd_fmt <- match(stats, names(tern_default_formats[[method]])) + # Select only needed formats from stats + out[!is.na(which_mthd_fmt)] <- tern_default_formats[[method]][which_mthd_fmt[!is.na(which_mthd_fmt)]] + } + - out <- setNames(ret, stats) # Modify some with custom formats if (!is.null(formats_in)) { @@ -207,7 +216,7 @@ get_formats_from_stats <- function(stats, formats_in = NULL) { #' get_labels_from_stats(all_cnt_occ, labels_in = list("fraction" = c("Some more fractions"))) #' #' @export -get_labels_from_stats <- function(stats, labels_in = NULL) { +get_labels_from_stats <- function(stats, labels_in = NULL, row_nms = NULL, control = NULL) { checkmate::assert_character(stats, min.len = 1) # It may be a list if (checkmate::test_list(labels_in, null.ok = TRUE)) { @@ -224,6 +233,25 @@ get_labels_from_stats <- function(stats, labels_in = NULL) { out <- setNames(ret, stats) + # Change defaults for labels with control specs + if (!is.null(control)) { + if ("conf_level" %in% names(control)) { + ret <- gsub("[0-9]+% CI", f_conf_level(control[["conf_level"]]), ret) + } + if ("quantiles" %in% names(control)) { + ret <- gsub( + "[0-9]+% and [0-9]+", paste0(control[["quantiles"]][1] * 100, "% and ", control[["quantiles"]][2] * 100, ""), + ret + ) + } + if ("mean_pval" %in% names(control)) { + ret <- gsub("p-value \\(H0: mean = [0-9\\.]+\\)", f_pval(control[["conf_level"]]), ret) + } + } + + out <- setNames(ret, stats) + } + # Modify some with custom labels if (!is.null(labels_in)) { # Stats is the main @@ -239,7 +267,7 @@ get_labels_from_stats <- function(stats, labels_in = NULL) { #' * `tern_default_formats` is a list of available formats, named after their relevant #' statistic. #' @export -tern_default_formats <- c( +tern_default_formats <- list( fraction = format_fraction_fixed_dp, unique = format_count_fraction_fixed_dp, nonunique = "xx", @@ -273,7 +301,14 @@ tern_default_formats <- c( geom_mean_ci = "(xx.xx, xx.xx)", geom_cv = "xx.x", pval = "x.xxxx | (<0.0001)", - pval_counts = "x.xxxx | (<0.0001)" + pval_counts = "x.xxxx | (<0.0001)", + surv_time = list( + median_ci = "(xx.x, xx.x)", + quantiles = "xx.x, xx.x", + range_censor = "xx.x to xx.x", + range_event = "xx.x to xx.x", + range = "xx.x to xx.x" + ) ) #' @describeIn default_stats_formats_labels `character` vector that contains default labels @@ -314,7 +349,9 @@ tern_default_labels <- c( geom_mean_ci = "Geometric Mean 95% CI", geom_cv = "CV % Geometric Mean", pval = "p-value (t-test)", # Default for numeric - pval_counts = "p-value (chi-squared test)" # Default for counts + pval_counts = "p-value (chi-squared test)", # Default for counts + range_censor = "Range (censored)", + range_event = "Range (event)" ) # To deprecate --------- From fd35bad28e0068ecf028ae584e1b432ab31b21fb Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 31 Oct 2023 13:43:20 -0400 Subject: [PATCH 02/25] Clean up --- R/survival_time.R | 2 +- R/utils_default_stats_formats_labels.R | 39 ++++++++------------ man/default_stats_formats_labels.Rd | 4 +- man/survival_time.Rd | 51 +++++++++++++++++--------- 4 files changed, 53 insertions(+), 43 deletions(-) diff --git a/R/survival_time.R b/R/survival_time.R index 155a152b68..8400f95cc0 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -167,7 +167,7 @@ surv_time <- function(lyt, var_labels = "Time to Event", show_labels = "visible", table_names = vars, - .stats = c("median", "median_ci", "quantiles", "range_censor", "range_event"), + .stats = c("median", "median_ci", "quantiles", "range"), .formats = NULL, .labels = NULL, .indent_mods = c("median_ci" = 1L)) { diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 5ff849d616..bee23f27fe 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -184,8 +184,6 @@ get_formats_from_stats <- function(stats, formats_in = NULL, method = NULL) { out[!is.na(which_mthd_fmt)] <- tern_default_formats[[method]][which_mthd_fmt[!is.na(which_mthd_fmt)]] } - - # Modify some with custom formats if (!is.null(formats_in)) { # Stats is the main @@ -228,28 +226,23 @@ get_labels_from_stats <- function(stats, labels_in = NULL, row_nms = NULL, contr which_lbl <- match(stats, names(tern_default_labels)) - ret <- vector("character", length = length(stats)) # it needs to be a character vector - ret[!is.na(which_lbl)] <- tern_default_labels[which_lbl[!is.na(which_lbl)]] - - out <- setNames(ret, stats) - - # Change defaults for labels with control specs - if (!is.null(control)) { - if ("conf_level" %in% names(control)) { - ret <- gsub("[0-9]+% CI", f_conf_level(control[["conf_level"]]), ret) - } - if ("quantiles" %in% names(control)) { - ret <- gsub( - "[0-9]+% and [0-9]+", paste0(control[["quantiles"]][1] * 100, "% and ", control[["quantiles"]][2] * 100, ""), - ret - ) - } - if ("mean_pval" %in% names(control)) { - ret <- gsub("p-value \\(H0: mean = [0-9\\.]+\\)", f_pval(control[["conf_level"]]), ret) - } - } + out <- setNames(vector("character", length = length(stats)), stats) # it needs to be a character vector + out[!is.na(which_lbl)] <- tern_default_labels[which_lbl[!is.na(which_lbl)]] - out <- setNames(ret, stats) + # Change defaults for labels with control specs + if (!is.null(control)) { + if ("conf_level" %in% names(control)) { + out <- gsub("[0-9]+% CI", f_conf_level(control[["conf_level"]]), out) + } + if ("quantiles" %in% names(control)) { + out <- gsub( + "[0-9]+% and [0-9]+", paste0(control[["quantiles"]][1] * 100, "% and ", control[["quantiles"]][2] * 100, ""), + out + ) + } + if ("mean_pval" %in% names(control)) { + out <- gsub("p-value \\(H0: mean = [0-9\\.]+\\)", f_pval(control[["conf_level"]]), out) + } } # Modify some with custom labels diff --git a/man/default_stats_formats_labels.Rd b/man/default_stats_formats_labels.Rd index abb81c2614..6814131270 100644 --- a/man/default_stats_formats_labels.Rd +++ b/man/default_stats_formats_labels.Rd @@ -30,9 +30,9 @@ get_stats( add_pval = FALSE ) -get_formats_from_stats(stats, formats_in = NULL) +get_formats_from_stats(stats, formats_in = NULL, method = NULL) -get_labels_from_stats(stats, labels_in = NULL) +get_labels_from_stats(stats, labels_in = NULL, row_nms = NULL, control = NULL) tern_default_formats diff --git a/man/survival_time.Rd b/man/survival_time.Rd index 8a72bca3b2..f479c4e9f8 100644 --- a/man/survival_time.Rd +++ b/man/survival_time.Rd @@ -9,7 +9,18 @@ \usage{ s_surv_time(df, .var, is_event, control = control_surv_time()) -a_surv_time(df, .var, is_event, control = control_surv_time()) +a_surv_time( + df, + labelstr = "", + .var = NULL, + is_event, + control = control_surv_time(), + .stats = NULL, + .formats = NULL, + .labels = NULL, + .indent_mods = NULL, + na_str = NA_character_ +) surv_time( lyt, @@ -18,12 +29,12 @@ surv_time( nested = TRUE, ..., var_labels = "Time to Event", + show_labels = "visible", table_names = vars, - .stats = c("median", "median_ci", "quantiles", "range_censor", "range_event"), + .stats = c("median", "median_ci", "quantiles", "range"), .formats = NULL, .labels = NULL, - .indent_mods = c(median = 0L, median_ci = 1L, quantiles = 0L, range_censor = 0L, - range_event = 0L, range = 0L) + .indent_mods = c(median_ci = 1L) ) } \arguments{ @@ -43,12 +54,27 @@ see more in \code{\link[survival:survfit]{survival::survfit()}}. Note option "no \item \code{quantiles} (\code{numeric})\cr vector of length two to specify the quantiles of survival time. }} -\item{lyt}{(\code{layout})\cr input layout where analyses will be added to.} +\item{labelstr}{(\code{character})\cr label of the level of the parent split currently being summarized +(must be present as second argument in Content Row Functions). See \code{\link[rtables:summarize_row_groups]{rtables::summarize_row_groups()}} +for more information.} -\item{vars}{(\code{character})\cr variable names for the primary analysis variable to be iterated over.} +\item{.stats}{(\code{character})\cr statistics to select for the table.} + +\item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more +information on the \code{"auto"} setting.} + +\item{.labels}{(named \code{character})\cr labels for the statistics (without indent).} + +\item{.indent_mods}{(named \code{vector} of \code{integer})\cr indent modifiers for the labels. Each element of the vector +should be a name-value pair with name corresponding to a statistic specified in \code{.stats} and value the indentation +for that statistic's row label.} \item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} +\item{lyt}{(\code{layout})\cr input layout where analyses will be added to.} + +\item{vars}{(\code{character})\cr variable names for the primary analysis variable to be iterated over.} + \item{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if possible} (\code{TRUE}, the default) or as a new top-level element (\code{FALSE}). Ignored if it would nest a split. underneath analyses, which is not allowed.} @@ -57,19 +83,10 @@ underneath analyses, which is not allowed.} \item{var_labels}{(\code{character})\cr character for label.} +\item{show_labels}{(\code{string})\cr label visibility: one of "default", "visible" and "hidden".} + \item{table_names}{(\code{character})\cr this can be customized in case that the same \code{vars} are analyzed multiple times, to avoid warnings from \code{rtables}.} - -\item{.stats}{(\code{character})\cr statistics to select for the table.} - -\item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more -information on the \code{"auto"} setting.} - -\item{.labels}{(named \code{character})\cr labels for the statistics (without indent).} - -\item{.indent_mods}{(named \code{vector} of \code{integer})\cr indent modifiers for the labels. Each element of the vector -should be a name-value pair with name corresponding to a statistic specified in \code{.stats} and value the indentation -for that statistic's row label.} } \value{ \itemize{ From 04989b4e469c583101bb754d053a8c55f5e9f686 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 1 Nov 2023 14:27:26 -0400 Subject: [PATCH 03/25] styler --- R/survival_time.R | 6 +++-- R/utils_default_stats_formats_labels.R | 34 +++++++++++++------------- 2 files changed, 21 insertions(+), 19 deletions(-) diff --git a/R/survival_time.R b/R/survival_time.R index 8400f95cc0..ff6e2baa28 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -97,7 +97,9 @@ a_surv_time <- function(df, x_stats <- s_surv_time( df = df, .var = .var, is_event = is_event, control = control ) - if (is.null(unlist(x_stats))) return(NULL) + if (is.null(unlist(x_stats))) { + return(NULL) + } rng_censor_upr <- x_stats[["range_censor"]][2] # Fill in with formatting defaults if needed @@ -120,7 +122,7 @@ a_surv_time <- function(df, cell_fns <- setNames(vector("list", length = length(x_stats)), .labels) if ("range" %in% names(x_stats) && x_stats[["range"]][2] == rng_censor_upr) { - cell_fns[[.labels[["range"]]]] <- "censored observation" + cell_fns[[.labels[["range"]]]] <- "Censored observation" } in_rows( diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 85c9b3824e..1a6918569c 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -234,24 +234,24 @@ get_labels_from_stats <- function(stats, labels_in = NULL, row_nms = NULL, contr ret <- rep(row_nms, length(stats)) out <- setNames(ret, paste(rep(stats, each = length(row_nms)), ret, sep = ".")) - out <- setNames(vector("character", length = length(stats)), stats) # it needs to be a character vector - out[!is.na(which_lbl)] <- tern_default_labels[which_lbl[!is.na(which_lbl)]] - - # Change defaults for labels with control specs - if (!is.null(control)) { - if ("conf_level" %in% names(control)) { - out <- gsub("[0-9]+% CI", f_conf_level(control[["conf_level"]]), out) - } - if ("quantiles" %in% names(control)) { - out <- gsub( - "[0-9]+% and [0-9]+", paste0(control[["quantiles"]][1] * 100, "% and ", control[["quantiles"]][2] * 100, ""), - out - ) + out <- setNames(vector("character", length = length(stats)), stats) # it needs to be a character vector + out[!is.na(which_lbl)] <- tern_default_labels[which_lbl[!is.na(which_lbl)]] + + # Change defaults for labels with control specs + if (!is.null(control)) { + if ("conf_level" %in% names(control)) { + out <- gsub("[0-9]+% CI", f_conf_level(control[["conf_level"]]), out) + } + if ("quantiles" %in% names(control)) { + out <- gsub( + "[0-9]+% and [0-9]+", paste0(control[["quantiles"]][1] * 100, "% and ", control[["quantiles"]][2] * 100, ""), + out + ) + } + if ("mean_pval" %in% names(control)) { + out <- gsub("p-value \\(H0: mean = [0-9\\.]+\\)", f_pval(control[["conf_level"]]), out) + } } - if ("mean_pval" %in% names(control)) { - out <- gsub("p-value \\(H0: mean = [0-9\\.]+\\)", f_pval(control[["conf_level"]]), out) - } - } out <- setNames(ret, stats) } From 93a1cf27f49678e497bafd8eb3e7ed93b227a1bb Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 1 Nov 2023 15:51:30 -0400 Subject: [PATCH 04/25] Fix labels --- R/utils_default_stats_formats_labels.R | 37 ++++++++++++++------------ 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 1a6918569c..4956d1be2a 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -233,27 +233,30 @@ get_labels_from_stats <- function(stats, labels_in = NULL, row_nms = NULL, contr if (!is.null(row_nms)) { ret <- rep(row_nms, length(stats)) out <- setNames(ret, paste(rep(stats, each = length(row_nms)), ret, sep = ".")) - + } else { out <- setNames(vector("character", length = length(stats)), stats) # it needs to be a character vector + + # Extract global defaults + which_lbl <- match(stats, names(tern_default_labels)) + + # Select only needed formats from stats out[!is.na(which_lbl)] <- tern_default_labels[which_lbl[!is.na(which_lbl)]] + } - # Change defaults for labels with control specs - if (!is.null(control)) { - if ("conf_level" %in% names(control)) { - out <- gsub("[0-9]+% CI", f_conf_level(control[["conf_level"]]), out) - } - if ("quantiles" %in% names(control)) { - out <- gsub( - "[0-9]+% and [0-9]+", paste0(control[["quantiles"]][1] * 100, "% and ", control[["quantiles"]][2] * 100, ""), - out - ) - } - if ("mean_pval" %in% names(control)) { - out <- gsub("p-value \\(H0: mean = [0-9\\.]+\\)", f_pval(control[["conf_level"]]), out) - } + # Change defaults for labels with control specs + if (!is.null(control)) { + if ("conf_level" %in% names(control)) { + out <- gsub("[0-9]+% CI", f_conf_level(control[["conf_level"]]), out) + } + if ("quantiles" %in% names(control)) { + out <- gsub( + "[0-9]+% and [0-9]+", paste0(control[["quantiles"]][1] * 100, "% and ", control[["quantiles"]][2] * 100, ""), + out + ) + } + if ("mean_pval" %in% names(control)) { + out <- gsub("p-value \\(H0: mean = [0-9\\.]+\\)", f_pval(control[["conf_level"]]), out) } - - out <- setNames(ret, stats) } # Modify some with custom labels From 89bbb24b8e8cfa4c52855b3545ab8cbdefc5ed3d Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 1 Nov 2023 15:51:42 -0400 Subject: [PATCH 05/25] Update ref footnotes --- R/survival_time.R | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/R/survival_time.R b/R/survival_time.R index ff6e2baa28..6cc8fd6c3d 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -100,6 +100,7 @@ a_surv_time <- function(df, if (is.null(unlist(x_stats))) { return(NULL) } + rng_censor_lwr <- x_stats[["range_censor"]][1] rng_censor_upr <- x_stats[["range_censor"]][2] # Fill in with formatting defaults if needed @@ -121,8 +122,14 @@ a_surv_time <- function(df, } cell_fns <- setNames(vector("list", length = length(x_stats)), .labels) - if ("range" %in% names(x_stats) && x_stats[["range"]][2] == rng_censor_upr) { - cell_fns[[.labels[["range"]]]] <- "Censored observation" + if ("range" %in% names(x_stats)) { + if (x_stats[["range"]][1] == rng_censor_lwr && x_stats[["range"]][2] == rng_censor_upr) { + cell_fns[[.labels[["range"]]]] <- "Censored observations: range minimum & maximum" + } else if (x_stats[["range"]][1] == rng_censor_lwr) { + cell_fns[[.labels[["range"]]]] <- "Censored observation: range minimum" + } else if (x_stats[["range"]][2] == rng_censor_upr) { + cell_fns[[.labels[["range"]]]] <- "Censored observation: range maximum" + } } in_rows( From 9f349a4085f5f7dc4b6a62063dc41a8b5c4d0ed8 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 1 Nov 2023 17:17:06 -0400 Subject: [PATCH 06/25] Add method-specific labels --- R/survival_time.R | 2 +- R/utils_default_stats_formats_labels.R | 19 +++++++++++++++---- 2 files changed, 16 insertions(+), 5 deletions(-) diff --git a/R/survival_time.R b/R/survival_time.R index 6cc8fd6c3d..f02547d169 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -106,7 +106,7 @@ a_surv_time <- function(df, # Fill in with formatting defaults if needed .stats <- get_stats("surv_time", stats_in = .stats) .formats <- get_formats_from_stats(.stats, .formats, method = "surv_time") - .labels <- get_labels_from_stats(.stats, .labels, control = control) + .labels <- get_labels_from_stats(.stats, .labels, method = "surv_time", control = control) .indent_mods <- get_indents_from_stats(.stats, .indent_mods) x_stats <- x_stats[.stats] diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 4956d1be2a..3ea132ff54 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -219,7 +219,7 @@ get_formats_from_stats <- function(stats, formats_in = NULL, method = NULL) { #' get_labels_from_stats(all_cnt_occ, labels_in = list("fraction" = c("Some more fractions"))) #' #' @export -get_labels_from_stats <- function(stats, labels_in = NULL, row_nms = NULL, control = NULL) { +get_labels_from_stats <- function(stats, labels_in = NULL, row_nms = NULL, method = NULL, control = NULL) { checkmate::assert_character(stats, min.len = 1) checkmate::assert_character(row_nms, null.ok = TRUE) # It may be a list @@ -241,6 +241,13 @@ get_labels_from_stats <- function(stats, labels_in = NULL, row_nms = NULL, contr # Select only needed formats from stats out[!is.na(which_lbl)] <- tern_default_labels[which_lbl[!is.na(which_lbl)]] + + # Extract any method-specific labels + if (!is.null(method) && method %in% names(tern_default_labels)) { + which_mthd_lbl <- match(stats, names(tern_default_labels[[method]])) + # Select only needed formats from stats + out[!is.na(which_mthd_lbl)] <- tern_default_labels[[method]][which_mthd_lbl[!is.na(which_mthd_lbl)]] + } } # Change defaults for labels with control specs @@ -380,7 +387,7 @@ tern_default_formats <- list( #' * `tern_default_labels` is a character vector of available labels, named after their relevant #' statistic. #' @export -tern_default_labels <- c( +tern_default_labels <- list( # list of labels -> sorted? xxx it should be not relevant due to match fraction = "fraction", unique = "Number of patients with at least one event", @@ -415,8 +422,12 @@ tern_default_labels <- c( geom_cv = "CV % Geometric Mean", pval = "p-value (t-test)", # Default for numeric pval_counts = "p-value (chi-squared test)", # Default for counts - range_censor = "Range (censored)", - range_event = "Range (event)" + surv_time = list( + median_ci = "95% CI", + range = "Range", + range_censor = "Range (censored)", + range_event = "Range (event)" + ) ) # To deprecate --------- From 4f714dbee099e1bada1833f6c57b35a5d190db85 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 1 Nov 2023 17:58:58 -0400 Subject: [PATCH 07/25] Fix tests --- R/survival_time.R | 2 +- R/utils_default_stats_formats_labels.R | 17 ++++++++++++----- man/default_stats_formats_labels.Rd | 8 +++++++- 3 files changed, 20 insertions(+), 7 deletions(-) diff --git a/R/survival_time.R b/R/survival_time.R index f02547d169..6b0f7cbcae 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -179,7 +179,7 @@ surv_time <- function(lyt, .stats = c("median", "median_ci", "quantiles", "range"), .formats = NULL, .labels = NULL, - .indent_mods = c("median_ci" = 1L)) { + .indent_mods = c(median_ci = 1L)) { extra_args <- list( .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str ) diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 3ea132ff54..adcd1add06 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -233,6 +233,11 @@ get_labels_from_stats <- function(stats, labels_in = NULL, row_nms = NULL, metho if (!is.null(row_nms)) { ret <- rep(row_nms, length(stats)) out <- setNames(ret, paste(rep(stats, each = length(row_nms)), ret, sep = ".")) + + if (!is.null(labels_in)) { + lvl_lbls <- intersect(names(labels_in), row_nms) + for (i in lvl_lbls) out[paste(stats, i, sep = ".")] <- labels_in[[i]] + } } else { out <- setNames(vector("character", length = length(stats)), stats) # it needs to be a character vector @@ -253,16 +258,18 @@ get_labels_from_stats <- function(stats, labels_in = NULL, row_nms = NULL, metho # Change defaults for labels with control specs if (!is.null(control)) { if ("conf_level" %in% names(control)) { - out <- gsub("[0-9]+% CI", f_conf_level(control[["conf_level"]]), out) + out <- lapply(out, gsub, pattern = "[0-9]+% CI", replacement = f_conf_level(control[["conf_level"]])) } if ("quantiles" %in% names(control)) { - out <- gsub( + out[["quantiles"]] <- gsub( "[0-9]+% and [0-9]+", paste0(control[["quantiles"]][1] * 100, "% and ", control[["quantiles"]][2] * 100, ""), - out + out[["quantiles"]] ) } if ("mean_pval" %in% names(control)) { - out <- gsub("p-value \\(H0: mean = [0-9\\.]+\\)", f_pval(control[["conf_level"]]), out) + out[["mean_pval"]] <- gsub( + "p-value \\(H0: mean = [0-9\\.]+\\)", f_pval(control[["conf_level"]]), out[["mean_pval"]] + ) } } @@ -273,7 +280,7 @@ get_labels_from_stats <- function(stats, labels_in = NULL, row_nms = NULL, metho out[common_names] <- labels_in[common_names] } - out + unlist(out) } #' @describeIn default_stats_formats_labels Format indent modifiers for a given vector/list of statistics. diff --git a/man/default_stats_formats_labels.Rd b/man/default_stats_formats_labels.Rd index 499cac16d4..12a6cff1f3 100644 --- a/man/default_stats_formats_labels.Rd +++ b/man/default_stats_formats_labels.Rd @@ -33,7 +33,13 @@ get_stats( get_formats_from_stats(stats, formats_in = NULL, method = NULL) -get_labels_from_stats(stats, labels_in = NULL, row_nms = NULL, control = NULL) +get_labels_from_stats( + stats, + labels_in = NULL, + row_nms = NULL, + method = NULL, + control = NULL +) get_indents_from_stats(stats, indents_in = NULL, row_nms = NULL) From 80f20455244a7f4e8a4ff2594b19324ff01dacd6 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 1 Nov 2023 18:09:15 -0400 Subject: [PATCH 08/25] Add test --- tests/testthat/_snaps/survival_time.md | 25 +++++++++++++++++++++++-- tests/testthat/test-survival_time.R | 26 ++++++++++++++++++++++++++ 2 files changed, 49 insertions(+), 2 deletions(-) diff --git a/tests/testthat/_snaps/survival_time.md b/tests/testthat/_snaps/survival_time.md index 47716eec1c..4f388b9237 100644 --- a/tests/testthat/_snaps/survival_time.md +++ b/tests/testthat/_snaps/survival_time.md @@ -81,8 +81,7 @@ Median 32.0 23.9 20.8 95% CI (22.5, 49.3) (18.3, 32.9) (12.9, 26.0) 25% and 75%-ile 17.4, 65.3 9.8, 42.0 7.3, 37.1 - Range (censored) 0.8 to 63.5 6.2 to 78.9 3.4 to 52.4 - Range (event) 0.3 to 155.5 0.1 to 154.1 0.6 to 80.7 + Range 0.3 to 155.5 0.1 to 154.1 0.6 to 80.7 # surv_time works with customized arguments @@ -97,4 +96,26 @@ 40% and 60%-ile 25.6, 46.5 18.3, 29.2 13.0, 25.7 Range (censored) 0.8 to 63.5 6.2 to 78.9 3.4 to 52.4 Range (event) 0.3 to 155.5 0.1 to 154.1 0.6 to 80.7 + Range 0.3 to 155.5 0.1 to 154.1 0.6 to 80.7 + +# surv_time works with referential footnotes + + Code + res + Output + ARM A ARM B ARM C All + ———————————————————————————————————————————————————————————————————————————————————————————— + Time to Event + Median 32.0 23.9 20.8 24.9 + 95% CI (22.6, 53.4) (18.3, 32.9) (12.9, 26.0) (21.5, 31.7) + 25% and 75%-ile 17.4, 65.3 9.8, 42.7 7.3, 37.1 11.5, 49.3 + Range 0.3 to 155.5 {1} 0.1 to 154.1 {2} 0.6 to 80.7 {3} 0.1 to 155.5 {4} + ———————————————————————————————————————————————————————————————————————————————————————————— + + {1} - Censored observation: range minimum + {2} - Censored observations: range minimum & maximum + {3} - Censored observation: range maximum + {4} - Censored observation: range minimum + ———————————————————————————————————————————————————————————————————————————————————————————— + diff --git a/tests/testthat/test-survival_time.R b/tests/testthat/test-survival_time.R index 5090952602..36ddedb2c8 100644 --- a/tests/testthat/test-survival_time.R +++ b/tests/testthat/test-survival_time.R @@ -74,6 +74,7 @@ testthat::test_that("surv_time works with customized arguments", { vars = "AVAL", var_labels = "Survival Time (Months)", is_event = "is_event", + .stats = get_stats("surv_time"), control = control_surv_time(conf_level = 0.9, conf_type = "log", quantiles = c(0.4, 0.6)) ) %>% build_table(df = adtte_f) @@ -81,3 +82,28 @@ testthat::test_that("surv_time works with customized arguments", { res <- testthat::expect_silent(result) testthat::expect_snapshot(res) }) + +testthat::test_that("surv_time works with referential footnotes", { + adtte_f <- tern_ex_adtte %>% + dplyr::filter(PARAMCD == "OS") %>% + dplyr::mutate( + AVAL = day2month(AVAL), + is_event = CNSR == 0 + ) + adtte_f$is_event[adtte_f$AVAL == min(adtte_f[adtte_f$ARMCD == "ARM A",]$AVAL) & adtte_f$ARMCD == "ARM A"] <- FALSE + adtte_f$is_event[adtte_f$AVAL == min(adtte_f[adtte_f$ARMCD == "ARM B",]$AVAL) & adtte_f$ARMCD == "ARM B"] <- FALSE + adtte_f$is_event[adtte_f$AVAL == max(adtte_f[adtte_f$ARMCD == "ARM B",]$AVAL) & adtte_f$ARMCD == "ARM B"] <- FALSE + adtte_f$is_event[adtte_f$AVAL == max(adtte_f[adtte_f$ARMCD == "ARM C",]$AVAL) & adtte_f$ARMCD == "ARM C"] <- FALSE + + result <- basic_table() %>% + split_cols_by(var = "ARMCD") %>% + add_overall_col(label = "All") %>% + surv_time( + vars = "AVAL", + is_event = "is_event" + ) %>% + build_table(df = adtte_f) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) +}) From f98d6e392eb2dad32d15e75f2b8ffc7839c0d432 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 1 Nov 2023 18:23:23 -0400 Subject: [PATCH 09/25] Update NEWS, docs --- NEWS.md | 9 +++++++-- R/utils_default_stats_formats_labels.R | 9 +++++++++ man/default_stats_formats_labels.Rd | 8 ++++++++ 3 files changed, 24 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index c8c2415d3a..0db9b5f8f3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,13 @@ * Added `ref_group_position` function to place the reference group facet last, first or at a certain position. * Added `keep_level_order` split function to retain original order of levels in a split. * Added `level_order` split function to reorder manually the levels. +* Added function `get_indents_from_stats` to format and return indent modifiers for a given set of statistics. +* Added summarize function version of `count_occurrences` analyze function, `summarize_occurrences`. +* Added referential footnotes to `surv_time` for censored range observations. + +### Enhancements +* Updated `get_formats_from_stats` and `get_labels_from_stats` with added `method` parameter to retrieve method-specific defaults. +* Updated `get_labels_from_stats` with added `control` parameter to auto-adjust default labels based on statistic control parameters. ### Miscellaneous * Specified minimal version of package dependencies. @@ -12,8 +19,6 @@ ### New Features * Added the `na_str` argument to `analyze` & `summarize_row_groups` wrapper functions `count_abnormal`, `count_abnormal_by_baseline`, `count_abnormal_by_marked`, `count_abnormal_by_worst_grade`, `count_abnormal_lab_worsen_by_baseline`, `count_cumulative`, `count_missed_doses`, `count_occurrences`, `count_occurrences_by_grade`, `summarize_occurrences_by_grade`, `summarize_patients_events_in_cols`, `count_patients_with_event`, `count_patients_with_flags`, `count_values`, `estimate_multinomial_response`, `estimate_proportion`, `h_tab_one_biomarker`, `estimate_incidence_rate`, `logistic_summary_by_flag`, `estimate_odds_ratio`, `estimate_proportion_diff`, `test_proportion_diff`, `summarize_ancova`, `summarize_change`, `summarize_glm_count`, `summarize_num_patients`, `analyze_num_patients`, `summarize_patients_exposure_in_cols`, `coxph_pairwise`, `tabulate_survival_subgroups`, `surv_time`, and `surv_timepoint`. -* Added function `get_indents_from_stats` to format and return indent modifiers for a given set of statistics. -* Added summarize function version of `count_occurrences` analyze function, `summarize_occurrences`. ### Enhancements * Added formatting function `format_count_fraction_lt10` for formatting `count_fraction` with special consideration when count is less than 10. diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index adcd1add06..424168df7b 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -137,6 +137,9 @@ get_stats <- function(method_groups = "analyze_vars_numeric", stats_in = NULL, a #' #' @param formats_in (named `vector`) \cr inserted formats to replace defaults. It can be a #' character vector from [formatters::list_valid_format_labels()] or a custom format function. +#' @param method (`character`) name of statistical method group from which to draw alternative +#' default formats from. E.g. For `method = "surv_time"`, the default format for `range` is +#' `"xx.x to xx.x"` instead of the tern default, `"xx.x - xx.x"`. #' #' @return #' * `get_formats_from_stats()` returns a named list of formats, they being a value from @@ -202,6 +205,12 @@ get_formats_from_stats <- function(stats, formats_in = NULL, method = NULL) { #' variable levels will be used as the defaults, and the names of the given custom values should #' correspond to levels (or have format `statistic.level`) instead of statistics. Can also be #' variable names if rows correspond to different variables instead of levels. Defaults to `NULL`. +#' @param method (`character`) name of statistical method group from which to draw alternative +#' default formats from. E.g. For `method = "surv_time"`, the default label for `range` is +#' `"Range"` instead of the tern default, `"Min - Max"`. +#' @param control (named `list`) list of control parameters to apply to automatically adjust +#' default labels. E.g. If control has element `conf_level` set to `0.9`, the default label for +#' statistic `mean_ci` will become `"Mean 90% CI"`. #' #' @return #' * `get_labels_from_stats()` returns a named character vector of default labels (if present diff --git a/man/default_stats_formats_labels.Rd b/man/default_stats_formats_labels.Rd index 12a6cff1f3..52c4e26207 100644 --- a/man/default_stats_formats_labels.Rd +++ b/man/default_stats_formats_labels.Rd @@ -75,6 +75,10 @@ methods.} \item{formats_in}{(named \code{vector}) \cr inserted formats to replace defaults. It can be a character vector from \code{\link[formatters:list_formats]{formatters::list_valid_format_labels()}} or a custom format function.} +\item{method}{(\code{character}) name of statistical method group from which to draw alternative +default formats from. E.g. For \code{method = "surv_time"}, the default label for \code{range} is +\code{"Range"} instead of the tern default, \code{"Min - Max"}.} + \item{labels_in}{(named \code{vector})\cr inserted labels to replace defaults.} \item{row_nms}{(\code{character})\cr row names. Levels of a \code{factor} or \code{character} variable, each @@ -83,6 +87,10 @@ variable levels will be used as the defaults, and the names of the given custom correspond to levels (or have format \code{statistic.level}) instead of statistics. Can also be variable names if rows correspond to different variables instead of levels. Defaults to \code{NULL}.} +\item{control}{(named \code{list}) list of control parameters to apply to automatically adjust +default labels. E.g. If control has element \code{conf_level} set to \code{0.9}, the default label for +statistic \code{mean_ci} will become \code{"Mean 90\% CI"}.} + \item{indents_in}{(named \code{vector})\cr inserted indent modifiers to replace defaults (default is \code{0L}).} \item{type}{(\code{flag})\cr is it going to be \code{"numeric"} or \code{"counts"}?} From fd30e3ca995c32570414ec16f8f898722b26e389 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Wed, 1 Nov 2023 22:30:06 +0000 Subject: [PATCH 10/25] [skip actions] Restyle files --- tests/testthat/test-survival_time.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-survival_time.R b/tests/testthat/test-survival_time.R index 36ddedb2c8..fc5ee91941 100644 --- a/tests/testthat/test-survival_time.R +++ b/tests/testthat/test-survival_time.R @@ -90,10 +90,10 @@ testthat::test_that("surv_time works with referential footnotes", { AVAL = day2month(AVAL), is_event = CNSR == 0 ) - adtte_f$is_event[adtte_f$AVAL == min(adtte_f[adtte_f$ARMCD == "ARM A",]$AVAL) & adtte_f$ARMCD == "ARM A"] <- FALSE - adtte_f$is_event[adtte_f$AVAL == min(adtte_f[adtte_f$ARMCD == "ARM B",]$AVAL) & adtte_f$ARMCD == "ARM B"] <- FALSE - adtte_f$is_event[adtte_f$AVAL == max(adtte_f[adtte_f$ARMCD == "ARM B",]$AVAL) & adtte_f$ARMCD == "ARM B"] <- FALSE - adtte_f$is_event[adtte_f$AVAL == max(adtte_f[adtte_f$ARMCD == "ARM C",]$AVAL) & adtte_f$ARMCD == "ARM C"] <- FALSE + adtte_f$is_event[adtte_f$AVAL == min(adtte_f[adtte_f$ARMCD == "ARM A", ]$AVAL) & adtte_f$ARMCD == "ARM A"] <- FALSE + adtte_f$is_event[adtte_f$AVAL == min(adtte_f[adtte_f$ARMCD == "ARM B", ]$AVAL) & adtte_f$ARMCD == "ARM B"] <- FALSE + adtte_f$is_event[adtte_f$AVAL == max(adtte_f[adtte_f$ARMCD == "ARM B", ]$AVAL) & adtte_f$ARMCD == "ARM B"] <- FALSE + adtte_f$is_event[adtte_f$AVAL == max(adtte_f[adtte_f$ARMCD == "ARM C", ]$AVAL) & adtte_f$ARMCD == "ARM C"] <- FALSE result <- basic_table() %>% split_cols_by(var = "ARMCD") %>% From 032a0bd8a06435105761dfc50c4f10360a49d33b Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 2 Nov 2023 09:44:21 -0400 Subject: [PATCH 11/25] Fix checks --- R/survival_time.R | 1 + man/survival_time.Rd | 3 +++ 2 files changed, 4 insertions(+) diff --git a/R/survival_time.R b/R/survival_time.R index 6b0f7cbcae..ab36b86362 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -87,6 +87,7 @@ s_surv_time <- function(df, a_surv_time <- function(df, labelstr = "", .var = NULL, + .df_row = NULL, is_event, control = control_surv_time(), .stats = NULL, diff --git a/man/survival_time.Rd b/man/survival_time.Rd index f479c4e9f8..852faa7461 100644 --- a/man/survival_time.Rd +++ b/man/survival_time.Rd @@ -13,6 +13,7 @@ a_surv_time( df, labelstr = "", .var = NULL, + .df_row = NULL, is_event, control = control_surv_time(), .stats = NULL, @@ -58,6 +59,8 @@ see more in \code{\link[survival:survfit]{survival::survfit()}}. Note option "no (must be present as second argument in Content Row Functions). See \code{\link[rtables:summarize_row_groups]{rtables::summarize_row_groups()}} for more information.} +\item{.df_row}{(\code{data.frame})\cr data frame across all of the columns for the given row split.} + \item{.stats}{(\code{character})\cr statistics to select for the table.} \item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more From e4137029fdf1af58a783fed5864caa6b2b955795 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 2 Nov 2023 13:10:02 -0400 Subject: [PATCH 12/25] Simplify get_* functions, add fun labels_apply_control --- R/utils_default_stats_formats_labels.R | 122 ++++++++++++------------- man/default_stats_formats_labels.Rd | 43 +++++---- 2 files changed, 86 insertions(+), 79 deletions(-) diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 424168df7b..8a9d2cffb8 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -162,7 +162,7 @@ get_stats <- function(method_groups = "analyze_vars_numeric", stats_in = NULL, a #' @seealso [formatting_functions] #' #' @export -get_formats_from_stats <- function(stats, formats_in = NULL, method = NULL) { +get_formats_from_stats <- function(stats, formats_in = NULL) { checkmate::assert_character(stats, min.len = 1) # It may be a list if there is a function in the formats if (checkmate::test_list(formats_in, null.ok = TRUE)) { @@ -172,20 +172,14 @@ get_formats_from_stats <- function(stats, formats_in = NULL, method = NULL) { checkmate::assert_character(formats_in, null.ok = TRUE) } - out <- setNames(vector("list", length = length(stats)), stats) # Returning a list is simpler - # Extract global defaults which_fmt <- match(stats, names(tern_default_formats)) # Select only needed formats from stats - out[!is.na(which_fmt)] <- tern_default_formats[which_fmt[!is.na(which_fmt)]] + ret <- vector("list", length = length(stats)) # Returning a list is simpler + ret[!is.na(which_fmt)] <- tern_default_formats[which_fmt[!is.na(which_fmt)]] - # Extract any method-specific formats - if (!is.null(method) && method %in% names(tern_default_formats)) { - which_mthd_fmt <- match(stats, names(tern_default_formats[[method]])) - # Select only needed formats from stats - out[!is.na(which_mthd_fmt)] <- tern_default_formats[[method]][which_mthd_fmt[!is.na(which_mthd_fmt)]] - } + out <- setNames(ret, stats) # Modify some with custom formats if (!is.null(formats_in)) { @@ -205,12 +199,6 @@ get_formats_from_stats <- function(stats, formats_in = NULL, method = NULL) { #' variable levels will be used as the defaults, and the names of the given custom values should #' correspond to levels (or have format `statistic.level`) instead of statistics. Can also be #' variable names if rows correspond to different variables instead of levels. Defaults to `NULL`. -#' @param method (`character`) name of statistical method group from which to draw alternative -#' default formats from. E.g. For `method = "surv_time"`, the default label for `range` is -#' `"Range"` instead of the tern default, `"Min - Max"`. -#' @param control (named `list`) list of control parameters to apply to automatically adjust -#' default labels. E.g. If control has element `conf_level` set to `0.9`, the default label for -#' statistic `mean_ci` will become `"Mean 90% CI"`. #' #' @return #' * `get_labels_from_stats()` returns a named character vector of default labels (if present @@ -228,7 +216,7 @@ get_formats_from_stats <- function(stats, formats_in = NULL, method = NULL) { #' get_labels_from_stats(all_cnt_occ, labels_in = list("fraction" = c("Some more fractions"))) #' #' @export -get_labels_from_stats <- function(stats, labels_in = NULL, row_nms = NULL, method = NULL, control = NULL) { +get_labels_from_stats <- function(stats, labels_in = NULL, row_nms = NULL) { checkmate::assert_character(stats, min.len = 1) checkmate::assert_character(row_nms, null.ok = TRUE) # It may be a list @@ -248,38 +236,12 @@ get_labels_from_stats <- function(stats, labels_in = NULL, row_nms = NULL, metho for (i in lvl_lbls) out[paste(stats, i, sep = ".")] <- labels_in[[i]] } } else { - out <- setNames(vector("character", length = length(stats)), stats) # it needs to be a character vector - - # Extract global defaults which_lbl <- match(stats, names(tern_default_labels)) - # Select only needed formats from stats - out[!is.na(which_lbl)] <- tern_default_labels[which_lbl[!is.na(which_lbl)]] - - # Extract any method-specific labels - if (!is.null(method) && method %in% names(tern_default_labels)) { - which_mthd_lbl <- match(stats, names(tern_default_labels[[method]])) - # Select only needed formats from stats - out[!is.na(which_mthd_lbl)] <- tern_default_labels[[method]][which_mthd_lbl[!is.na(which_mthd_lbl)]] - } - } + ret <- vector("character", length = length(stats)) # it needs to be a character vector + ret[!is.na(which_lbl)] <- tern_default_labels[which_lbl[!is.na(which_lbl)]] - # Change defaults for labels with control specs - if (!is.null(control)) { - if ("conf_level" %in% names(control)) { - out <- lapply(out, gsub, pattern = "[0-9]+% CI", replacement = f_conf_level(control[["conf_level"]])) - } - if ("quantiles" %in% names(control)) { - out[["quantiles"]] <- gsub( - "[0-9]+% and [0-9]+", paste0(control[["quantiles"]][1] * 100, "% and ", control[["quantiles"]][2] * 100, ""), - out[["quantiles"]] - ) - } - if ("mean_pval" %in% names(control)) { - out[["mean_pval"]] <- gsub( - "p-value \\(H0: mean = [0-9\\.]+\\)", f_pval(control[["conf_level"]]), out[["mean_pval"]] - ) - } + out <- setNames(ret, stats) } # Modify some with custom labels @@ -289,7 +251,7 @@ get_labels_from_stats <- function(stats, labels_in = NULL, row_nms = NULL, metho out[common_names] <- labels_in[common_names] } - unlist(out) + out } #' @describeIn default_stats_formats_labels Format indent modifiers for a given vector/list of statistics. @@ -348,12 +310,57 @@ get_indents_from_stats <- function(stats, indents_in = NULL, row_nms = NULL) { out } +#' @describeIn default_stats_formats_labels Update default labels according to control specifications. +#' +#' @param labels_default (named `vector` of `character`)\cr a named vector of statistic labels to modify +#' according to the control specifications. Labels that are are explicitly defined in `labels_in` will +#' not be affected. +#' @param control (named `list`)\cr list of control parameters to apply to adjust default labels. +#' E.g. If control has element `conf_level` set to `0.9`, the default label for +#' statistic `mean_ci` will become `"Mean 90% CI"`. +#' +#' @return +#' * `labels_apply_control()` returns a named character vector of labels with control specifications +#' applied to relevant labels. +#' +#' @examples +#' control <- list(conf_level = 0.80, quantiles = c(0.1, 0.83), test_mean = 0.57) +#' get_labels_from_stats(c("mean_ci", "quantiles", "mean_pval")) %>% labels_apply_control(control = control) +#' +labels_apply_control <- function(labels_default, labels_in = NULL, control) { + if ("conf_level" %in% names(control)) { + labels_default <- sapply( + names(labels_default), + function(x) { + if (!x %in% names(labels_in)) { + gsub(labels_default[[x]], pattern = "[0-9]+% CI", replacement = f_conf_level(control[["conf_level"]])) + } else { + labels_default[[x]] + } + } + ) + } + if ("quantiles" %in% names(control) && !"quantiles" %in% names(labels_in)) { + labels_default["quantiles"] <- gsub( + "[0-9]+% and [0-9]+", paste0(control[["quantiles"]][1] * 100, "% and ", control[["quantiles"]][2] * 100, ""), + labels_default["quantiles"] + ) + } + if ("test_mean" %in% names(control) && !"mean_pval" %in% names(labels_in)) { + labels_default["mean_pval"] <- gsub( + "p-value \\(H0: mean = [0-9\\.]+\\)", f_pval(control[["test_mean"]]), labels_default["mean_pval"] + ) + } + + labels_default +} + #' @describeIn default_stats_formats_labels Named list of default formats for `tern`. #' @format #' * `tern_default_formats` is a list of available formats, named after their relevant #' statistic. #' @export -tern_default_formats <- list( +tern_default_formats <- c( fraction = format_fraction_fixed_dp, unique = format_count_fraction_fixed_dp, nonunique = "xx", @@ -388,13 +395,8 @@ tern_default_formats <- list( geom_cv = "xx.x", pval = "x.xxxx | (<0.0001)", pval_counts = "x.xxxx | (<0.0001)", - surv_time = list( - median_ci = "(xx.x, xx.x)", - quantiles = "xx.x, xx.x", - range_censor = "xx.x to xx.x", - range_event = "xx.x to xx.x", - range = "xx.x to xx.x" - ) + range_censor = "xx.x to xx.x", + range_event = "xx.x to xx.x" ) #' @describeIn default_stats_formats_labels `character` vector that contains default labels @@ -403,7 +405,7 @@ tern_default_formats <- list( #' * `tern_default_labels` is a character vector of available labels, named after their relevant #' statistic. #' @export -tern_default_labels <- list( +tern_default_labels <- c( # list of labels -> sorted? xxx it should be not relevant due to match fraction = "fraction", unique = "Number of patients with at least one event", @@ -437,13 +439,7 @@ tern_default_labels <- list( geom_mean_ci = "Geometric Mean 95% CI", geom_cv = "CV % Geometric Mean", pval = "p-value (t-test)", # Default for numeric - pval_counts = "p-value (chi-squared test)", # Default for counts - surv_time = list( - median_ci = "95% CI", - range = "Range", - range_censor = "Range (censored)", - range_event = "Range (event)" - ) + pval_counts = "p-value (chi-squared test)" # Default for counts ) # To deprecate --------- diff --git a/man/default_stats_formats_labels.Rd b/man/default_stats_formats_labels.Rd index 52c4e26207..6ea637ef35 100644 --- a/man/default_stats_formats_labels.Rd +++ b/man/default_stats_formats_labels.Rd @@ -7,6 +7,7 @@ \alias{get_formats_from_stats} \alias{get_labels_from_stats} \alias{get_indents_from_stats} +\alias{labels_apply_control} \alias{tern_default_formats} \alias{tern_default_labels} \alias{summary_formats} @@ -31,18 +32,14 @@ get_stats( add_pval = FALSE ) -get_formats_from_stats(stats, formats_in = NULL, method = NULL) +get_formats_from_stats(stats, formats_in = NULL) -get_labels_from_stats( - stats, - labels_in = NULL, - row_nms = NULL, - method = NULL, - control = NULL -) +get_labels_from_stats(stats, labels_in = NULL, row_nms = NULL) get_indents_from_stats(stats, indents_in = NULL, row_nms = NULL) +labels_apply_control(labels_default, labels_in = NULL, control) + tern_default_formats tern_default_labels @@ -75,10 +72,6 @@ methods.} \item{formats_in}{(named \code{vector}) \cr inserted formats to replace defaults. It can be a character vector from \code{\link[formatters:list_formats]{formatters::list_valid_format_labels()}} or a custom format function.} -\item{method}{(\code{character}) name of statistical method group from which to draw alternative -default formats from. E.g. For \code{method = "surv_time"}, the default label for \code{range} is -\code{"Range"} instead of the tern default, \code{"Min - Max"}.} - \item{labels_in}{(named \code{vector})\cr inserted labels to replace defaults.} \item{row_nms}{(\code{character})\cr row names. Levels of a \code{factor} or \code{character} variable, each @@ -87,12 +80,16 @@ variable levels will be used as the defaults, and the names of the given custom correspond to levels (or have format \code{statistic.level}) instead of statistics. Can also be variable names if rows correspond to different variables instead of levels. Defaults to \code{NULL}.} -\item{control}{(named \code{list}) list of control parameters to apply to automatically adjust -default labels. E.g. If control has element \code{conf_level} set to \code{0.9}, the default label for -statistic \code{mean_ci} will become \code{"Mean 90\% CI"}.} - \item{indents_in}{(named \code{vector})\cr inserted indent modifiers to replace defaults (default is \code{0L}).} +\item{labels_default}{(named \code{vector} of \code{character})\cr a named vector of statistic labels to modify +according to the control specifications. Labels that are are explicitly defined in \code{labels_in} will +not be affected.} + +\item{control}{(named \code{list})\cr list of control parameters to apply to adjust default labels. +E.g. If control has element \code{conf_level} set to \code{0.9}, the default label for +statistic \code{mean_ci} will become \code{"Mean 90\% CI"}.} + \item{type}{(\code{flag})\cr is it going to be \code{"numeric"} or \code{"counts"}?} \item{include_pval}{(\code{flag})\cr deprecated parameter. Same as \code{add_pval}.} @@ -114,6 +111,10 @@ indentation modifiers for statistics to use instead of the default of \code{0L} Names should be a subset of the statistics defined in \code{stats_custom} (or default statistics if this is \code{NULL}). Alternatively, the same indentation modifier can be applied to all statistics by setting \code{indent_mods_custom} to a single integer value.} + +\item{method}{(\code{character}) name of statistical method group from which to draw alternative +default formats from. E.g. For \code{method = "surv_time"}, the default format for \code{range} is +\code{"xx.x to xx.x"} instead of the tern default, \code{"xx.x - xx.x"}.} } \value{ \itemize{ @@ -135,6 +136,11 @@ otherwise \code{NULL}). or a named numeric vector of indent modifiers (if present, otherwise \code{NULL}). } +\itemize{ +\item \code{labels_apply_control()} returns a named character vector of labels with control specifications +applied to relevant labels. +} + \itemize{ \item \code{summary_formats()} returns a named \code{vector} of default statistic formats for the given data type. } @@ -171,6 +177,8 @@ present \code{NULL} is returned. \item \code{get_indents_from_stats()}: Format indent modifiers for a given vector/list of statistics. +\item \code{labels_apply_control()}: Update default labels according to control specifications. + \item \code{tern_default_formats}: Named list of default formats for \code{tern}. \item \code{tern_default_labels}: \code{character} vector that contains default labels @@ -238,6 +246,9 @@ get_indents_from_stats( indents_in = list(a = 2L, count.a = 1L, count.b = 5L), row_nms = c("a", "b") ) +control <- list(conf_level = 0.80, quantiles = c(0.1, 0.83), test_mean = 0.57) +get_labels_from_stats(c("mean_ci", "quantiles", "mean_pval")) \%>\% labels_apply_control(control = control) + summary_formats() summary_formats(type = "counts", include_pval = TRUE) From 5fabc23b563fa44401ad1fb5dd66a4b97dc2a31a Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 2 Nov 2023 15:35:05 -0400 Subject: [PATCH 13/25] Add internal utility function for auto formatting --- R/formatting_functions.R | 20 ++++++++++++++++++++ man/apply_auto_formatting.Rd | 25 +++++++++++++++++++++++++ 2 files changed, 45 insertions(+) create mode 100644 man/apply_auto_formatting.Rd diff --git a/R/formatting_functions.R b/R/formatting_functions.R index 37057a90e9..7a6d657176 100644 --- a/R/formatting_functions.R +++ b/R/formatting_functions.R @@ -554,3 +554,23 @@ count_decimalplaces <- function(dec) { return(0) } } + +#' Apply Auto Formatting +#' +#' Checks if any of the listed formats in `.formats` are `"auto"`, and replaces `"auto"` with +#' the correct implementation of `format_auto` for the given statistics, data, and variable. +#' +#' @inheritParams argument_convention +#' @param x_stats (named `list`)\cr a named list of statistics where each element corresponds +#' to an element in `.formats`, with matching names. +#' +#' @keywords internal +apply_auto_formatting <- function(.formats, x_stats, .df_row, .var) { + is_auto_fmt <- vapply(.formats, function(ii) is.character(ii) && ii == "auto", logical(1)) + if (any(is_auto_fmt)) { + auto_stats <- x_stats[is_auto_fmt] + var_df <- .df_row[[.var]] # xxx this can be extended for the WHOLE data or single facets + .formats[is_auto_fmt] <- lapply(names(auto_stats), format_auto, dt_var = var_df) + } + .formats +} diff --git a/man/apply_auto_formatting.Rd b/man/apply_auto_formatting.Rd new file mode 100644 index 0000000000..8ca9500162 --- /dev/null +++ b/man/apply_auto_formatting.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/formatting_functions.R +\name{apply_auto_formatting} +\alias{apply_auto_formatting} +\title{Apply Auto Formatting} +\usage{ +apply_auto_formatting(.formats, x_stats, .df_row, .var) +} +\arguments{ +\item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more +information on the \code{"auto"} setting.} + +\item{x_stats}{(named \code{list})\cr a named list of statistics where each element corresponds +to an element in \code{.formats}, with matching names.} + +\item{.df_row}{(\code{data.frame})\cr data frame across all of the columns for the given row split.} + +\item{.var}{(\code{string})\cr single variable name that is passed by \code{rtables} when requested +by a statistics function.} +} +\description{ +Checks if any of the listed formats in \code{.formats} are \code{"auto"}, and replaces \code{"auto"} with +the correct implementation of \code{format_auto} for the given statistics, data, and variable. +} +\keyword{internal} From c54e12b73adee078aab7f89bab0d5c0088c095c0 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 2 Nov 2023 15:35:30 -0400 Subject: [PATCH 14/25] Fix defaults in a_surv_time --- R/survival_time.R | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/R/survival_time.R b/R/survival_time.R index ab36b86362..ba1dc6e944 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -104,23 +104,22 @@ a_surv_time <- function(df, rng_censor_lwr <- x_stats[["range_censor"]][1] rng_censor_upr <- x_stats[["range_censor"]][2] + # Use method-specific defaults + fmts <- c(median_ci = "(xx.x, xx.x)", quantiles = "xx.x, xx.x", range = "xx.x to xx.x") + lbls <- c(median_ci = "95% CI", range = "Range", range_censor = "Range (censored)", range_event = "Range (event)") + .formats <- c(.formats, fmts[setdiff(names(fmts), names(.formats))]) + .labels <- c(.labels, lbls[setdiff(names(lbls), names(.labels))]) + # Fill in with formatting defaults if needed .stats <- get_stats("surv_time", stats_in = .stats) - .formats <- get_formats_from_stats(.stats, .formats, method = "surv_time") - .labels <- get_labels_from_stats(.stats, .labels, method = "surv_time", control = control) + .formats <- get_formats_from_stats(.stats, .formats) + .labels <- get_labels_from_stats(.stats, .labels) %>% labels_apply_control(.labels, control) .indent_mods <- get_indents_from_stats(.stats, .indent_mods) x_stats <- x_stats[.stats] # Auto format handling - fmt_is_auto <- vapply(.formats, function(ii) is.character(ii) && ii == "auto", logical(1)) - if (any(fmt_is_auto)) { - res_l_auto <- x_stats[fmt_is_auto] - tmp_dt_var <- .df_row[[.var]] # xxx this can be extended for the WHOLE data or single facets - .formats[fmt_is_auto] <- lapply(seq_along(res_l_auto), function(rla) { - format_auto(tmp_dt_var, names(res_l_auto)[rla]) - }) - } + .formats <- apply_auto_formatting(.formats, x_stats, .df_row, .var) cell_fns <- setNames(vector("list", length = length(x_stats)), .labels) if ("range" %in% names(x_stats)) { From fdad6b6f86436daedcb406d4d286de1b06aa9b94 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 2 Nov 2023 15:57:32 -0400 Subject: [PATCH 15/25] Improve documentation --- R/survival_time.R | 2 +- R/utils_default_stats_formats_labels.R | 48 +++++++++++++++----------- man/default_stats_formats_labels.Rd | 34 ++++-------------- man/labels_apply_control.Rd | 35 +++++++++++++++++++ 4 files changed, 70 insertions(+), 49 deletions(-) create mode 100644 man/labels_apply_control.Rd diff --git a/R/survival_time.R b/R/survival_time.R index ba1dc6e944..6e4aa046ee 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -113,7 +113,7 @@ a_surv_time <- function(df, # Fill in with formatting defaults if needed .stats <- get_stats("surv_time", stats_in = .stats) .formats <- get_formats_from_stats(.stats, .formats) - .labels <- get_labels_from_stats(.stats, .labels) %>% labels_apply_control(.labels, control) + .labels <- get_labels_from_stats(.stats, .labels) %>% labels_apply_control(control, .labels) .indent_mods <- get_indents_from_stats(.stats, .indent_mods) x_stats <- x_stats[.stats] diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 8a9d2cffb8..5a86147df0 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -310,29 +310,35 @@ get_indents_from_stats <- function(stats, indents_in = NULL, row_nms = NULL) { out } -#' @describeIn default_stats_formats_labels Update default labels according to control specifications. +#' Update Labels According to Control Specifications +#' +#' @description `r lifecycle::badge("stable")` +#' +#' Given a list of statistic labels and and a list of control parameters, updates labels with a relevant +#' control specification. For example, if control has element `conf_level` set to `0.9`, the default +#' label for statistic `mean_ci` will be updated to `"Mean 90% CI"`. Any labels that are supplied +#' via `labels_custom` will not be updated regardless of `control`. #' #' @param labels_default (named `vector` of `character`)\cr a named vector of statistic labels to modify -#' according to the control specifications. Labels that are are explicitly defined in `labels_in` will +#' according to the control specifications. Labels that are explicitly defined in `labels_custom` will #' not be affected. +#' @param labels_custom (named `vector` of `character`)\cr named vector of labels that are customized by +#' the user and should not be affected by `control`. #' @param control (named `list`)\cr list of control parameters to apply to adjust default labels. -#' E.g. If control has element `conf_level` set to `0.9`, the default label for -#' statistic `mean_ci` will become `"Mean 90% CI"`. #' -#' @return -#' * `labels_apply_control()` returns a named character vector of labels with control specifications -#' applied to relevant labels. +#' @return A named character vector of labels with control specifications applied to relevant labels. #' #' @examples #' control <- list(conf_level = 0.80, quantiles = c(0.1, 0.83), test_mean = 0.57) -#' get_labels_from_stats(c("mean_ci", "quantiles", "mean_pval")) %>% labels_apply_control(control = control) +#' get_labels_from_stats(c("mean_ci", "quantiles", "mean_pval")) %>% +#' labels_apply_control(control = control) #' -labels_apply_control <- function(labels_default, labels_in = NULL, control) { +labels_apply_control <- function(labels_default, control, labels_custom = NULL) { if ("conf_level" %in% names(control)) { labels_default <- sapply( names(labels_default), function(x) { - if (!x %in% names(labels_in)) { + if (!x %in% names(labels_custom)) { gsub(labels_default[[x]], pattern = "[0-9]+% CI", replacement = f_conf_level(control[["conf_level"]])) } else { labels_default[[x]] @@ -340,13 +346,13 @@ labels_apply_control <- function(labels_default, labels_in = NULL, control) { } ) } - if ("quantiles" %in% names(control) && !"quantiles" %in% names(labels_in)) { + if ("quantiles" %in% names(control) && !"quantiles" %in% names(labels_custom)) { labels_default["quantiles"] <- gsub( "[0-9]+% and [0-9]+", paste0(control[["quantiles"]][1] * 100, "% and ", control[["quantiles"]][2] * 100, ""), labels_default["quantiles"] ) } - if ("test_mean" %in% names(control) && !"mean_pval" %in% names(labels_in)) { + if ("test_mean" %in% names(control) && !"mean_pval" %in% names(labels_custom)) { labels_default["mean_pval"] <- gsub( "p-value \\(H0: mean = [0-9\\.]+\\)", f_pval(control[["test_mean"]]), labels_default["mean_pval"] ) @@ -355,10 +361,12 @@ labels_apply_control <- function(labels_default, labels_in = NULL, control) { labels_default } -#' @describeIn default_stats_formats_labels Named list of default formats for `tern`. +#' @describeIn default_stats_formats_labels Named vector of default formats for `tern`. +#' #' @format -#' * `tern_default_formats` is a list of available formats, named after their relevant -#' statistic. +#' * `tern_default_formats` is a named vector of available default formats, with each element +#' named for their corresponding statistic. +#' #' @export tern_default_formats <- c( fraction = format_fraction_fixed_dp, @@ -399,14 +407,14 @@ tern_default_formats <- c( range_event = "xx.x to xx.x" ) -#' @describeIn default_stats_formats_labels `character` vector that contains default labels -#' for `tern`. +#' @describeIn default_stats_formats_labels Named `character` vector of default labels for `tern`. +#' #' @format -#' * `tern_default_labels` is a character vector of available labels, named after their relevant -#' statistic. +#' * `tern_default_labels` is a named `character` vector of available default labels, with each element +#' named for their corresponding statistic. +#' #' @export tern_default_labels <- c( - # list of labels -> sorted? xxx it should be not relevant due to match fraction = "fraction", unique = "Number of patients with at least one event", nonunique = "Number of events", diff --git a/man/default_stats_formats_labels.Rd b/man/default_stats_formats_labels.Rd index 6ea637ef35..ab576c4c59 100644 --- a/man/default_stats_formats_labels.Rd +++ b/man/default_stats_formats_labels.Rd @@ -7,7 +7,6 @@ \alias{get_formats_from_stats} \alias{get_labels_from_stats} \alias{get_indents_from_stats} -\alias{labels_apply_control} \alias{tern_default_formats} \alias{tern_default_labels} \alias{summary_formats} @@ -16,13 +15,13 @@ \title{Defaults for statistical method names and their associated formats & labels} \format{ \itemize{ -\item \code{tern_default_formats} is a list of available formats, named after their relevant -statistic. +\item \code{tern_default_formats} is a named vector of available default formats, with each element +named for their corresponding statistic. } \itemize{ -\item \code{tern_default_labels} is a character vector of available labels, named after their relevant -statistic. +\item \code{tern_default_labels} is a named \code{character} vector of available default labels, with each element +named for their corresponding statistic. } } \usage{ @@ -38,8 +37,6 @@ get_labels_from_stats(stats, labels_in = NULL, row_nms = NULL) get_indents_from_stats(stats, indents_in = NULL, row_nms = NULL) -labels_apply_control(labels_default, labels_in = NULL, control) - tern_default_formats tern_default_labels @@ -82,14 +79,6 @@ variable names if rows correspond to different variables instead of levels. Defa \item{indents_in}{(named \code{vector})\cr inserted indent modifiers to replace defaults (default is \code{0L}).} -\item{labels_default}{(named \code{vector} of \code{character})\cr a named vector of statistic labels to modify -according to the control specifications. Labels that are are explicitly defined in \code{labels_in} will -not be affected.} - -\item{control}{(named \code{list})\cr list of control parameters to apply to adjust default labels. -E.g. If control has element \code{conf_level} set to \code{0.9}, the default label for -statistic \code{mean_ci} will become \code{"Mean 90\% CI"}.} - \item{type}{(\code{flag})\cr is it going to be \code{"numeric"} or \code{"counts"}?} \item{include_pval}{(\code{flag})\cr deprecated parameter. Same as \code{add_pval}.} @@ -136,11 +125,6 @@ otherwise \code{NULL}). or a named numeric vector of indent modifiers (if present, otherwise \code{NULL}). } -\itemize{ -\item \code{labels_apply_control()} returns a named character vector of labels with control specifications -applied to relevant labels. -} - \itemize{ \item \code{summary_formats()} returns a named \code{vector} of default statistic formats for the given data type. } @@ -177,12 +161,9 @@ present \code{NULL} is returned. \item \code{get_indents_from_stats()}: Format indent modifiers for a given vector/list of statistics. -\item \code{labels_apply_control()}: Update default labels according to control specifications. +\item \code{tern_default_formats}: Named vector of default formats for \code{tern}. -\item \code{tern_default_formats}: Named list of default formats for \code{tern}. - -\item \code{tern_default_labels}: \code{character} vector that contains default labels -for \code{tern}. +\item \code{tern_default_labels}: Named \code{character} vector of default labels for \code{tern}. \item \code{summary_formats()}: Quick function to retrieve default formats for summary statistics: \code{\link[=analyze_vars]{analyze_vars()}} and \code{\link[=analyze_vars_in_cols]{analyze_vars_in_cols()}} principally. @@ -246,9 +227,6 @@ get_indents_from_stats( indents_in = list(a = 2L, count.a = 1L, count.b = 5L), row_nms = c("a", "b") ) -control <- list(conf_level = 0.80, quantiles = c(0.1, 0.83), test_mean = 0.57) -get_labels_from_stats(c("mean_ci", "quantiles", "mean_pval")) \%>\% labels_apply_control(control = control) - summary_formats() summary_formats(type = "counts", include_pval = TRUE) diff --git a/man/labels_apply_control.Rd b/man/labels_apply_control.Rd new file mode 100644 index 0000000000..35f35f496e --- /dev/null +++ b/man/labels_apply_control.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils_default_stats_formats_labels.R +\name{labels_apply_control} +\alias{labels_apply_control} +\title{Update Labels According to Control Specifications} +\usage{ +labels_apply_control(labels_default, control, labels_custom = NULL) +} +\arguments{ +\item{labels_default}{(named \code{vector} of \code{character})\cr a named vector of statistic labels to modify +according to the control specifications. Labels that are explicitly defined in \code{labels_custom} will +not be affected.} + +\item{control}{(named \code{list})\cr list of control parameters to apply to adjust default labels.} + +\item{labels_custom}{(named \code{vector} of \code{character})\cr named vector of labels that are customized by +the user and should not be affected by \code{control}.} +} +\value{ +A named character vector of labels with control specifications applied to relevant labels. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} + +Given a list of statistic labels and and a list of control parameters, updates labels with a relevant +control specification. For example, if control has element \code{conf_level} set to \code{0.9}, the default +label for statistic \code{mean_ci} will be updated to \code{"Mean 90\% CI"}. Any labels that are supplied +via \code{labels_custom} will not be updated regardless of \code{control}. +} +\examples{ +control <- list(conf_level = 0.80, quantiles = c(0.1, 0.83), test_mean = 0.57) +get_labels_from_stats(c("mean_ci", "quantiles", "mean_pval")) \%>\% + labels_apply_control(control = control) + +} From dcb914980585be944c02ecd3e637ce5a0623fc79 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 2 Nov 2023 18:22:14 -0400 Subject: [PATCH 16/25] Clean up control util --- R/utils_default_stats_formats_labels.R | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 5a86147df0..05536805b6 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -331,9 +331,10 @@ get_indents_from_stats <- function(stats, indents_in = NULL, row_nms = NULL) { #' @examples #' control <- list(conf_level = 0.80, quantiles = c(0.1, 0.83), test_mean = 0.57) #' get_labels_from_stats(c("mean_ci", "quantiles", "mean_pval")) %>% -#' labels_apply_control(control = control) +#' labels_use_control(control = control) #' -labels_apply_control <- function(labels_default, control, labels_custom = NULL) { +#' @export +labels_use_control <- function(labels_default, control, labels_custom = NULL) { if ("conf_level" %in% names(control)) { labels_default <- sapply( names(labels_default), @@ -346,13 +347,15 @@ labels_apply_control <- function(labels_default, control, labels_custom = NULL) } ) } - if ("quantiles" %in% names(control) && !"quantiles" %in% names(labels_custom)) { + if ("quantiles" %in% names(control) && "quantiles" %in% names(labels_default) && + !"quantiles" %in% names(labels_custom)) { # nolint labels_default["quantiles"] <- gsub( "[0-9]+% and [0-9]+", paste0(control[["quantiles"]][1] * 100, "% and ", control[["quantiles"]][2] * 100, ""), labels_default["quantiles"] ) } - if ("test_mean" %in% names(control) && !"mean_pval" %in% names(labels_custom)) { + if ("test_mean" %in% names(control) && "mean_pval" %in% names(labels_default) && + !"mean_pval" %in% names(labels_custom)) { # nolint labels_default["mean_pval"] <- gsub( "p-value \\(H0: mean = [0-9\\.]+\\)", f_pval(control[["test_mean"]]), labels_default["mean_pval"] ) From 81daa5e90ab49476df53729747951faa6c7ad715 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 2 Nov 2023 18:25:46 -0400 Subject: [PATCH 17/25] Update surv_time after separating PRs --- NEWS.md | 4 ---- R/survival_time.R | 5 +---- 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/NEWS.md b/NEWS.md index 0db9b5f8f3..e518dba1cd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,10 +8,6 @@ * Added summarize function version of `count_occurrences` analyze function, `summarize_occurrences`. * Added referential footnotes to `surv_time` for censored range observations. -### Enhancements -* Updated `get_formats_from_stats` and `get_labels_from_stats` with added `method` parameter to retrieve method-specific defaults. -* Updated `get_labels_from_stats` with added `control` parameter to auto-adjust default labels based on statistic control parameters. - ### Miscellaneous * Specified minimal version of package dependencies. diff --git a/R/survival_time.R b/R/survival_time.R index 6e4aa046ee..c75f0d5508 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -98,9 +98,6 @@ a_surv_time <- function(df, x_stats <- s_surv_time( df = df, .var = .var, is_event = is_event, control = control ) - if (is.null(unlist(x_stats))) { - return(NULL) - } rng_censor_lwr <- x_stats[["range_censor"]][1] rng_censor_upr <- x_stats[["range_censor"]][2] @@ -113,7 +110,7 @@ a_surv_time <- function(df, # Fill in with formatting defaults if needed .stats <- get_stats("surv_time", stats_in = .stats) .formats <- get_formats_from_stats(.stats, .formats) - .labels <- get_labels_from_stats(.stats, .labels) %>% labels_apply_control(control, .labels) + .labels <- get_labels_from_stats(.stats, .labels) %>% labels_use_control(control, .labels) .indent_mods <- get_indents_from_stats(.stats, .indent_mods) x_stats <- x_stats[.stats] From 130be5c237c1f0c75f9cb9b82144fd0deb751628 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 2 Nov 2023 18:32:36 -0400 Subject: [PATCH 18/25] Bypass method-specific labels when applying control to labels --- R/survival_time.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/survival_time.R b/R/survival_time.R index c75f0d5508..19aa5e2be5 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -104,13 +104,14 @@ a_surv_time <- function(df, # Use method-specific defaults fmts <- c(median_ci = "(xx.x, xx.x)", quantiles = "xx.x, xx.x", range = "xx.x to xx.x") lbls <- c(median_ci = "95% CI", range = "Range", range_censor = "Range (censored)", range_event = "Range (event)") + lbls_custom <- .labels .formats <- c(.formats, fmts[setdiff(names(fmts), names(.formats))]) - .labels <- c(.labels, lbls[setdiff(names(lbls), names(.labels))]) + .labels <- c(.labels, lbls[setdiff(names(lbls), names(lbls_custom))]) # Fill in with formatting defaults if needed .stats <- get_stats("surv_time", stats_in = .stats) .formats <- get_formats_from_stats(.stats, .formats) - .labels <- get_labels_from_stats(.stats, .labels) %>% labels_use_control(control, .labels) + .labels <- get_labels_from_stats(.stats, .labels) %>% labels_use_control(control, lbls_custom) .indent_mods <- get_indents_from_stats(.stats, .indent_mods) x_stats <- x_stats[.stats] From c362b5e6023d491700c7cf6a0bd9e99841c707e5 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 2 Nov 2023 19:13:15 -0400 Subject: [PATCH 19/25] Add tests, example --- NAMESPACE | 2 + R/formatting_functions.R | 3 +- R/survival_time.R | 10 +++- ...apply_control.Rd => labels_use_control.Rd} | 8 ++-- man/survival_time.Rd | 7 +++ tests/testthat/_snaps/survival_time.md | 27 +++++++++++ tests/testthat/test-survival_time.R | 46 +++++++++++++++++++ 7 files changed, 97 insertions(+), 6 deletions(-) rename man/{labels_apply_control.Rd => labels_use_control.Rd} (90%) diff --git a/NAMESPACE b/NAMESPACE index c6396b4d69..2a46e1d2d5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -34,6 +34,7 @@ export(a_odds_ratio) export(a_proportion) export(a_proportion_diff) export(a_summary) +export(a_surv_time) export(add_riskdiff) export(add_rowcounts) export(aesi_label) @@ -219,6 +220,7 @@ export(has_fractions_difference) export(imputation_rule) export(keep_content_rows) export(keep_rows) +export(labels_use_control) export(level_order) export(logistic_regression_cols) export(logistic_summary_by_flag) diff --git a/R/formatting_functions.R b/R/formatting_functions.R index 7a6d657176..95a9c6724b 100644 --- a/R/formatting_functions.R +++ b/R/formatting_functions.R @@ -499,7 +499,8 @@ format_auto <- function(dt_var, x_stat) { # Defaults - they may be a param in the future der_stats <- c( "mean", "sd", "se", "median", "geom_mean", "quantiles", "iqr", - "mean_sd", "mean_se", "mean_se", "mean_ci", "mean_sei", "mean_sdi" + "mean_sd", "mean_se", "mean_se", "mean_ci", "mean_sei", "mean_sdi", + "median_ci" ) nonder_stats <- c("n", "range", "min", "max") diff --git a/R/survival_time.R b/R/survival_time.R index 19aa5e2be5..4d2c3268f4 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -83,7 +83,15 @@ s_surv_time <- function(df, #' @return #' * `a_surv_time()` returns the corresponding list with formatted [rtables::CellValue()]. #' -#' @keywords internal +#' @examples +#' a_surv_time( +#' df, +#' .df_row = df, +#' .var = "AVAL", +#' is_event = "is_event" +#' ) +#' +#' @export a_surv_time <- function(df, labelstr = "", .var = NULL, diff --git a/man/labels_apply_control.Rd b/man/labels_use_control.Rd similarity index 90% rename from man/labels_apply_control.Rd rename to man/labels_use_control.Rd index 35f35f496e..a4c6c50f01 100644 --- a/man/labels_apply_control.Rd +++ b/man/labels_use_control.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils_default_stats_formats_labels.R -\name{labels_apply_control} -\alias{labels_apply_control} +\name{labels_use_control} +\alias{labels_use_control} \title{Update Labels According to Control Specifications} \usage{ -labels_apply_control(labels_default, control, labels_custom = NULL) +labels_use_control(labels_default, control, labels_custom = NULL) } \arguments{ \item{labels_default}{(named \code{vector} of \code{character})\cr a named vector of statistic labels to modify @@ -30,6 +30,6 @@ via \code{labels_custom} will not be updated regardless of \code{control}. \examples{ control <- list(conf_level = 0.80, quantiles = c(0.1, 0.83), test_mean = 0.57) get_labels_from_stats(c("mean_ci", "quantiles", "mean_pval")) \%>\% - labels_apply_control(control = control) + labels_use_control(control = control) } diff --git a/man/survival_time.Rd b/man/survival_time.Rd index 852faa7461..b49cb60a79 100644 --- a/man/survival_time.Rd +++ b/man/survival_time.Rd @@ -141,6 +141,13 @@ adtte_f <- tern_ex_adtte \%>\% ) df <- adtte_f \%>\% filter(ARMCD == "ARM A") +a_surv_time( + df, + .df_row = df, + .var = "AVAL", + is_event = "is_event" +) + basic_table() \%>\% split_cols_by(var = "ARMCD") \%>\% add_colcounts() \%>\% diff --git a/tests/testthat/_snaps/survival_time.md b/tests/testthat/_snaps/survival_time.md index 4f388b9237..a80456d070 100644 --- a/tests/testthat/_snaps/survival_time.md +++ b/tests/testthat/_snaps/survival_time.md @@ -70,6 +70,33 @@ [1] "Range" +# a_surv_time works with default arguments + + Code + res + Output + RowsVerticalSection (in_rows) object print method: + ---------------------------- + row_name formatted_cell indent_mod row_label + 1 Median 24.8 0 Median + 2 95% CI (21.1, 31.3) 0 95% CI + 3 25% and 75%-ile 10.8, 47.6 0 25% and 75%-ile + 4 Range (censored) 0.8 to 78.9 0 Range (censored) + 5 Range (event) 0.1 to 155.5 0 Range (event) + 6 Range 0.1 to 155.5 0 Range + +# a_surv_time works with customized arguments + + Code + res + Output + RowsVerticalSection (in_rows) object print method: + ---------------------------- + row_name formatted_cell indent_mod row_label + 1 median conf int (13.591239860, 37.970548966) 3 median conf int + 2 20% and 80%-ile 6.65 / 51.09 0 20% and 80%-ile + 3 Range 0.1 to 154.1 0 Range + # surv_time works with default arguments Code diff --git a/tests/testthat/test-survival_time.R b/tests/testthat/test-survival_time.R index fc5ee91941..661a20e05a 100644 --- a/tests/testthat/test-survival_time.R +++ b/tests/testthat/test-survival_time.R @@ -37,6 +37,52 @@ testthat::test_that("s_surv_time works with customized arguments", { testthat::expect_snapshot(res) }) +testthat::test_that("a_surv_time works with default arguments", { + adtte_f <- tern_ex_adtte %>% + dplyr::filter(PARAMCD == "OS") %>% + dplyr::mutate( + AVAL = day2month(AVAL), + is_event = CNSR == 0 + ) + + result <- a_surv_time( + adtte_f, + .df_row = df, + .var = "AVAL", + is_event = "is_event" + ) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) +}) + +testthat::test_that("a_surv_time works with customized arguments", { + adtte_f <- tern_ex_adtte %>% + dplyr::filter(PARAMCD == "OS") %>% + dplyr::mutate( + AVAL = day2month(AVAL), + is_event = CNSR == 0 + ) %>% + dplyr::filter(ARMCD == "ARM B") + + result <- a_surv_time( + adtte_f, + .var = "AVAL", + is_event = "is_event", + control = control_surv_time( + conf_level = 0.99, conf_type = "log-log", quantiles = c(0.2, 0.8) + ), + .df_row = adtte_f, + .stats = c("median_ci", "quantiles", "range"), + .formats = c(median_ci = "auto", quantiles = "xx.xx / xx.xx"), + .labels = c(median_ci = "median conf int"), + .indent_mods = c(median_ci = 3L) + ) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) +}) + testthat::test_that("surv_time works with default arguments", { adtte_f <- tern_ex_adtte %>% dplyr::filter(PARAMCD == "OS") %>% From 282444f9f13db9dbe00864a3ac56b0b0b7ee1f33 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Thu, 2 Nov 2023 23:16:16 +0000 Subject: [PATCH 20/25] [skip actions] Restyle files --- R/utils_default_stats_formats_labels.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 05536805b6..36aed3a7d1 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -348,14 +348,14 @@ labels_use_control <- function(labels_default, control, labels_custom = NULL) { ) } if ("quantiles" %in% names(control) && "quantiles" %in% names(labels_default) && - !"quantiles" %in% names(labels_custom)) { # nolint + !"quantiles" %in% names(labels_custom)) { # nolint labels_default["quantiles"] <- gsub( "[0-9]+% and [0-9]+", paste0(control[["quantiles"]][1] * 100, "% and ", control[["quantiles"]][2] * 100, ""), labels_default["quantiles"] ) } if ("test_mean" %in% names(control) && "mean_pval" %in% names(labels_default) && - !"mean_pval" %in% names(labels_custom)) { # nolint + !"mean_pval" %in% names(labels_custom)) { # nolint labels_default["mean_pval"] <- gsub( "p-value \\(H0: mean = [0-9\\.]+\\)", f_pval(control[["test_mean"]]), labels_default["mean_pval"] ) From c50bdd953fad8c7797a7caa4377ad4905f531edc Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 2 Nov 2023 19:18:08 -0400 Subject: [PATCH 21/25] Empty commit From d8cab3eee7d2e36e86eec456908593dad7dd9a8d Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 2 Nov 2023 19:41:59 -0400 Subject: [PATCH 22/25] Fix checks --- _pkgdown.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index 22388323ce..cad3672dd8 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -70,6 +70,7 @@ reference: - default_stats_formats_labels - starts_with("h_") - imputation_rule + - labels_use_control - starts_with("or_") - starts_with("prop_") - -starts_with("h_col_") From e01dcf3a8c2453448ad081d1dfb18e30e969e1e9 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 2 Nov 2023 19:43:21 -0400 Subject: [PATCH 23/25] Remove unused parameter --- R/utils_default_stats_formats_labels.R | 3 --- man/default_stats_formats_labels.Rd | 4 ---- 2 files changed, 7 deletions(-) diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 36aed3a7d1..866dd96a25 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -137,9 +137,6 @@ get_stats <- function(method_groups = "analyze_vars_numeric", stats_in = NULL, a #' #' @param formats_in (named `vector`) \cr inserted formats to replace defaults. It can be a #' character vector from [formatters::list_valid_format_labels()] or a custom format function. -#' @param method (`character`) name of statistical method group from which to draw alternative -#' default formats from. E.g. For `method = "surv_time"`, the default format for `range` is -#' `"xx.x to xx.x"` instead of the tern default, `"xx.x - xx.x"`. #' #' @return #' * `get_formats_from_stats()` returns a named list of formats, they being a value from diff --git a/man/default_stats_formats_labels.Rd b/man/default_stats_formats_labels.Rd index ab576c4c59..ff494cd85a 100644 --- a/man/default_stats_formats_labels.Rd +++ b/man/default_stats_formats_labels.Rd @@ -100,10 +100,6 @@ indentation modifiers for statistics to use instead of the default of \code{0L} Names should be a subset of the statistics defined in \code{stats_custom} (or default statistics if this is \code{NULL}). Alternatively, the same indentation modifier can be applied to all statistics by setting \code{indent_mods_custom} to a single integer value.} - -\item{method}{(\code{character}) name of statistical method group from which to draw alternative -default formats from. E.g. For \code{method = "surv_time"}, the default format for \code{range} is -\code{"xx.x to xx.x"} instead of the tern default, \code{"xx.x - xx.x"}.} } \value{ \itemize{ From 5606d3460b909a69c96c3ea9adefaa28130cd777 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 7 Nov 2023 15:20:41 -0500 Subject: [PATCH 24/25] Update docs --- man/survival_time.Rd | 15 ++------------- 1 file changed, 2 insertions(+), 13 deletions(-) diff --git a/man/survival_time.Rd b/man/survival_time.Rd index a79cb3cacc..9a16fb9b73 100644 --- a/man/survival_time.Rd +++ b/man/survival_time.Rd @@ -61,7 +61,8 @@ for more information.} \item{.df_row}{(\code{data.frame})\cr data frame across all of the columns for the given row split.} -\item{.stats}{(\code{character})\cr statistics to select for the table.} +\item{.stats}{(\code{character})\cr statistics to select for the table. Run \code{get_stats("surv_time")} +to see available statistics for this function.} \item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more information on the \code{"auto"} setting.} @@ -90,18 +91,6 @@ underneath analyses, which is not allowed.} \item{table_names}{(\code{character})\cr this can be customized in case that the same \code{vars} are analyzed multiple times, to avoid warnings from \code{rtables}.} - -\item{.stats}{(\code{character})\cr statistics to select for the table. Run \code{get_stats("surv_time")} -to see available statistics for this function.} - -\item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more -information on the \code{"auto"} setting.} - -\item{.labels}{(named \code{character})\cr labels for the statistics (without indent).} - -\item{.indent_mods}{(named \code{vector} of \code{integer})\cr indent modifiers for the labels. Each element of the vector -should be a name-value pair with name corresponding to a statistic specified in \code{.stats} and value the indentation -for that statistic's row label.} } \value{ \itemize{ From db0a858942c88b8068c355068689005905662127 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 7 Nov 2023 15:48:05 -0500 Subject: [PATCH 25/25] Add option to remove ref footnotes, update tests after get_stats PR --- NEWS.md | 2 +- R/analyze_variables.R | 1 + R/survival_time.R | 9 +- man/survival_time.Rd | 5 + tests/testthat/_snaps/analyze_variables.md | 110 +++++++++++------- .../utils_default_stats_formats_labels.md | 12 +- 6 files changed, 87 insertions(+), 52 deletions(-) diff --git a/NEWS.md b/NEWS.md index 67ed4ee898..daeb6d1ab0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,7 +10,7 @@ * Added utility function `labels_use_control` to modify labels with control specifications. * Added list containing default statistics for each method group, `tern_default_stats`. * Added summarize function version of `count_occurrences` analyze function, `summarize_occurrences`. -* Added referential footnotes to `surv_time` for censored range observations. +* Added referential footnotes to `surv_time` for censored range observations, controlled via the `ref_fn_censor` parameter. ### Enhancements * Added `ref_group_coxph` parameter to `g_km` to specify the reference group used for pairwise Cox-PH calculations when `annot_coxph = TRUE`. diff --git a/R/analyze_variables.R b/R/analyze_variables.R index d848a3bed1..045e565e1f 100644 --- a/R/analyze_variables.R +++ b/R/analyze_variables.R @@ -517,6 +517,7 @@ a_summary <- function(x, lbls } + if ("count_fraction_fixed_dp" %in% .stats) x_stats[["count_fraction_fixed_dp"]] <- x_stats[["count_fraction"]] x_stats <- x_stats[.stats] if (is.factor(x) || is.character(x)) { diff --git a/R/survival_time.R b/R/survival_time.R index 11359843eb..b72b1650d2 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -100,6 +100,7 @@ a_surv_time <- function(df, .df_row = NULL, is_event, control = control_surv_time(), + ref_fn_censor = TRUE, .stats = NULL, .formats = NULL, .labels = NULL, @@ -130,7 +131,7 @@ a_surv_time <- function(df, .formats <- apply_auto_formatting(.formats, x_stats, .df_row, .var) cell_fns <- setNames(vector("list", length = length(x_stats)), .labels) - if ("range" %in% names(x_stats)) { + if ("range" %in% names(x_stats) && ref_fn_censor) { if (x_stats[["range"]][1] == rng_censor_lwr && x_stats[["range"]][2] == rng_censor_upr) { cell_fns[[.labels[["range"]]]] <- "Censored observations: range minimum & maximum" } else if (x_stats[["range"]][1] == rng_censor_lwr) { @@ -157,6 +158,8 @@ a_surv_time <- function(df, #' @param .indent_mods (named `vector` of `integer`)\cr indent modifiers for the labels. Each element of the vector #' should be a name-value pair with name corresponding to a statistic specified in `.stats` and value the indentation #' for that statistic's row label. +#' @param ref_fn_censor (`flag`)\cr whether referential footnotes indicating censored observations should be printed +#' when the `range` statistic is included. #' #' @return #' * `surv_time()` returns a layout object suitable for passing to further layouting functions, @@ -178,6 +181,7 @@ a_surv_time <- function(df, #' @export surv_time <- function(lyt, vars, + ref_fn_censor = TRUE, na_str = NA_character_, nested = TRUE, ..., @@ -189,7 +193,8 @@ surv_time <- function(lyt, .labels = NULL, .indent_mods = c(median_ci = 1L)) { extra_args <- list( - .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str + .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, + na_str = na_str, ref_fn_censor = ref_fn_censor ) analyze( diff --git a/man/survival_time.Rd b/man/survival_time.Rd index 9a16fb9b73..3ecfc9c090 100644 --- a/man/survival_time.Rd +++ b/man/survival_time.Rd @@ -16,6 +16,7 @@ a_surv_time( .df_row = NULL, is_event, control = control_surv_time(), + ref_fn_censor = TRUE, .stats = NULL, .formats = NULL, .labels = NULL, @@ -26,6 +27,7 @@ a_surv_time( surv_time( lyt, vars, + ref_fn_censor = TRUE, na_str = NA_character_, nested = TRUE, ..., @@ -61,6 +63,9 @@ for more information.} \item{.df_row}{(\code{data.frame})\cr data frame across all of the columns for the given row split.} +\item{ref_fn_censor}{(\code{flag})\cr whether referential footnotes indicating censored observations should be printed +when the \code{range} statistic is included.} + \item{.stats}{(\code{character})\cr statistics to select for the table. Run \code{get_stats("surv_time")} to see available statistics for this function.} diff --git a/tests/testthat/_snaps/analyze_variables.md b/tests/testthat/_snaps/analyze_variables.md index 1dbe24e372..156f5c60d3 100644 --- a/tests/testthat/_snaps/analyze_variables.md +++ b/tests/testthat/_snaps/analyze_variables.md @@ -960,15 +960,18 @@ Output RowsVerticalSection (in_rows) object print method: ---------------------------- - row_name formatted_cell indent_mod row_label - 1 n 5 0 n - 2 a 3 0 a - 3 b 1 0 b - 4 c 1 0 c - 5 a 3 (60%) 0 a - 6 b 1 (20%) 0 b - 7 c 1 (20%) 0 c - 8 n_blq 0 0 n_blq + row_name formatted_cell indent_mod row_label + 1 n 5 0 n + 2 a 3 0 a + 3 b 1 0 b + 4 c 1 0 c + 5 a 3 (60%) 0 a + 6 b 1 (20%) 0 b + 7 c 1 (20%) 0 c + 8 a 3 (60.0%) 0 a + 9 b 1 (20.0%) 0 b + 10 c 1 (20.0%) 0 c + 11 n_blq 0 0 n_blq --- @@ -977,15 +980,18 @@ Output RowsVerticalSection (in_rows) object print method: ---------------------------- - row_name formatted_cell indent_mod row_label - 1 n 4 0 n - 2 A 2 0 A - 3 B 1 0 B - 4 C 1 0 C - 5 A 2 (50%) 0 A - 6 B 1 (25%) 0 B - 7 C 1 (25%) 0 C - 8 n_blq 0 0 n_blq + row_name formatted_cell indent_mod row_label + 1 n 4 0 n + 2 A 2 0 A + 3 B 1 0 B + 4 C 1 0 C + 5 A 2 (50%) 0 A + 6 B 1 (25%) 0 B + 7 C 1 (25%) 0 C + 8 A 2 (50.0%) 0 A + 9 B 1 (25.0%) 0 B + 10 C 1 (25.0%) 0 C + 11 n_blq 0 0 n_blq --- @@ -998,7 +1004,8 @@ 1 n 5 0 n 2 count 3 0 count 3 count_fraction 3 (60%) 0 count_fraction - 4 n_blq 0 0 n_blq + 4 count_fraction 3 (60.0%) 0 count_fraction + 5 n_blq 0 0 n_blq # a_summary works with custom input. @@ -1028,7 +1035,11 @@ 7 b 1 (20%) 0 b 8 c 1 (20%) 0 c 9 NA 1 (20%) 0 NA - 10 n_blq 0 0 n_blq + 10 a 2 (40.0%) 0 a + 11 b 1 (20.0%) 0 b + 12 c 1 (20.0%) 0 c + 13 NA 1 (20.0%) 0 NA + 14 n_blq 0 0 n_blq # a_summary works with healthy input when compare = TRUE. @@ -1071,16 +1082,19 @@ Output RowsVerticalSection (in_rows) object print method: ---------------------------- - row_name formatted_cell indent_mod row_label - 1 n 5 0 n - 2 a 3 0 a - 3 b 1 0 b - 4 c 1 0 c - 5 a 3 (60%) 0 a - 6 b 1 (20%) 0 b - 7 c 1 (20%) 0 c - 8 n_blq 0 0 n_blq - 9 p-value (chi-squared test) 0.9560 0 p-value (chi-squared test) + row_name formatted_cell indent_mod row_label + 1 n 5 0 n + 2 a 3 0 a + 3 b 1 0 b + 4 c 1 0 c + 5 a 3 (60%) 0 a + 6 b 1 (20%) 0 b + 7 c 1 (20%) 0 c + 8 a 3 (60.0%) 0 a + 9 b 1 (20.0%) 0 b + 10 c 1 (20.0%) 0 c + 11 n_blq 0 0 n_blq + 12 p-value (chi-squared test) 0.9560 0 p-value (chi-squared test) --- @@ -1089,16 +1103,19 @@ Output RowsVerticalSection (in_rows) object print method: ---------------------------- - row_name formatted_cell indent_mod row_label - 1 n 4 0 n - 2 A 2 0 A - 3 B 1 0 B - 4 C 1 0 C - 5 A 2 (50%) 0 A - 6 B 1 (25%) 0 B - 7 C 1 (25%) 0 C - 8 n_blq 0 0 n_blq - 9 p-value (chi-squared test) 0.9074 0 p-value (chi-squared test) + row_name formatted_cell indent_mod row_label + 1 n 4 0 n + 2 A 2 0 A + 3 B 1 0 B + 4 C 1 0 C + 5 A 2 (50%) 0 A + 6 B 1 (25%) 0 B + 7 C 1 (25%) 0 C + 8 A 2 (50.0%) 0 A + 9 B 1 (25.0%) 0 B + 10 C 1 (25.0%) 0 C + 11 n_blq 0 0 n_blq + 12 p-value (chi-squared test) 0.9074 0 p-value (chi-squared test) --- @@ -1111,8 +1128,9 @@ 1 n 5 0 n 2 count 3 0 count 3 count_fraction 3 (60%) 0 count_fraction - 4 n_blq 0 0 n_blq - 5 p-value (chi-squared test) 0.8091 0 p-value (chi-squared test) + 4 count_fraction 3 (60.0%) 0 count_fraction + 5 n_blq 0 0 n_blq + 6 p-value (chi-squared test) 0.8091 0 p-value (chi-squared test) # a_summary works with custom input when compare = TRUE. @@ -1142,8 +1160,12 @@ 7 b 1 (20%) 0 b 8 c 1 (20%) 0 c 9 NA 1 (20%) 0 NA - 10 n_blq 0 0 n_blq - 11 p-value (chi-squared test) 0.8254 0 p-value (chi-squared test) + 10 a 2 (40.0%) 0 a + 11 b 1 (20.0%) 0 b + 12 c 1 (20.0%) 0 c + 13 NA 1 (20.0%) 0 NA + 14 n_blq 0 0 n_blq + 15 p-value (chi-squared test) 0.8254 0 p-value (chi-squared test) # `analyze_vars` works with healthy input, default `na.rm = TRUE`. diff --git a/tests/testthat/_snaps/utils_default_stats_formats_labels.md b/tests/testthat/_snaps/utils_default_stats_formats_labels.md index 00c7668377..226a576bb6 100644 --- a/tests/testthat/_snaps/utils_default_stats_formats_labels.md +++ b/tests/testthat/_snaps/utils_default_stats_formats_labels.md @@ -18,7 +18,9 @@ Code res Output - [1] "n" "count" "count_fraction" "n_blq" + [1] "n" "count" + [3] "count_fraction" "count_fraction_fixed_dp" + [5] "n_blq" --- @@ -134,10 +136,10 @@ Output n count "n" "count" - count_fraction n_blq - "count_fraction" "n_blq" - pval_counts - "p-value (chi-squared test)" + count_fraction count_fraction_fixed_dp + "count_fraction" "count_fraction" + n_blq pval_counts + "n_blq" "p-value (chi-squared test)" # summary_custom works as expected