From acff39f437fe0ce9c3ca9c14a5db4f7081f355e9 Mon Sep 17 00:00:00 2001 From: Gabe Becker Date: Mon, 8 Dec 2025 14:18:54 -0800 Subject: [PATCH 01/15] formats_var first pass commit --- R/00tabletrees.R | 20 +++-- R/argument_conventions.R | 1 + R/colby_constructors.R | 15 +++- R/tree_accessors.R | 22 ++++- R/tt_dotabulation.R | 44 ++++++++++ inst/WORDLIST | 86 +++++++++--------- man/analyze.Rd | 4 + man/avarspl.Rd | 10 ++- man/int_methods.Rd | 12 +++ man/lyt_args.Rd | 2 + man/rtables-package.Rd | 2 +- tests/testthat/test-lyt-tabulation.R | 126 +++++++++++++++++++++++++++ 12 files changed, 293 insertions(+), 51 deletions(-) diff --git a/R/00tabletrees.R b/R/00tabletrees.R index 5b64b7c804..9435865e63 100644 --- a/R/00tabletrees.R +++ b/R/00tabletrees.R @@ -633,7 +633,9 @@ setClass("VAnalyzeSplit", representation( default_rowlabel = "character", include_NAs = "logical", - var_label_position = "character" + var_label_position = "character", + row_formats_var = "characterOrNULL", + row_na_strs_var = "characterOrNULL" ) ) @@ -672,7 +674,9 @@ AnalyzeVarSplit <- function(var, indent_mod = 0L, label_pos = "default", cvar = "", - section_div = NA_character_) { + section_div = NA_character_, + formats_var = NULL, + na_strs_var = NULL) { check_ok_label(split_label) label_pos <- match.arg(label_pos, c("default", label_pos_values)) if (!any(nzchar(defrowlab))) { @@ -701,7 +705,9 @@ AnalyzeVarSplit <- function(var, page_title_prefix = NA_character_, child_section_div = section_div, child_show_colcounts = FALSE, - child_colcount_format = NA_character_ + child_colcount_format = NA_character_, + row_formats_var = formats_var, + row_na_strs_var = na_strs_var ) ## no content_extra_args } @@ -823,7 +829,9 @@ AnalyzeMultiVars <- function(var, child_labels = c("default", "topleft", "visible", "hidden"), child_names = var, cvar = "", - section_div = NA_character_) { + section_div = NA_character_, + formats_var = NULL, + na_strs_var = NULL) { ## NB we used to resolve to strict TRUE/FALSE for label visibillity ## in this function but that was too greedy for repeated ## analyze calls, so that now occurs in the tabulation machinery @@ -858,7 +866,9 @@ AnalyzeMultiVars <- function(var, label_pos = show_kidlabs, split_format = split_format, split_na_str = split_na_str, - section_div = section_div_if_multivar + section_div = section_div_if_multivar, + formats_var = formats_var, + na_strs_var = na_strs_var ), ## rvis), SIMPLIFY = FALSE ) diff --git a/R/argument_conventions.R b/R/argument_conventions.R index 958ae2c067..a7254c7f88 100644 --- a/R/argument_conventions.R +++ b/R/argument_conventions.R @@ -98,6 +98,7 @@ gen_args <- function(df, alt_counts_df, spl, pos, tt, tr, verbose, colwidths, ob #' functions. See [formatters::list_valid_format_labels()] for a list of all available format strings. #' @param format_na_str (`string`)\cr string which should be displayed when formatted if this cell's value(s) #' are all `NA`. +#' @param formats_var (`string` or `NULL`)\cr `NULL` (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the `format` argument; i.e., they will not override formats (other than `"default"`) set within the afun. Cannot be used simultaneously with `format`. #' @param indent_mod (`numeric`)\cr modifier for the default indent position for the structure created by this #' function (subtable, content table, or row) *and all of that structure's children*. Defaults to 0, which #' corresponds to the unmodified default behavior. diff --git a/R/colby_constructors.R b/R/colby_constructors.R index 60228510b7..9a7ce99843 100644 --- a/R/colby_constructors.R +++ b/R/colby_constructors.R @@ -1124,7 +1124,9 @@ analyze <- function(lyt, table_names = vars, parent_name = NULL, format = NULL, + formats_var = NULL, na_str = NA_character_, + na_strs_var = NULL, nested = TRUE, ## can't name this na_rm symbol conflict with possible afuns!! inclNAs = FALSE, @@ -1134,6 +1136,15 @@ analyze <- function(lyt, section_div = NA_character_) { show_labels <- match.arg(show_labels) subafun <- substitute(afun) + if (!is.null(format) && !is.null(formats_var)) { + stop("Cannot use 'format' and 'formats_var' arguments at ", + "the same time. Please choose one method for specifying ", + "default formatting.") + } else if (is.null(formats_var) && !is.null(na_strs_var)) { + stop("Cannot use 'na_strs_var' (got ", + na_strs_var, + ") without using 'formats_var'.") + } # R treats a single NA value as a logical atomic. The below # maps all the NAs in `var_labels` to NA_character_ required by `Split` # and avoids the error when `var_labels` is just c(NA). @@ -1170,7 +1181,9 @@ analyze <- function(lyt, child_names = table_names, child_labels = show_labels, section_div = section_div, - split_name = parent_name + split_name = parent_name, + formats_var = formats_var, + na_strs_var = na_strs_var ) if (nested && (is(last_rowsplit(lyt), "VAnalyzeSplit") || is(last_rowsplit(lyt), "AnalyzeMultiVars"))) { diff --git a/R/tree_accessors.R b/R/tree_accessors.R index 7d3c3d5c25..70efe6f2ad 100644 --- a/R/tree_accessors.R +++ b/R/tree_accessors.R @@ -493,6 +493,18 @@ setMethod("spl_label_var", "VarLevelSplit", function(obj) obj@value_label_var) #' @rdname int_methods setMethod("spl_label_var", "Split", function(obj) NULL) +#' @rdname int_methods +setGeneric("spl_formats_var", function(obj) standardGeneric("spl_formats_var")) + +#' @rdname int_methods +setMethod("spl_formats_var", "VAnalyzeSplit", function(obj) obj@row_formats_var) + +#' @rdname int_methods +setGeneric("spl_na_strs_var", function(obj) standardGeneric("spl_na_strs_var")) + +#' @rdname int_methods +setMethod("spl_na_strs_var", "VAnalyzeSplit", function(obj) obj@row_na_strs_var) + ### name related things # #' @inherit formatters::formatter_methods #' Methods for generics in the `formatters` package @@ -1203,6 +1215,10 @@ setGeneric("set_format_recursive", function(obj, format, na_str, override = FALS standardGeneric("set_format_recursive") }) +fmt_can_inherit <- function(obj, fmt = obj_format(obj)) { + is.null(fmt) || identical(fmt, "default") +} + #' @param override (`flag`)\cr whether to override attribute. #' #' @rdname int_methods @@ -1213,7 +1229,7 @@ setMethod( return(obj) } - if ((is.null(obj_format(obj)) && !is.null(format)) || override) { + if ((fmt_can_inherit(obj) && !is.null(format)) || override) { obj_format(obj) <- format } if ((.no_na_str(obj) && !.no_na_str(na_str)) || override) { @@ -1221,7 +1237,7 @@ setMethod( } lcells <- row_cells(obj) lvals <- lapply(lcells, function(x) { - if (!is.null(x) && (override || is.null(obj_format(x)))) { + if (!is.null(x) && (override || fmt_can_inherit(x))) { obj_format(x) <- obj_format(obj) } if (!is.null(x) && (override || .no_na_str(x))) { @@ -1248,7 +1264,7 @@ setMethod( return(obj) } - if ((is.null(obj_format(obj)) && !is.null(format)) || override) { + if ((fmt_can_inherit(obj) && !is.null(format)) || override) { obj_format(obj) <- format } if ((.no_na_str(obj) && !.no_na_str(na_str)) || override) { diff --git a/R/tt_dotabulation.R b/R/tt_dotabulation.R index 18f8f622b4..5f00cc8ad3 100644 --- a/R/tt_dotabulation.R +++ b/R/tt_dotabulation.R @@ -550,6 +550,36 @@ gen_rowvalues <- function(dfpart, ctab } + +.apply_default_formats <- function(kidlst, fmtlst, nastrlst = character()) { + + if (is.null(names(kidlst))) { + names(kidlst) <- vapply(kidlst, obj_name, "") + } + + missing_nastrs <- setdiff(names(fmtlst), names(nastrlst)) + if (length(missing_nastrs) > 0) { + nastrlst[missing_nastrs] <- NA_character_ + } + + ## pmatch checks for exact matches first then partial matches + fmt_match <- pmatch(names(kidlst), names(fmtlst)) + toset <- which(!is.na(fmt_match)) + + fmts <- fmtlst[fmt_match[toset]] + na_strs <- nastrlst[names(fmts)] + + kidlst[toset] <- mapply(function(kid, fmt, na_str) { + if (fmt_can_inherit(kid)) { + kid <- set_format_recursive(kid, fmt, na_str, override = FALSE) + } + kid + }, kid = kidlst[toset], fmt = fmts, na_str = na_strs, SIMPLIFY = FALSE) + + kidlst +} + + .make_analyzed_tab <- function(df, alt_df, alt_df_full, @@ -595,6 +625,20 @@ gen_rowvalues <- function(dfpart, call. = FALSE ) } + + if (!is.null(spl_formats_var(spl))) { + if (is.null(spl_na_strs_var(spl))) { + na_strs <- character() ## case handled in .apply_default_formats + } else { + na_strs <- df[[spl_na_strs_var(spl)]][[1]] + } + kids <- .apply_default_formats( + kids, + df[[spl_formats_var(spl)]][[1]], + na_strs + ) + } + lab <- obj_label(spl) ret <- TableTree( kids = kids, diff --git a/inst/WORDLIST b/inst/WORDLIST index d15e79ad5f..f497ed84b1 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,53 +1,25 @@ +Abinaya AE AEs -ARD -ARDs -BMEASIFL -Bové -CRAN's -Carreras -Cheatsheet -Chohan -FFFL -Godwin -Heng -Hoffmann -Kelkhoff -Layouting -Lewandowski -Maximo -Modelling -NSE -ORCID -Paszty -Pathing -Pharma -Phuse -Pre -Qi -RStudio -Resync -Rua -SKELETOMUSCULAR -STUDYID -Sabanés -Saibah -Stoilova -Subtable -Subtables -Tadeusz -Unstratified -ValueWrapper -Yung afun afuns amongst +ARD ard +ARDs biomarker +BMEASIFL +Bov +Bov +Carreras charset +Cheatsheet +Chohan colcount combinatorial +CRAN's customizations +Davide de decrementing df @@ -58,44 +30,74 @@ elemtable emph facetted facetting +FFFL formatter forseeable funder +Garolini getter getters +Godwin +Heng +Hoffmann ie indicies ing initializer labelled +Layouting layouting +Lewandowski mandatorily +Maximo modelled +Modelling monospace +Mordig multivariable +NSE +ORCID orderable orthogonally oversimplifaction +Paszty pathability pathable pathed +Pathing pathing +Pharma +Phuse postfix postprocessing +Pre pre reindexed repped responder +Resync reusability roadmap +RStudio +rtables +Rua +Saban +Sabans +Saibah +SKELETOMUSCULAR sortable spl +Stoilova +STUDYID subsplits +Subtable subtable subtable's +Subtables subtables summarization tableone +Tadeusz todo traversable truetype @@ -106,8 +108,14 @@ uniquification univariable unnested unpruned +Unstratified unstratified useR +ValueWrapper visibilities visibilty +Waddell xtable +Yogasekaram +Yung +Zhu diff --git a/man/analyze.Rd b/man/analyze.Rd index d509fb4be3..f0a1ebdbfe 100644 --- a/man/analyze.Rd +++ b/man/analyze.Rd @@ -12,7 +12,9 @@ analyze( table_names = vars, parent_name = NULL, format = NULL, + formats_var = NULL, na_str = NA_character_, + na_strs_var = NULL, nested = TRUE, inclNAs = FALSE, extra_args = list(), @@ -42,6 +44,8 @@ analyzing a single variable.} strings (\code{"xx.x"}) or function. In cases such as \code{analyze} calls, they can be character vectors or lists of functions. See \code{\link[formatters:list_formats]{formatters::list_valid_format_labels()}} for a list of all available format strings.} +\item{formats_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}.} + \item{na_str}{(\code{string})\cr string that should be displayed when the value of \code{x} is missing. Defaults to \code{"NA"}.} \item{nested}{(\code{logical})\cr whether this layout instruction should be applied within the existing layout structure diff --git a/man/avarspl.Rd b/man/avarspl.Rd index 99cde01943..1672618b5b 100644 --- a/man/avarspl.Rd +++ b/man/avarspl.Rd @@ -21,7 +21,9 @@ AnalyzeVarSplit( indent_mod = 0L, label_pos = "default", cvar = "", - section_div = NA_character_ + section_div = NA_character_, + formats_var = NULL, + na_strs_var = NULL ) AnalyzeColVarSplit( @@ -57,7 +59,9 @@ AnalyzeMultiVars( child_labels = c("default", "topleft", "visible", "hidden"), child_names = var, cvar = "", - section_div = NA_character_ + section_div = NA_character_, + formats_var = NULL, + na_strs_var = NULL ) } \arguments{ @@ -104,6 +108,8 @@ analyzed at the same level of nesting.} \item{section_div}{(\code{string})\cr string which should be repeated as a section divider after each group defined by this split instruction, or \code{NA_character_} (the default) for no section divider.} +\item{formats_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}.} + \item{.payload}{(\code{list})\cr used internally, not intended to be set by end users.} \item{child_labels}{(\code{string})\cr the display behavior for the labels (i.e. label rows) of the children of this diff --git a/man/int_methods.Rd b/man/int_methods.Rd index 0a662b3de7..9c528cc439 100644 --- a/man/int_methods.Rd +++ b/man/int_methods.Rd @@ -104,6 +104,10 @@ \alias{spl_label_var} \alias{spl_label_var,VarLevelSplit-method} \alias{spl_label_var,Split-method} +\alias{spl_formats_var} +\alias{spl_formats_var,VAnalyzeSplit-method} +\alias{spl_na_strs_var} +\alias{spl_na_strs_var,VAnalyzeSplit-method} \alias{tt_labelrow} \alias{tt_labelrow,VTableTree-method} \alias{tt_labelrow<-} @@ -634,6 +638,14 @@ spl_label_var(obj) \S4method{spl_label_var}{Split}(obj) +spl_formats_var(obj) + +\S4method{spl_formats_var}{VAnalyzeSplit}(obj) + +spl_na_strs_var(obj) + +\S4method{spl_na_strs_var}{VAnalyzeSplit}(obj) + tt_labelrow(obj) \S4method{tt_labelrow}{VTableTree}(obj) diff --git a/man/lyt_args.Rd b/man/lyt_args.Rd index 0b7984345d..77deeef1b2 100644 --- a/man/lyt_args.Rd +++ b/man/lyt_args.Rd @@ -187,6 +187,8 @@ this split. Defaults to \code{"(N=xx)"}.} to the \emph{split} or \emph{group of sibling analyses}, for \verb{split_rows_by*} and \verb{analyze*} when analyzing more than one variable, respectively. Ignored when analyzing a single variable.} + +\item{formats_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}.} } \value{ No return value. diff --git a/man/rtables-package.Rd b/man/rtables-package.Rd index d9ea24e78b..75733fad90 100644 --- a/man/rtables-package.Rd +++ b/man/rtables-package.Rd @@ -30,7 +30,7 @@ Authors: Other contributors: \itemize{ - \item Daniel Sabanés Bové \email{daniel.sabanes_bove@roche.com} [contributor] + \item Daniel Sabans Bov \email{daniel.sabanes_bove@roche.com} [contributor] \item Maximilian Mordig \email{maximilian_oliver.mordig@roche.com} [contributor] \item Abinaya Yogasekaram \email{abinaya.yogasekaram@contractors.roche.com} (\href{https://orcid.org/0009-0005-2083-1105}{ORCID}) [contributor] \item F. Hoffmann-La Roche AG [copyright holder, funder] diff --git a/tests/testthat/test-lyt-tabulation.R b/tests/testthat/test-lyt-tabulation.R index 78b50cee8c..0b4c51e1a0 100644 --- a/tests/testthat/test-lyt-tabulation.R +++ b/tests/testthat/test-lyt-tabulation.R @@ -1766,3 +1766,129 @@ test_that("path uniqueness/sibling name uniqueness is enforced correctly", { tbl3b <- build_and_check_row_paths(lyt3b, FALSE) expect_identical(tbl3, tbl3b) }) + + +test_that("formats_var works in analyze()", { + adlb <- ex_adlb + alt_fmts <- list(list(median = "xx.x", + "mean (sd)" = "xx.xx (xx.xxx)", + missing_val = "xx")) + + crp_fmts <- list(list(median = "xx.", + "mean (sd)" = "xx.x (xx.xx)", + missing_val = "xx")) + + iga_fmts <- list(list(median = "xx.xx", + "mean (sd)" = "xx. (xx.x)", + missing_val = "xx")) + + + adlb$formats <- alt_fmts + adlb$formats[adlb$PARAMCD == "CRP"] <- crp_fmts + + adlb$formats[adlb$PARAMCD == "IGA"] <- iga_fmts + + adlb$na_strs <- list(list()) + adlb$na_strs[adlb$PARAMCD == "CRP"] <- list(list(missing_val = "n/a")) + adlb$na_strs[adlb$PARAMCD == "IGA"] <- list(list(missing_val = "-")) + + fmts_afun <- function(x, .formats = NULL) { + in_rows(n = sum(!is.na(x)), + median = median(x, na.rm = TRUE), + "mean (sd)" = c(mean(x, na.rm = TRUE), sd(x, na.rm = TRUE)), + "missing_val" = NA, + .formats = .formats) + } + + ## works without also specifying na_strs_var + lyt <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("PARAMCD") |> + analyze("AVAL", fmts_afun, formats_var = "formats") + + tbl <- build_table(lyt, adlb) + + mpf <- matrix_form(tbl) + + mpf_fmts_real <- mf_formats(mpf)[-1, -1] # no row labs, no col labs + + mpf_fmts_exp <- matrix(c("-", "xx", unlist(alt_fmts), + "-", "xx", unlist(crp_fmts), + "-", "xx", unlist(iga_fmts)), + nrow = nrow(mpf_fmts_real), + ncol = ncol(mpf_fmts_real)) + + expect_identical(mpf_fmts_real, + mpf_fmts_exp) + + fmtcells <- get_formatted_cells(tbl) + + expect_equal(fmtcells[c(3:4, 8:9, 13:14),1], + c("49.6", "49.91 (8.098)", + "50", "50.2 (8.61)", + "49.69", "50 (7.8)")) + + + ## works when also specifying na_strs_var + lyt2 <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("PARAMCD") |> + analyze("AVAL", fmts_afun, formats_var = "formats", na_strs_var = "na_strs") + + tbl2 <- build_table(lyt2, adlb) + + ## precendence and interaction with .formats use in in_rows + + lyt3 <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("PARAMCD") |> + analyze("AVAL", fmts_afun, formats_var = "formats", + extra_args = list( + .formats = list( + n = "xx", + median = "xx.xxx", + "mean (sd)" = "xx.x - xx.x", + missing_val = "xx" + ) + )) + + tbl3 <- build_table(lyt3, adlb) + + lyt3b <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("PARAMCD") |> + analyze("AVAL", fmts_afun, + extra_args = list( + .formats = list( + n = "xx", + median = "xx.xxx", + "mean (sd)" = "xx.x - xx.x", + missing_val = "xx" + ) + )) + + tbl3b <- build_table(lyt3, adlb) + + expect_identical(tbl3, tbl3b) + + lyt3c <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("PARAMCD") |> + analyze("AVAL", fmts_afun, formats_var = "formats", + extra_args = list( + .formats = list( + n = "default", + median = "default", + "mean (sd)" = "default", + missing_val = "default" + ) + )) + + tbl3c <- build_table(lyt3c, adlb) + + expect_identical(get_formatted_cells(tbl), get_formatted_cells(tbl3c)) + + + + +}) From 6cf974e05a52db74cc1802ae69122596c1cbaa3b Mon Sep 17 00:00:00 2001 From: Gabe Becker Date: Mon, 8 Dec 2025 14:55:06 -0800 Subject: [PATCH 02/15] Add na_strs_var to dox --- R/argument_conventions.R | 3 ++- man/analyze.Rd | 2 ++ man/avarspl.Rd | 2 ++ man/lyt_args.Rd | 6 +++++- 4 files changed, 11 insertions(+), 2 deletions(-) diff --git a/R/argument_conventions.R b/R/argument_conventions.R index a7254c7f88..9555a5ca6d 100644 --- a/R/argument_conventions.R +++ b/R/argument_conventions.R @@ -99,6 +99,7 @@ gen_args <- function(df, alt_counts_df, spl, pos, tt, tr, verbose, colwidths, ob #' @param format_na_str (`string`)\cr string which should be displayed when formatted if this cell's value(s) #' are all `NA`. #' @param formats_var (`string` or `NULL`)\cr `NULL` (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the `format` argument; i.e., they will not override formats (other than `"default"`) set within the afun. Cannot be used simultaneously with `format`. +#' @param na_strs_var (`string` or `NULL`)\cr `NULL` (the default) or the name of the list column containing named lists of default NA strings to use. These will be applied with the same precedence as the `format` argument; i.e., they will not override formats (other than `"default"`) set within the afun. Cannot be used simultaneously with `format`. Cannot be used if `formats_var` is `NULL`. #' @param indent_mod (`numeric`)\cr modifier for the default indent position for the structure created by this #' function (subtable, content table, or row) *and all of that structure's children*. Defaults to 0, which #' corresponds to the unmodified default behavior. @@ -158,7 +159,7 @@ lyt_args <- function(lyt, var, vars, label, labels_var, varlabels, varnames, spl var_labels, cvar, table_names, topleft, align, page_by, page_prefix, format_na_str, section_div, na_str, show_colcounts, - colcount_format, parent_name) { + colcount_format, parent_name, formats_var, na_strs_var) { NULL } diff --git a/man/analyze.Rd b/man/analyze.Rd index f0a1ebdbfe..8be604968c 100644 --- a/man/analyze.Rd +++ b/man/analyze.Rd @@ -48,6 +48,8 @@ functions. See \code{\link[formatters:list_formats]{formatters::list_valid_forma \item{na_str}{(\code{string})\cr string that should be displayed when the value of \code{x} is missing. Defaults to \code{"NA"}.} +\item{na_strs_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default NA strings to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}. Cannot be used if \code{formats_var} is \code{NULL}.} + \item{nested}{(\code{logical})\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.} diff --git a/man/avarspl.Rd b/man/avarspl.Rd index 1672618b5b..a0c1dd78c9 100644 --- a/man/avarspl.Rd +++ b/man/avarspl.Rd @@ -110,6 +110,8 @@ by this split instruction, or \code{NA_character_} (the default) for no section \item{formats_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}.} +\item{na_strs_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default NA strings to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}. Cannot be used if \code{formats_var} is \code{NULL}.} + \item{.payload}{(\code{list})\cr used internally, not intended to be set by end users.} \item{child_labels}{(\code{string})\cr the display behavior for the labels (i.e. label rows) of the children of this diff --git a/man/lyt_args.Rd b/man/lyt_args.Rd index 77deeef1b2..e1c9ce537d 100644 --- a/man/lyt_args.Rd +++ b/man/lyt_args.Rd @@ -51,7 +51,9 @@ lyt_args( na_str, show_colcounts, colcount_format, - parent_name + parent_name, + formats_var, + na_strs_var ) } \arguments{ @@ -189,6 +191,8 @@ to the \emph{split} or \emph{group of sibling analyses}, for \verb{split_rows_by analyzing a single variable.} \item{formats_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}.} + +\item{na_strs_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default NA strings to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}. Cannot be used if \code{formats_var} is \code{NULL}.} } \value{ No return value. From cad5cbaadc7333b28c2178899422694efe18feee Mon Sep 17 00:00:00 2001 From: Gabe Becker Date: Tue, 9 Dec 2025 15:11:37 -0800 Subject: [PATCH 03/15] working except for multiple vars case --- R/tt_dotabulation.R | 25 ++++++++++++++-- tests/testthat/test-lyt-tabulation.R | 45 ++++++++++++++++++++++++---- 2 files changed, 62 insertions(+), 8 deletions(-) diff --git a/R/tt_dotabulation.R b/R/tt_dotabulation.R index 5f00cc8ad3..33b19356a4 100644 --- a/R/tt_dotabulation.R +++ b/R/tt_dotabulation.R @@ -550,6 +550,19 @@ gen_rowvalues <- function(dfpart, ctab } +inv_pmatch <- function(str, tbl) { + inds <- pmatch(tbl, str) + found_inds <- which(!is.na(inds)) + ret <- NA_integer_ + if (length(found_inds) == 1) { + ret <- found_inds + } else if (length(found_inds) > 1) { + ncs <- nchar(tbl[found_inds]) + chosen <- which.max(ncs) + ret <- found_inds[chosen] + } + ret +} .apply_default_formats <- function(kidlst, fmtlst, nastrlst = character()) { @@ -562,8 +575,16 @@ gen_rowvalues <- function(dfpart, nastrlst[missing_nastrs] <- NA_character_ } - ## pmatch checks for exact matches first then partial matches - fmt_match <- pmatch(names(kidlst), names(fmtlst)) + ## checks for exact matches first then partial matches + fmt_match <- match(names(kidlst), names(fmtlst)) + no_exact_inds <- which(is.na(fmt_match)) + fmt_match[no_exact_inds] <- vapply( + names(kidlst)[no_exact_inds], + inv_pmatch, + tbl = names(fmtlst), + 1L + ) + toset <- which(!is.na(fmt_match)) fmts <- fmtlst[fmt_match[toset]] diff --git a/tests/testthat/test-lyt-tabulation.R b/tests/testthat/test-lyt-tabulation.R index 0b4c51e1a0..a9bda01271 100644 --- a/tests/testthat/test-lyt-tabulation.R +++ b/tests/testthat/test-lyt-tabulation.R @@ -1772,15 +1772,18 @@ test_that("formats_var works in analyze()", { adlb <- ex_adlb alt_fmts <- list(list(median = "xx.x", "mean (sd)" = "xx.xx (xx.xxx)", - missing_val = "xx")) + missing_val = "xx", + STRATA1 = "xx")) crp_fmts <- list(list(median = "xx.", "mean (sd)" = "xx.x (xx.xx)", - missing_val = "xx")) + missing_val = "xx", + STRATA1 = "N=xx")) iga_fmts <- list(list(median = "xx.xx", "mean (sd)" = "xx. (xx.x)", - missing_val = "xx")) + missing_val = "xx", + STRATA1 = "xx.x")) adlb$formats <- alt_fmts @@ -1812,9 +1815,9 @@ test_that("formats_var works in analyze()", { mpf_fmts_real <- mf_formats(mpf)[-1, -1] # no row labs, no col labs - mpf_fmts_exp <- matrix(c("-", "xx", unlist(alt_fmts), - "-", "xx", unlist(crp_fmts), - "-", "xx", unlist(iga_fmts)), + mpf_fmts_exp <- matrix(c("-", "xx", unlist(alt_fmts[[1]][1:3]), ## no STRATA1 here and below + "-", "xx", unlist(crp_fmts[[1]][1:3]), + "-", "xx", unlist(iga_fmts[[1]][1:3])), nrow = nrow(mpf_fmts_real), ncol = ncol(mpf_fmts_real)) @@ -1888,7 +1891,37 @@ test_that("formats_var works in analyze()", { expect_identical(get_formatted_cells(tbl), get_formatted_cells(tbl3c)) + ## tern style row naming partial match support + factor_count_prepend_var <- function(x, .var) { + stopifnot(is.factor(x)) + vals <- as.list(table(x)) + in_rows(.list = vals, .names = paste0(.var, names(vals)), .labels = levels(x)) + } + + lyt4 <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("PARAMCD") |> + analyze("STRATA1", factor_count_prepend_var, formats_var = "formats") + + tbl4 <- build_table(lyt4, adlb) + + fmtcells4 <- get_formatted_cells(tbl4) + + alt_a_cnt <- with(adlb, sum(ARM == "A: Drug X" & PARAMCD == "ALT" & STRATA1 == "A")) + crp_b_cnt <- with(adlb, sum(ARM == "B: Placebo" & PARAMCD == "CRP" & STRATA1 == "B")) + iga_c_cnt <- with(adlb, sum(ARM == "C: Combination" & PARAMCD == "IGA" & STRATA1 == "C")) + expect_identical(fmtcells4[2, 1], format_value(alt_a_cnt, "xx")) + expect_identical(fmtcells4[7, 2], format_value(crp_b_cnt, "N=xx")) + expect_identical(fmtcells4[12, 3], format_value(iga_c_cnt, "xx.x")) + ## most specific for multiple partial matches + + adlb2 <- adlb + ## This should do nothing because STRATA1 is a more specific partial match than STRAT + adlb2$formats <- lapply(adlb2$formats, function(x) c(x, list(STRAT = "xx.xxx"))) + + tbl4b <- build_table(lyt4, adlb2) + expect_identical(tbl4, tbl4b) }) From 7d347e1f098681b3a9c3008479fc27d76656c38a Mon Sep 17 00:00:00 2001 From: Gabe Becker Date: Fri, 12 Dec 2025 15:28:29 -0800 Subject: [PATCH 04/15] formats per var implemented, part way through testing --- R/00tabletrees.R | 88 ++++++++++++++++++------- R/colby_constructors.R | 11 ++++ R/tt_dotabulation.R | 65 ++++++++++++++++-- tests/testthat/test-lyt-tabulation.R | 98 +++++++++++++++++++++++++++- 4 files changed, 232 insertions(+), 30 deletions(-) diff --git a/R/00tabletrees.R b/R/00tabletrees.R index 9435865e63..84cd00e16a 100644 --- a/R/00tabletrees.R +++ b/R/00tabletrees.R @@ -46,6 +46,7 @@ setClassUnion("SubsetDef", c("expression", "logical", "integer", "numeric")) setClassUnion("integerOrNULL", c("NULL", "integer")) setClassUnion("characterOrNULL", c("NULL", "character")) +setClassUnion("characterOrList", c("list", "character")) ## should XXX [splits, s_values, sval_labels, subset(?)] be a data.frame? setClass("TreePos", representation( @@ -60,10 +61,26 @@ validity = function(object) { } ) +setOldClass(c("FormatList", "list")) + +FormatList <- function(..., .list = list(...)) { + if (!is.list(.list)) + .list <- list(.list) + valid <- vapply(.list, is, class2 = "FormatSpec", TRUE) + if (!are(.list, "FormatSpec")) { + stop("Attempted to construct FormatList with elements that are not ", + "FormatSpec compatible. This should not happen, please contact ", + "the maintainers.") + } + + class(.list) <- c("FormatList", "list") + .list +} + setClassUnion("functionOrNULL", c("NULL", "function")) setClassUnion("listOrNULL", c("NULL", "list")) ## TODO (?) make "list" more specific, e.g FormatList, or FunctionList? -setClassUnion("FormatSpec", c("NULL", "character", "function", "list")) +setClassUnion("FormatSpec", c("NULL", "character", "function", "list", "FormatList")) setClassUnion("ExprOrNULL", c("NULL", "expression")) setClass("ValueWrapper", representation( @@ -133,7 +150,7 @@ setClass("Split", name = "character", split_label = "character", split_format = "FormatSpec", - split_na_str = "character", + split_na_str = "characterOrList", split_label_position = "character", ## NB this is the function which is applied to ## get the content rows for the CHILDREN of this @@ -850,28 +867,53 @@ AnalyzeMultiVars <- function(var, ## split_format = .repoutlst(split_format, nv) inclNAs <- .repoutlst(inclNAs, nv) section_div_if_multivar <- if (length(var) > 1) NA_character_ else section_div - pld <- mapply(AnalyzeVarSplit, - var = var, - split_name = child_names, - split_label = split_label, - afun = afun, - defrowlab = defrowlab, - cfun = cfun, - cformat = cformat, - ## split_format = split_format, - inclNAs = inclNAs, - MoreArgs = list( - extra_args = extra_args, - indent_mod = indent_mod, - label_pos = show_kidlabs, - split_format = split_format, - split_na_str = split_na_str, - section_div = section_div_if_multivar, - formats_var = formats_var, - na_strs_var = na_strs_var - ), ## rvis), - SIMPLIFY = FALSE + + moreargs <- list( + extra_args = extra_args, + indent_mod = indent_mod, + label_pos = show_kidlabs, + split_na_str = split_na_str, + section_div = section_div_if_multivar, + formats_var = formats_var, + na_strs_var = na_strs_var ) + mv_list_case <- is.list(split_format) && + all(var %in% names(split_format)) && + all(vapply(split_format, is, class2 = "FormatList", TRUE)) + if (mv_list_case) { # diff format list for each var + ## split_value does *not* go in more args, not constant across vars + pld <- mapply( + AnalyzeVarSplit, + var = var, + split_name = child_names, + split_label = split_label, + afun = afun, + defrowlab = defrowlab, + cfun = cfun, + cformat = cformat, + ## in case they're in the wrong order for some insane reason + split_format = split_format[var], + inclNAs = inclNAs, + MoreArgs = moreargs, ## rvis), + SIMPLIFY = FALSE + ) + } else { # not diff lists for each var + ## split format goes in more args because its constant across vars + pld <- mapply( + AnalyzeVarSplit, + var = var, + split_name = child_names, + split_label = split_label, + afun = afun, + defrowlab = defrowlab, + cfun = cfun, + cformat = cformat, + inclNAs = inclNAs, + MoreArgs = c(moreargs, list(split_format = split_format)), ## rvis), + SIMPLIFY = FALSE + ) + + } } else { ## we're combining existing splits here pld <- unlist(lapply(.payload, .uncompound)) diff --git a/R/colby_constructors.R b/R/colby_constructors.R index 9a7ce99843..a358611dec 100644 --- a/R/colby_constructors.R +++ b/R/colby_constructors.R @@ -1170,6 +1170,17 @@ analyze <- function(lyt, defrowlab <- var_labels } + ## hook up the new hotness + var_format_lists <- length(vars) > 1 && + is.list(format) && + all(vars %in% names(format)) + + if (var_format_lists) { + format <- lapply(format, function(x) FormatList(.list = x)) + if (is.character(na_str)) { + na_str <- lapply(format, function(x) na_str) + } + } spl <- AnalyzeMultiVars(vars, var_labels, afun = afun, split_format = format, diff --git a/R/tt_dotabulation.R b/R/tt_dotabulation.R index 33b19356a4..e7d59b71ae 100644 --- a/R/tt_dotabulation.R +++ b/R/tt_dotabulation.R @@ -550,6 +550,8 @@ gen_rowvalues <- function(dfpart, ctab } +## return index in tbl that has best partial match to str +## or NA_integer_ if none do inv_pmatch <- function(str, tbl) { inds <- pmatch(tbl, str) found_inds <- which(!is.na(inds)) @@ -566,16 +568,36 @@ inv_pmatch <- function(str, tbl) { .apply_default_formats <- function(kidlst, fmtlst, nastrlst = character()) { + if (length(fmtlst) == 0 && length(nastrlst) == 0) { + return(kidlst) + } + if (is.null(names(kidlst))) { names(kidlst) <- vapply(kidlst, obj_name, "") } + if (identical(nastrlst, character())) { + nastrlst <- NA_character_ + } + + if (is.character(nastrlst) && length(nastrlst) >= 1) { + nastrlst <- replicate(length(kidlst), list(nastrlst), simplify = FALSE) + names(nastrlst) <- names(kidlst) + } + missing_nastrs <- setdiff(names(fmtlst), names(nastrlst)) if (length(missing_nastrs) > 0) { nastrlst[missing_nastrs] <- NA_character_ } + missing_fmts <- setdiff(names(nastrlst), names(fmtlst)) + if (length(missing_fmts) > 0) { + fmtlst[missing_fmts] <- list(NULL) + } + ## they may be in different orders, if so fix it + stopifnot(intersect(names(fmtlst), names(nastrlst)) == names(fmtlst)) + nastrlst <- nastrlst[names(fmtlst)] - ## checks for exact matches first then partial matches + ## checks for exact matches first then (inverse) partial matches fmt_match <- match(names(kidlst), names(fmtlst)) no_exact_inds <- which(is.na(fmt_match)) fmt_match[no_exact_inds] <- vapply( @@ -617,6 +639,20 @@ inv_pmatch <- function(str, tbl) { if (nchar(defrlabel) == 0 && !missing(partlabel) && nchar(partlabel) > 0) { defrlabel <- partlabel } + + fmt <- obj_format(spl) + have_fmt_lst <- FALSE + if (is(fmt, "FormatList")) { + ## list for diff vars but each has one format case + if (length(fmt) == 1 && is.null(names(fmt))) { + fmt <- unlist(fmt) + stopifnot(is(fmt, "FormatSpec")) + } else { ## real format list case + fmt <- NULL + have_fmt_lst <- TRUE + } + } + kids <- tryCatch( .make_tablerows(df, func = analysis_fun(spl), @@ -624,7 +660,7 @@ inv_pmatch <- function(str, tbl) { cinfo = cinfo, datcol = spl_payload(spl), lev = lvl + 1L, - format = obj_format(spl), + format = fmt, #obj_format(spl), splextra = split_exargs(spl), baselines = baselines, alt_dfpart = alt_df, @@ -647,28 +683,45 @@ inv_pmatch <- function(str, tbl) { ) } + fmtlist <- NULL if (!is.null(spl_formats_var(spl))) { if (is.null(spl_na_strs_var(spl))) { na_strs <- character() ## case handled in .apply_default_formats } else { na_strs <- df[[spl_na_strs_var(spl)]][[1]] } + fmtlist <- df[[spl_formats_var(spl)]][[1]] + } else if (have_fmt_lst) { + fmtlist <- obj_format(spl) + na_strs <- obj_na_str(spl) + if (is.character(na_strs)) { + na_strs <- lapply(fmtlist, function(nm) na_strs) + names(na_strs) <- names(fmtlist) + } + } + + if (!is.null(fmtlist)) { kids <- .apply_default_formats( kids, - df[[spl_formats_var(spl)]][[1]], + fmtlist, na_strs ) } - + lab <- obj_label(spl) + if (is.character(obj_na_str(spl))) { + final_na_str <- obj_na_str(spl) + } else { + final_na_str <- NA_character_ + } ret <- TableTree( kids = kids, name = obj_name(spl), label = lab, lev = lvl, cinfo = cinfo, - format = obj_format(spl), - na_str = obj_na_str(spl), + format = if (is.null(fmtlist)) obj_format(spl) else NULL, + na_str = final_na_str, indent_mod = indent_mod(spl), trailing_section_div = spl_section_div(spl) ) diff --git a/tests/testthat/test-lyt-tabulation.R b/tests/testthat/test-lyt-tabulation.R index a9bda01271..72c3a2e053 100644 --- a/tests/testthat/test-lyt-tabulation.R +++ b/tests/testthat/test-lyt-tabulation.R @@ -1830,7 +1830,21 @@ test_that("formats_var works in analyze()", { c("49.6", "49.91 (8.098)", "50", "50.2 (8.61)", "49.69", "50 (7.8)")) - + + ## can use formats_var with na_str specified the old way + lyta <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("PARAMCD") |> + analyze("AVAL", + fmts_afun, + formats_var = "formats", + na_str = "global na cha cha cha") + + tbla <- build_table(lyta, adlb) + + expect_true( + all(get_formatted_cells(tbla)[c(5, 10, 15), ] == "global na cha cha cha") + ) ## works when also specifying na_strs_var lyt2 <- basic_table() |> @@ -1925,3 +1939,85 @@ test_that("formats_var works in analyze()", { tbl4b <- build_table(lyt4, adlb2) expect_identical(tbl4, tbl4b) }) + +test_that("New format as list of formats for diff vars in analyze works", { + + ## ugh apparently simple_analysis applies a format!!!!!!!!!!!! x.x + + my_stupid_afun <- function(x) { + if (is.factor(x)) { + vallst <- lapply(table(x), rcell) + names(vallst) <- levels(x) + } else if(is(x, "numeric")) { + vallst <- list(Mean = rcell(mean(x, na.rm = TRUE))) + } else { + stop("no") + } + in_rows(.list = vallst) + } + + ## basic case: list of individual formats, one for each var + lyt <- basic_table() |> + analyze(c("AGE", "BMRKR1", "STRATA1"), + afun = my_stupid_afun, + format = list(AGE = "xx.x", + BMRKR1 = "xx.xx", + STRATA1 = "N=xx")) + + tbl <- build_table(lyt, ex_adsl) + + age_mean <- mean(ex_adsl$AGE, na.rm = TRUE) + bmrkr1_mean <- mean(ex_adsl$BMRKR1, na.rm = TRUE) + strata1_counts <- table(ex_adsl$STRATA1) + sex_counts <- table(ex_adsl$SEX) + exp <- matrix( + c( + "", + format_value(age_mean, "xx.x"), + "", + format_value(bmrkr1_mean, "xx.xx"), + "", + vapply(strata1_counts, format_value, format = "N=xx", "") + ), + ncol = 1 + ) + + expect_equal(get_formatted_cells(tbl), exp) + + ## preserve old stanky behavior I for some reason thought was a good idea + ## list of formats applied to analysis of all vars and taken in order + ## with recycling (!!!!) + ## ... Past me was a genius of unparalleled insight /s + + lyt_old <- basic_table() |> + analyze(c("AGE", "BMRKR1", "STRATA1", "SEX"), + afun = my_stupid_afun, + format = list("xx.x", + "xx.xx", + "N=xx")) + + tbl_old <- build_table(lyt_old, ex_adsl) + + fmtvec <- c("xx.x", "xx.xx", "N=xx") + ## supppress **very reasonable** warnings about bad recycling + exp_old <- suppressWarnings(matrix( + ncol = 1, + c( + "", + format_value(age_mean, "xx.x"), + "", + format_value(bmrkr1_mean, "xx.x"), + "", + mapply(format_value, + x = strata1_counts, + format = fmtvec), + "", + mapply(format_value, + x = sex_counts, + format = fmtvec) # !! insane recycling behavior. what?!? + ) + )) + + + +}) From 58826b1c8371b7d20938ae7bf61f40f00d64a793 Mon Sep 17 00:00:00 2001 From: Gabe Becker Date: Fri, 12 Dec 2025 17:06:45 -0800 Subject: [PATCH 05/15] passing tests for old, format var, and format list per var behaviors --- R/tt_dotabulation.R | 22 +++- tests/testthat/test-lyt-tabulation.R | 183 ++++++++++++++++++++++----- 2 files changed, 172 insertions(+), 33 deletions(-) diff --git a/R/tt_dotabulation.R b/R/tt_dotabulation.R index e7d59b71ae..5a86388807 100644 --- a/R/tt_dotabulation.R +++ b/R/tt_dotabulation.R @@ -581,17 +581,31 @@ inv_pmatch <- function(str, tbl) { } if (is.character(nastrlst) && length(nastrlst) >= 1) { - nastrlst <- replicate(length(kidlst), list(nastrlst), simplify = FALSE) - names(nastrlst) <- names(kidlst) + missing_nastr_val <- nastrlst + nastrlst <- list() + } else { + missing_nastr_val <- NA_character_ + } + + if (!is.list(fmtlst)) { + missing_fmt_val <- fmtlst + fmtlst <- list() + } else if (length(fmtlst) == 1 && + is.null(names(fmtlst)) && + is(fmtlst[[1]], "FormatSpec")) { + missing_fmt_val <- fmtlst[[1]] + fmtlst <- list() + } else { + missing_fmt_val <- NULL } missing_nastrs <- setdiff(names(fmtlst), names(nastrlst)) if (length(missing_nastrs) > 0) { - nastrlst[missing_nastrs] <- NA_character_ + nastrlst[missing_nastrs] <- missing_nastr_val } missing_fmts <- setdiff(names(nastrlst), names(fmtlst)) if (length(missing_fmts) > 0) { - fmtlst[missing_fmts] <- list(NULL) + fmtlst[missing_fmts] <- list(missing_fmt_val) } ## they may be in different orders, if so fix it stopifnot(intersect(names(fmtlst), names(nastrlst)) == names(fmtlst)) diff --git a/tests/testthat/test-lyt-tabulation.R b/tests/testthat/test-lyt-tabulation.R index 72c3a2e053..91d76661bc 100644 --- a/tests/testthat/test-lyt-tabulation.R +++ b/tests/testthat/test-lyt-tabulation.R @@ -1768,23 +1768,44 @@ test_that("path uniqueness/sibling name uniqueness is enforced correctly", { }) -test_that("formats_var works in analyze()", { - adlb <- ex_adlb - alt_fmts <- list(list(median = "xx.x", - "mean (sd)" = "xx.xx (xx.xxx)", - missing_val = "xx", - STRATA1 = "xx")) +## used in both formats_var and format var list test sets below +fmts_afun <- function(x, .formats = NULL) { + in_rows(n = sum(!is.na(x)), + median = median(x, na.rm = TRUE), + "mean (sd)" = c(mean(x, na.rm = TRUE), sd(x, na.rm = TRUE)), + "missing_val" = NA, + .formats = .formats) +} + + + + ## tern style row naming partial match support +factor_count_prepend_var <- function(x, .var) { + stopifnot(is.factor(x)) + vals <- as.list(table(x)) + + in_rows(.list = vals, .names = paste0(.var, names(vals)), .labels = levels(x)) +} - crp_fmts <- list(list(median = "xx.", - "mean (sd)" = "xx.x (xx.xx)", +alt_fmts <- list(list(median = "xx.x", + "mean (sd)" = "xx.xx (xx.xxx)", missing_val = "xx", - STRATA1 = "N=xx")) + STRATA1 = "xx")) - iga_fmts <- list(list(median = "xx.xx", - "mean (sd)" = "xx. (xx.x)", - missing_val = "xx", - STRATA1 = "xx.x")) - +crp_fmts <- list(list(median = "xx.", + "mean (sd)" = "xx.x (xx.xx)", + missing_val = "xx", + STRATA1 = "N=xx")) + +iga_fmts <- list(list(median = "xx.xx", + "mean (sd)" = "xx. (xx.x)", + missing_val = "xx", + STRATA1 = "xx.x")) + + + +test_that("formats_var works in analyze()", { + adlb <- ex_adlb adlb$formats <- alt_fmts adlb$formats[adlb$PARAMCD == "CRP"] <- crp_fmts @@ -1795,13 +1816,7 @@ test_that("formats_var works in analyze()", { adlb$na_strs[adlb$PARAMCD == "CRP"] <- list(list(missing_val = "n/a")) adlb$na_strs[adlb$PARAMCD == "IGA"] <- list(list(missing_val = "-")) - fmts_afun <- function(x, .formats = NULL) { - in_rows(n = sum(!is.na(x)), - median = median(x, na.rm = TRUE), - "mean (sd)" = c(mean(x, na.rm = TRUE), sd(x, na.rm = TRUE)), - "missing_val" = NA, - .formats = .formats) - } + ## works without also specifying na_strs_var lyt <- basic_table() |> @@ -1854,6 +1869,11 @@ test_that("formats_var works in analyze()", { tbl2 <- build_table(lyt2, adlb) + fmtcells2 <- get_formatted_cells(tbl2) + expect_true(all(fmtcells2[5, ] == "NA") && + all(fmtcells2[10, ] == "n/a") && + all(fmtcells2[15, ] == "-")) + ## precendence and interaction with .formats use in in_rows lyt3 <- basic_table() |> @@ -1905,13 +1925,6 @@ test_that("formats_var works in analyze()", { expect_identical(get_formatted_cells(tbl), get_formatted_cells(tbl3c)) - ## tern style row naming partial match support - factor_count_prepend_var <- function(x, .var) { - stopifnot(is.factor(x)) - vals <- as.list(table(x)) - - in_rows(.list = vals, .names = paste0(.var, names(vals)), .labels = levels(x)) - } lyt4 <- basic_table() |> split_cols_by("ARM") |> @@ -2017,7 +2030,119 @@ test_that("New format as list of formats for diff vars in analyze works", { format = fmtvec) # !! insane recycling behavior. what?!? ) )) + + ## confirmed this behavior on main before merge. ugh + expect_identical(get_formatted_cells(tbl_old), exp_old) + + + ## even newer extra hotness: list of formats for each var + + ## beware extra layer of listiness between list column case and this one! + varfmts <- list(AGE = alt_fmts[[1]], + BMRKR1 = crp_fmts[[1]], + STRATA1 = crp_fmts[[1]], + SEX = iga_fmts[[1]]) + + ## part one, single afun exact matches + + lyt2 <- basic_table() |> + analyze(c("AGE", "BMRKR1"), + afun = fmts_afun, + format = varfmts) + + tbl2 <- build_table(lyt2, ex_adsl) + + fmtcells2 <- get_formatted_cells(tbl2) + + expect_identical( + fmtcells2, + matrix( + ncol = 1, + c( + "", + format_value(sum(!is.na(ex_adsl$AGE)), "xx"), + format_value(median(ex_adsl$AGE), "xx.x"), + format_value(c(mean(ex_adsl$AGE), sd(ex_adsl$AGE)), "xx.xx (xx.xxx)"), + "NA", + "", + format_value(sum(!is.na(ex_adsl$BMRKR1)), "xx"), + format_value(median(ex_adsl$BMRKR1), "xx."), + format_value(c(mean(ex_adsl$BMRKR1), sd(ex_adsl$BMRKR1)), + "xx.x (xx.xx)"), + "NA" + ) + ) + ) - + ## part two, single afun partial matches + + lyt3 <- basic_table() |> + analyze(c("STRATA1", "SEX"), + afun = factor_count_prepend_var, + format = varfmts) + + tbl3 <- build_table(lyt3, ex_adsl) + fmtcells3 <- get_formatted_cells(tbl3) + expect_identical( + fmtcells3, + matrix( + ncol = 1, + c( + "", + vapply(strata1_counts, format_value, format = "N=xx", ""), + "", + vapply(sex_counts, format_value, format = "xx", "") + ) + ) + ) + + ## part 3 multiple afuns + + lyt4 <- basic_table() |> + analyze(c("AGE", "BMRKR1", "STRATA1", "SEX"), + afun = list(fmts_afun, + fmts_afun, + factor_count_prepend_var, + factor_count_prepend_var), + format = varfmts) + + tbl4 <- build_table(lyt4, ex_adsl) + + fmtcells4 <- get_formatted_cells(tbl4) + + expect_identical(fmtcells4, + rbind(fmtcells2, fmtcells3)) + + ## does it work with "the functions"? + + bad_fmt_factory <- function(val) function(x, ...) val + + lyt5 <- basic_table() |> + analyze(c("AGE", "BMRKR1", "STRATA1", "SEX"), + afun = list(fmts_afun, + fmts_afun, + factor_count_prepend_var, + factor_count_prepend_var), + format = list(AGE = bad_fmt_factory("AGE"), + BMRKR1 = bad_fmt_factory("BMRKR1"), + STRATA1 = bad_fmt_factory("STRATA1"), + SEX = bad_fmt_factory("SEX"))) + + tbl5 <- build_table(lyt5, ex_adsl) + + fmtcells5 <- get_formatted_cells(tbl5) + + expect_identical( + fmtcells5, + matrix( + ncol = 1, + c( + c("", rep("AGE", 3), "NA"), + c("", rep("BMRKR1", 3), "NA"), + c("", rep("STRATA1", 3)), + c("", rep("SEX", 4)) + ) + ) + ) }) From 84568a80f65fab82afaf1163a640f42b8219dac6 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Sat, 13 Dec 2025 01:10:20 +0000 Subject: [PATCH 06/15] [skip style] [skip vbump] Restyle files --- R/00tabletrees.R | 12 +- R/colby_constructors.R | 18 +- R/tt_dotabulation.R | 27 ++- tests/testthat/test-lyt-tabulation.R | 276 +++++++++++++++------------ 4 files changed, 186 insertions(+), 147 deletions(-) diff --git a/R/00tabletrees.R b/R/00tabletrees.R index 84cd00e16a..deae810c62 100644 --- a/R/00tabletrees.R +++ b/R/00tabletrees.R @@ -64,13 +64,16 @@ validity = function(object) { setOldClass(c("FormatList", "list")) FormatList <- function(..., .list = list(...)) { - if (!is.list(.list)) + if (!is.list(.list)) { .list <- list(.list) + } valid <- vapply(.list, is, class2 = "FormatSpec", TRUE) if (!are(.list, "FormatSpec")) { - stop("Attempted to construct FormatList with elements that are not ", - "FormatSpec compatible. This should not happen, please contact ", - "the maintainers.") + stop( + "Attempted to construct FormatList with elements that are not ", + "FormatSpec compatible. This should not happen, please contact ", + "the maintainers." + ) } class(.list) <- c("FormatList", "list") @@ -912,7 +915,6 @@ AnalyzeMultiVars <- function(var, MoreArgs = c(moreargs, list(split_format = split_format)), ## rvis), SIMPLIFY = FALSE ) - } } else { ## we're combining existing splits here diff --git a/R/colby_constructors.R b/R/colby_constructors.R index a358611dec..80024e065c 100644 --- a/R/colby_constructors.R +++ b/R/colby_constructors.R @@ -1137,13 +1137,17 @@ analyze <- function(lyt, show_labels <- match.arg(show_labels) subafun <- substitute(afun) if (!is.null(format) && !is.null(formats_var)) { - stop("Cannot use 'format' and 'formats_var' arguments at ", - "the same time. Please choose one method for specifying ", - "default formatting.") + stop( + "Cannot use 'format' and 'formats_var' arguments at ", + "the same time. Please choose one method for specifying ", + "default formatting." + ) } else if (is.null(formats_var) && !is.null(na_strs_var)) { - stop("Cannot use 'na_strs_var' (got ", - na_strs_var, - ") without using 'formats_var'.") + stop( + "Cannot use 'na_strs_var' (got ", + na_strs_var, + ") without using 'formats_var'." + ) } # R treats a single NA value as a logical atomic. The below # maps all the NAs in `var_labels` to NA_character_ required by `Split` @@ -1173,7 +1177,7 @@ analyze <- function(lyt, ## hook up the new hotness var_format_lists <- length(vars) > 1 && is.list(format) && - all(vars %in% names(format)) + all(vars %in% names(format)) if (var_format_lists) { format <- lapply(format, function(x) FormatList(.list = x)) diff --git a/R/tt_dotabulation.R b/R/tt_dotabulation.R index 5a86388807..9a8cb4c661 100644 --- a/R/tt_dotabulation.R +++ b/R/tt_dotabulation.R @@ -567,7 +567,6 @@ inv_pmatch <- function(str, tbl) { } .apply_default_formats <- function(kidlst, fmtlst, nastrlst = character()) { - if (length(fmtlst) == 0 && length(nastrlst) == 0) { return(kidlst) } @@ -588,13 +587,13 @@ inv_pmatch <- function(str, tbl) { } if (!is.list(fmtlst)) { - missing_fmt_val <- fmtlst - fmtlst <- list() + missing_fmt_val <- fmtlst + fmtlst <- list() } else if (length(fmtlst) == 1 && - is.null(names(fmtlst)) && - is(fmtlst[[1]], "FormatSpec")) { + is.null(names(fmtlst)) && + is(fmtlst[[1]], "FormatSpec")) { missing_fmt_val <- fmtlst[[1]] - fmtlst <- list() + fmtlst <- list() } else { missing_fmt_val <- NULL } @@ -609,7 +608,7 @@ inv_pmatch <- function(str, tbl) { } ## they may be in different orders, if so fix it stopifnot(intersect(names(fmtlst), names(nastrlst)) == names(fmtlst)) - nastrlst <- nastrlst[names(fmtlst)] + nastrlst <- nastrlst[names(fmtlst)] ## checks for exact matches first then (inverse) partial matches fmt_match <- match(names(kidlst), names(fmtlst)) @@ -620,19 +619,19 @@ inv_pmatch <- function(str, tbl) { tbl = names(fmtlst), 1L ) - + toset <- which(!is.na(fmt_match)) fmts <- fmtlst[fmt_match[toset]] - na_strs <- nastrlst[names(fmts)] - + na_strs <- nastrlst[names(fmts)] + kidlst[toset] <- mapply(function(kid, fmt, na_str) { if (fmt_can_inherit(kid)) { kid <- set_format_recursive(kid, fmt, na_str, override = FALSE) } kid }, kid = kidlst[toset], fmt = fmts, na_str = na_strs, SIMPLIFY = FALSE) - + kidlst } @@ -663,10 +662,10 @@ inv_pmatch <- function(str, tbl) { stopifnot(is(fmt, "FormatSpec")) } else { ## real format list case fmt <- NULL - have_fmt_lst <- TRUE + have_fmt_lst <- TRUE } } - + kids <- tryCatch( .make_tablerows(df, func = analysis_fun(spl), @@ -674,7 +673,7 @@ inv_pmatch <- function(str, tbl) { cinfo = cinfo, datcol = spl_payload(spl), lev = lvl + 1L, - format = fmt, #obj_format(spl), + format = fmt, # obj_format(spl), splextra = split_exargs(spl), baselines = baselines, alt_dfpart = alt_df, diff --git a/tests/testthat/test-lyt-tabulation.R b/tests/testthat/test-lyt-tabulation.R index 91d76661bc..c70eceaf1e 100644 --- a/tests/testthat/test-lyt-tabulation.R +++ b/tests/testthat/test-lyt-tabulation.R @@ -15,7 +15,6 @@ test_that("summarize_row_groups works with provided funcs", { }) - ## this test_that("complex layout works", { lyt <- make_big_lyt() @@ -34,9 +33,6 @@ test_that("complex layout works", { }) - - - test_that("existing table in layout works", { thing2 <- basic_table() %>% split_cols_by("ARM") %>% @@ -234,8 +230,6 @@ test_that("labelkids parameter works", { }) - - test_that("ref_group comparisons work", { skip_if_not_installed("tibble") require(tibble, quietly = TRUE) @@ -995,7 +989,6 @@ test_that("alt_counts_df works", { }) - test_that("deeply nested and uneven column layouts work", { lyt <- basic_table(show_colcounts = TRUE) %>% split_cols_by(var = "ARM") %>% @@ -1022,7 +1015,6 @@ test_that("deeply nested and uneven column layouts work", { }) - test_that("topleft label position works", { lyt <- basic_table(show_colcounts = TRUE) %>% split_cols_by("ARM") %>% @@ -1114,7 +1106,6 @@ test_that("topleft label position works", { }) - test_that(".spl_context works in content and analysis functions", { ageglobmean <- mean(DM$AGE) cfun <- function(df, labelstr, .spl_context) { @@ -1495,7 +1486,6 @@ test_that("counts_wpcts returns error correctly", { }) - test_that("qtable works", { nice_comp_table <- function(t1, t2) { expect_identical(row_paths(t1), row_paths(t2)) @@ -1770,16 +1760,17 @@ test_that("path uniqueness/sibling name uniqueness is enforced correctly", { ## used in both formats_var and format var list test sets below fmts_afun <- function(x, .formats = NULL) { - in_rows(n = sum(!is.na(x)), - median = median(x, na.rm = TRUE), - "mean (sd)" = c(mean(x, na.rm = TRUE), sd(x, na.rm = TRUE)), - "missing_val" = NA, - .formats = .formats) + in_rows( + n = sum(!is.na(x)), + median = median(x, na.rm = TRUE), + "mean (sd)" = c(mean(x, na.rm = TRUE), sd(x, na.rm = TRUE)), + "missing_val" = NA, + .formats = .formats + ) } - - ## tern style row naming partial match support +## tern style row naming partial match support factor_count_prepend_var <- function(x, .var) { stopifnot(is.factor(x)) vals <- as.list(table(x)) @@ -1787,21 +1778,26 @@ factor_count_prepend_var <- function(x, .var) { in_rows(.list = vals, .names = paste0(.var, names(vals)), .labels = levels(x)) } -alt_fmts <- list(list(median = "xx.x", - "mean (sd)" = "xx.xx (xx.xxx)", - missing_val = "xx", - STRATA1 = "xx")) - -crp_fmts <- list(list(median = "xx.", - "mean (sd)" = "xx.x (xx.xx)", - missing_val = "xx", - STRATA1 = "N=xx")) +alt_fmts <- list(list( + median = "xx.x", + "mean (sd)" = "xx.xx (xx.xxx)", + missing_val = "xx", + STRATA1 = "xx" +)) -iga_fmts <- list(list(median = "xx.xx", - "mean (sd)" = "xx. (xx.x)", - missing_val = "xx", - STRATA1 = "xx.x")) +crp_fmts <- list(list( + median = "xx.", + "mean (sd)" = "xx.x (xx.xx)", + missing_val = "xx", + STRATA1 = "N=xx" +)) +iga_fmts <- list(list( + median = "xx.xx", + "mean (sd)" = "xx. (xx.x)", + missing_val = "xx", + STRATA1 = "xx.x" +)) test_that("formats_var works in analyze()", { @@ -1809,14 +1805,13 @@ test_that("formats_var works in analyze()", { adlb$formats <- alt_fmts adlb$formats[adlb$PARAMCD == "CRP"] <- crp_fmts - + adlb$formats[adlb$PARAMCD == "IGA"] <- iga_fmts adlb$na_strs <- list(list()) adlb$na_strs[adlb$PARAMCD == "CRP"] <- list(list(missing_val = "n/a")) adlb$na_strs[adlb$PARAMCD == "IGA"] <- list(list(missing_val = "-")) - - + ## works without also specifying na_strs_var lyt <- basic_table() |> @@ -1830,35 +1825,46 @@ test_that("formats_var works in analyze()", { mpf_fmts_real <- mf_formats(mpf)[-1, -1] # no row labs, no col labs - mpf_fmts_exp <- matrix(c("-", "xx", unlist(alt_fmts[[1]][1:3]), ## no STRATA1 here and below - "-", "xx", unlist(crp_fmts[[1]][1:3]), - "-", "xx", unlist(iga_fmts[[1]][1:3])), - nrow = nrow(mpf_fmts_real), - ncol = ncol(mpf_fmts_real)) + mpf_fmts_exp <- matrix( + c( + "-", "xx", unlist(alt_fmts[[1]][1:3]), ## no STRATA1 here and below + "-", "xx", unlist(crp_fmts[[1]][1:3]), + "-", "xx", unlist(iga_fmts[[1]][1:3]) + ), + nrow = nrow(mpf_fmts_real), + ncol = ncol(mpf_fmts_real) + ) - expect_identical(mpf_fmts_real, - mpf_fmts_exp) + expect_identical( + mpf_fmts_real, + mpf_fmts_exp + ) fmtcells <- get_formatted_cells(tbl) - expect_equal(fmtcells[c(3:4, 8:9, 13:14),1], - c("49.6", "49.91 (8.098)", - "50", "50.2 (8.61)", - "49.69", "50 (7.8)")) + expect_equal( + fmtcells[c(3:4, 8:9, 13:14), 1], + c( + "49.6", "49.91 (8.098)", + "50", "50.2 (8.61)", + "49.69", "50 (7.8)" + ) + ) ## can use formats_var with na_str specified the old way lyta <- basic_table() |> split_cols_by("ARM") |> split_rows_by("PARAMCD") |> analyze("AVAL", - fmts_afun, - formats_var = "formats", - na_str = "global na cha cha cha") + fmts_afun, + formats_var = "formats", + na_str = "global na cha cha cha" + ) tbla <- build_table(lyta, adlb) expect_true( - all(get_formatted_cells(tbla)[c(5, 10, 15), ] == "global na cha cha cha") + all(get_formatted_cells(tbla)[c(5, 10, 15), ] == "global na cha cha cha") ) ## works when also specifying na_strs_var @@ -1871,23 +1877,25 @@ test_that("formats_var works in analyze()", { fmtcells2 <- get_formatted_cells(tbl2) expect_true(all(fmtcells2[5, ] == "NA") && - all(fmtcells2[10, ] == "n/a") && - all(fmtcells2[15, ] == "-")) + all(fmtcells2[10, ] == "n/a") && + all(fmtcells2[15, ] == "-")) ## precendence and interaction with .formats use in in_rows lyt3 <- basic_table() |> split_cols_by("ARM") |> split_rows_by("PARAMCD") |> - analyze("AVAL", fmts_afun, formats_var = "formats", - extra_args = list( - .formats = list( - n = "xx", - median = "xx.xxx", - "mean (sd)" = "xx.x - xx.x", - missing_val = "xx" - ) - )) + analyze("AVAL", fmts_afun, + formats_var = "formats", + extra_args = list( + .formats = list( + n = "xx", + median = "xx.xxx", + "mean (sd)" = "xx.x - xx.x", + missing_val = "xx" + ) + ) + ) tbl3 <- build_table(lyt3, adlb) @@ -1895,14 +1903,15 @@ test_that("formats_var works in analyze()", { split_cols_by("ARM") |> split_rows_by("PARAMCD") |> analyze("AVAL", fmts_afun, - extra_args = list( - .formats = list( - n = "xx", - median = "xx.xxx", - "mean (sd)" = "xx.x - xx.x", - missing_val = "xx" - ) - )) + extra_args = list( + .formats = list( + n = "xx", + median = "xx.xxx", + "mean (sd)" = "xx.x - xx.x", + missing_val = "xx" + ) + ) + ) tbl3b <- build_table(lyt3, adlb) @@ -1911,15 +1920,17 @@ test_that("formats_var works in analyze()", { lyt3c <- basic_table() |> split_cols_by("ARM") |> split_rows_by("PARAMCD") |> - analyze("AVAL", fmts_afun, formats_var = "formats", - extra_args = list( - .formats = list( - n = "default", - median = "default", - "mean (sd)" = "default", - missing_val = "default" - ) - )) + analyze("AVAL", fmts_afun, + formats_var = "formats", + extra_args = list( + .formats = list( + n = "default", + median = "default", + "mean (sd)" = "default", + missing_val = "default" + ) + ) + ) tbl3c <- build_table(lyt3c, adlb) @@ -1941,7 +1952,7 @@ test_that("formats_var works in analyze()", { expect_identical(fmtcells4[2, 1], format_value(alt_a_cnt, "xx")) expect_identical(fmtcells4[7, 2], format_value(crp_b_cnt, "N=xx")) expect_identical(fmtcells4[12, 3], format_value(iga_c_cnt, "xx.x")) - + ## most specific for multiple partial matches @@ -1954,14 +1965,13 @@ test_that("formats_var works in analyze()", { }) test_that("New format as list of formats for diff vars in analyze works", { - ## ugh apparently simple_analysis applies a format!!!!!!!!!!!! x.x my_stupid_afun <- function(x) { if (is.factor(x)) { vallst <- lapply(table(x), rcell) - names(vallst) <- levels(x) - } else if(is(x, "numeric")) { + names(vallst) <- levels(x) + } else if (is(x, "numeric")) { vallst <- list(Mean = rcell(mean(x, na.rm = TRUE))) } else { stop("no") @@ -1972,17 +1982,20 @@ test_that("New format as list of formats for diff vars in analyze works", { ## basic case: list of individual formats, one for each var lyt <- basic_table() |> analyze(c("AGE", "BMRKR1", "STRATA1"), - afun = my_stupid_afun, - format = list(AGE = "xx.x", - BMRKR1 = "xx.xx", - STRATA1 = "N=xx")) - + afun = my_stupid_afun, + format = list( + AGE = "xx.x", + BMRKR1 = "xx.xx", + STRATA1 = "N=xx" + ) + ) + tbl <- build_table(lyt, ex_adsl) age_mean <- mean(ex_adsl$AGE, na.rm = TRUE) bmrkr1_mean <- mean(ex_adsl$BMRKR1, na.rm = TRUE) strata1_counts <- table(ex_adsl$STRATA1) - sex_counts <- table(ex_adsl$SEX) + sex_counts <- table(ex_adsl$SEX) exp <- matrix( c( "", @@ -2004,10 +2017,13 @@ test_that("New format as list of formats for diff vars in analyze works", { lyt_old <- basic_table() |> analyze(c("AGE", "BMRKR1", "STRATA1", "SEX"), - afun = my_stupid_afun, - format = list("xx.x", - "xx.xx", - "N=xx")) + afun = my_stupid_afun, + format = list( + "xx.x", + "xx.xx", + "N=xx" + ) + ) tbl_old <- build_table(lyt_old, ex_adsl) @@ -2022,12 +2038,14 @@ test_that("New format as list of formats for diff vars in analyze works", { format_value(bmrkr1_mean, "xx.x"), "", mapply(format_value, - x = strata1_counts, - format = fmtvec), + x = strata1_counts, + format = fmtvec + ), "", mapply(format_value, - x = sex_counts, - format = fmtvec) # !! insane recycling behavior. what?!? + x = sex_counts, + format = fmtvec + ) # !! insane recycling behavior. what?!? ) )) @@ -2038,17 +2056,20 @@ test_that("New format as list of formats for diff vars in analyze works", { ## even newer extra hotness: list of formats for each var ## beware extra layer of listiness between list column case and this one! - varfmts <- list(AGE = alt_fmts[[1]], - BMRKR1 = crp_fmts[[1]], - STRATA1 = crp_fmts[[1]], - SEX = iga_fmts[[1]]) + varfmts <- list( + AGE = alt_fmts[[1]], + BMRKR1 = crp_fmts[[1]], + STRATA1 = crp_fmts[[1]], + SEX = iga_fmts[[1]] + ) ## part one, single afun exact matches lyt2 <- basic_table() |> analyze(c("AGE", "BMRKR1"), - afun = fmts_afun, - format = varfmts) + afun = fmts_afun, + format = varfmts + ) tbl2 <- build_table(lyt2, ex_adsl) @@ -2067,19 +2088,22 @@ test_that("New format as list of formats for diff vars in analyze works", { "", format_value(sum(!is.na(ex_adsl$BMRKR1)), "xx"), format_value(median(ex_adsl$BMRKR1), "xx."), - format_value(c(mean(ex_adsl$BMRKR1), sd(ex_adsl$BMRKR1)), - "xx.x (xx.xx)"), + format_value( + c(mean(ex_adsl$BMRKR1), sd(ex_adsl$BMRKR1)), + "xx.x (xx.xx)" + ), "NA" ) ) ) - + ## part two, single afun partial matches lyt3 <- basic_table() |> analyze(c("STRATA1", "SEX"), - afun = factor_count_prepend_var, - format = varfmts) + afun = factor_count_prepend_var, + format = varfmts + ) tbl3 <- build_table(lyt3, ex_adsl) fmtcells3 <- get_formatted_cells(tbl3) @@ -2101,18 +2125,23 @@ test_that("New format as list of formats for diff vars in analyze works", { lyt4 <- basic_table() |> analyze(c("AGE", "BMRKR1", "STRATA1", "SEX"), - afun = list(fmts_afun, - fmts_afun, - factor_count_prepend_var, - factor_count_prepend_var), - format = varfmts) + afun = list( + fmts_afun, + fmts_afun, + factor_count_prepend_var, + factor_count_prepend_var + ), + format = varfmts + ) tbl4 <- build_table(lyt4, ex_adsl) fmtcells4 <- get_formatted_cells(tbl4) - expect_identical(fmtcells4, - rbind(fmtcells2, fmtcells3)) + expect_identical( + fmtcells4, + rbind(fmtcells2, fmtcells3) + ) ## does it work with "the functions"? @@ -2120,14 +2149,19 @@ test_that("New format as list of formats for diff vars in analyze works", { lyt5 <- basic_table() |> analyze(c("AGE", "BMRKR1", "STRATA1", "SEX"), - afun = list(fmts_afun, - fmts_afun, - factor_count_prepend_var, - factor_count_prepend_var), - format = list(AGE = bad_fmt_factory("AGE"), - BMRKR1 = bad_fmt_factory("BMRKR1"), - STRATA1 = bad_fmt_factory("STRATA1"), - SEX = bad_fmt_factory("SEX"))) + afun = list( + fmts_afun, + fmts_afun, + factor_count_prepend_var, + factor_count_prepend_var + ), + format = list( + AGE = bad_fmt_factory("AGE"), + BMRKR1 = bad_fmt_factory("BMRKR1"), + STRATA1 = bad_fmt_factory("STRATA1"), + SEX = bad_fmt_factory("SEX") + ) + ) tbl5 <- build_table(lyt5, ex_adsl) @@ -2139,7 +2173,7 @@ test_that("New format as list of formats for diff vars in analyze works", { ncol = 1, c( c("", rep("AGE", 3), "NA"), - c("", rep("BMRKR1", 3), "NA"), + c("", rep("BMRKR1", 3), "NA"), c("", rep("STRATA1", 3)), c("", rep("SEX", 4)) ) From d122b42df7e59840cc777b1ac6f74a1d4ecf904c Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Sat, 13 Dec 2025 01:15:15 +0000 Subject: [PATCH 07/15] [skip roxygen] [skip vbump] Roxygen Man Pages Auto Update --- man/rtables-package.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/rtables-package.Rd b/man/rtables-package.Rd index 75733fad90..d9ea24e78b 100644 --- a/man/rtables-package.Rd +++ b/man/rtables-package.Rd @@ -30,7 +30,7 @@ Authors: Other contributors: \itemize{ - \item Daniel Sabans Bov \email{daniel.sabanes_bove@roche.com} [contributor] + \item Daniel Sabanés Bové \email{daniel.sabanes_bove@roche.com} [contributor] \item Maximilian Mordig \email{maximilian_oliver.mordig@roche.com} [contributor] \item Abinaya Yogasekaram \email{abinaya.yogasekaram@contractors.roche.com} (\href{https://orcid.org/0009-0005-2083-1105}{ORCID}) [contributor] \item F. Hoffmann-La Roche AG [copyright holder, funder] From d5ddb93dee066f7a783db5d00579bae20745d115 Mon Sep 17 00:00:00 2001 From: Gabe Becker Date: Fri, 12 Dec 2025 20:25:24 -0800 Subject: [PATCH 08/15] Updated analyze documentaiton with details on formatting behavior --- R/colby_constructors.R | 83 +++++++++++++++++++++++++++++++++++--- man/analyze.Rd | 90 +++++++++++++++++++++++++++++++++++++----- 2 files changed, 158 insertions(+), 15 deletions(-) diff --git a/R/colby_constructors.R b/R/colby_constructors.R index 80024e065c..9a0161d09b 100644 --- a/R/colby_constructors.R +++ b/R/colby_constructors.R @@ -1067,12 +1067,81 @@ NULL #' divider will be overridden by a split-level section divider when #' both apply to the same position in the rendered output. #' -#' @inherit split_cols_by return -#' -#' @details -#' When non-`NULL`, `format` is used to specify formats for all generated rows, and can be a character vector, a -#' function, or a list of functions. It will be repped out to the number of rows once this is calculated during the -#' tabulation process, but will be overridden by formats specified within `rcell` calls in `afun`. +#' @details When `length(vars) > 1` and when two calls to `analyze` +#' are done in sequence (the second with the default `nested = +#' TRUE`), the analyses will be combined into a multi-variable +#' analysis that will be reflected in the row structure of the +#' resulting table. In these cases, the default is to show the +#' label describing the variable analyzed for each of the +#' resulting subtables, while that is hidden by default in +#' one-variable cases. +#' +#' # Specifying Default Formatting Behavior +#' +#' *Default* formatting behavior for rows generated by `afun` can be +#' specified by one of `format` or `formats_var`. In both cases, these +#' default formatting instructions *will not* supersede formatting +#' specified from within `afun` at either the `rcell` or `in_rows` +#' call levels; They will only apply to rows/cells whose formatting as +#' returned by `afun` is either `NULL` or `"default"`. When +#' non-`NULL`, `format` is used to specify formats for all generated +#' rows, and can be a character vector, a function, or a list of +#' functions. It will be repped out to the number of rows once this is +#' calculated during the tabulation process, but will be overridden by +#' formats specified within `rcell` calls in `afun`. +#' +#' `format` can accept a format label string (see +#' [formatters::list_valid_format_labels()]), a formatting function, an +#' unnamed list, or a named list. +#' +#' When `format` is an unnamed list - or a named list where not all +#' values of `vars` appear in the names - its elements will be repped +#' out to the number of rows generated by `afun` (separately) within +#' each row facet `afun` is applied within. **This includes recycling +#' behavior, even in the case where the number of rows is not cleanly +#' divisible by the number of specified formats**. This behavior is +#' retained largely for legacy reasons and switching to the new +#' named-list behavior is advised where applicable. +#' +#' When `format` is a named list whose names contain all values in +#' `vars`, the elements of `format` are taken to be specific to the +#' analysis of the corresponding variable; this allows us to specify a +#' multi-variable analysis where e.g., the different variables are +#' analyzed by the same `afun` but have different levels of +#' measurement precision (and thus different formatting needs). In +#' this case the var-specific formatting can be a single format (label +#' string or function) or can be a named list whose names will be +#' matched up to those of the rows generated by applying `afun` in +#' each row facet. Matching of formats to rows is performed the same +#' as in the `formats_var` case and is described below. +#' +#' When `formats_var` is non-`NULL`, it specifies the name of a list +#' column containing formatting instructions for one or more rows +#' `afun` will generate when applied within a row facet. This can be +#' used when the analysis results for a single variable (e.g., `value` +#' or `AVAL` in long-form data) should be formatted differently within +#' different row facets (e.g., when faceting on `statistic` or +#' `PARAMCD`). The value of `df[[formats_var]]` is assumed without +#' verification to be constant within each row facet `afun` is applied +#' within, and the first (list) value of the column within the row +#' facet data will be used. +#' +#' In the `formats_var` case as well as the case of `format` being a +#' named list containing the values of `vars`, after rows are created +#' during tabulation, the default formats are matched and applied to +#' them as follows: +#' +#' 1. When the generated row's name (as given by `obj_name`) matches +#' a name in the list, the corresponding default format is applied, +#' 2. for those without exact matches, the default format whose name +#' provides *the best partial match* to each row name is applied, +#' 3. For those without default format names that partially match +#' the row name, no default format is applied. +#' +#' Note carefully that in (2), it is the names of the list of formats +#' that are partially matching the row names not the other way around. +#' +#' # The Analysis Function #' #' The analysis function (`afun`) should take as its first parameter either `x` or `df`. Whichever of these the #' function accepts will change the behavior when tabulation is performed as follows: @@ -1086,6 +1155,8 @@ NULL #' other parameters which, *if and only if* present in the formals, will be passed to the function by the tabulation #' machinery. These are listed and described in [additional_fun_params]. #' +#' @inherit split_cols_by return +#' #' @note None of the arguments described in [additional_fun_params] can be overridden via `extra_args` or when calling #' [make_afun()]. `.N_col` and `.N_total` can be overridden via the `col_counts` argument to [build_table()]. #' Alternative values for the others must be calculated within `afun` based on a combination of extra arguments and diff --git a/man/analyze.Rd b/man/analyze.Rd index 8be604968c..4803c19787 100644 --- a/man/analyze.Rd +++ b/man/analyze.Rd @@ -83,10 +83,87 @@ adding calls to \code{analyze} and/or \code{\link[=analyze_colvars]{analyze_colv the tabulation will occur at the current/next level of nesting by default. } \details{ -When non-\code{NULL}, \code{format} is used to specify formats for all generated rows, and can be a character vector, a -function, or a list of functions. It will be repped out to the number of rows once this is calculated during the -tabulation process, but will be overridden by formats specified within \code{rcell} calls in \code{afun}. +When \code{length(vars) > 1} and when two calls to \code{analyze} +are done in sequence (the second with the default \code{nested = TRUE}), the analyses will be combined into a multi-variable +analysis that will be reflected in the row structure of the +resulting table. In these cases, the default is to show the +label describing the variable analyzed for each of the +resulting subtables, while that is hidden by default in +one-variable cases. +} +\note{ +None of the arguments described in \link{additional_fun_params} can be overridden via \code{extra_args} or when calling +\code{\link[=make_afun]{make_afun()}}. \code{.N_col} and \code{.N_total} can be overridden via the \code{col_counts} argument to \code{\link[=build_table]{build_table()}}. +Alternative values for the others must be calculated within \code{afun} based on a combination of extra arguments and +the unmodified values provided by the tabulation framework. +} +\section{Specifying Default Formatting Behavior}{ +\emph{Default} formatting behavior for rows generated by \code{afun} can be +specified by one of \code{format} or \code{formats_var}. In both cases, these +default formatting instructions \emph{will not} supersede formatting +specified from within \code{afun} at either the \code{rcell} or \code{in_rows} +call levels; They will only apply to rows/cells whose formatting as +returned by \code{afun} is either \code{NULL} or \code{"default"}. When +non-\code{NULL}, \code{format} is used to specify formats for all generated +rows, and can be a character vector, a function, or a list of +functions. It will be repped out to the number of rows once this is +calculated during the tabulation process, but will be overridden by +formats specified within \code{rcell} calls in \code{afun}. + +\code{format} can accept a format label string (see +\code{\link[formatters:list_formats]{formatters::list_valid_format_labels()}}), a formatting function, an +unnamed list, or a named list. + +When \code{format} is an unnamed list - or a named list where not all +values of \code{vars} appear in the names - its elements will be repped +out to the number of rows generated by \code{afun} (separately) within +each row facet \code{afun} is applied within. \strong{This includes recycling +behavior, even in the case where the number of rows is not cleanly +divisible by the number of specified formats}. This behavior is +retained largely for legacy reasons and switching to the new +named-list behavior is advised where applicable. + +When \code{format} is a named list whose names contain all values in +\code{vars}, the elements of \code{format} are taken to be specific to the +analysis of the corresponding variable; this allows us to specify a +multi-variable analysis where e.g., the different variables are +analyzed by the same \code{afun} but have different levels of +measurement precision (and thus different formatting needs). In +this case the var-specific formatting can be a single format (label +string or function) or can be a named list whose names will be +matched up to those of the rows generated by applying \code{afun} in +each row facet. Matching of formats to rows is performed the same +as in the \code{formats_var} case and is described below. + +When \code{formats_var} is non-\code{NULL}, it specifies the name of a list +column containing formatting instructions for one or more rows +\code{afun} will generate when applied within a row facet. This can be +used when the analysis results for a single variable (e.g., \code{value} +or \code{AVAL} in long-form data) should be formatted differently within +different row facets (e.g., when faceting on \code{statistic} or +\code{PARAMCD}). The value of \code{df[[formats_var]]} is assumed without +verification to be constant within each row facet \code{afun} is applied +within, and the first (list) value of the column within the row +facet data will be used. + +In the \code{formats_var} case as well as the case of \code{format} being a +named list containing the values of \code{vars}, after rows are created +during tabulation, the default formats are matched and applied to +them as follows: +\enumerate{ +\item When the generated row's name (as given by \code{obj_name}) matches +a name in the list, the corresponding default format is applied, +\item for those without exact matches, the default format whose name +provides \emph{the best partial match} to each row name is applied, +\item For those without default format names that partially match +the row name, no default format is applied. +} +Note carefully that in (2), it is the names of the list of formats +that are partially matching the row names not the other way around. +} + +\section{The Analysis Function}{ The analysis function (\code{afun}) should take as its first parameter either \code{x} or \code{df}. Whichever of these the function accepts will change the behavior when tabulation is performed as follows: \itemize{ @@ -100,12 +177,7 @@ In addition to differentiation on the first argument, the analysis function can other parameters which, \emph{if and only if} present in the formals, will be passed to the function by the tabulation machinery. These are listed and described in \link{additional_fun_params}. } -\note{ -None of the arguments described in \link{additional_fun_params} can be overridden via \code{extra_args} or when calling -\code{\link[=make_afun]{make_afun()}}. \code{.N_col} and \code{.N_total} can be overridden via the \code{col_counts} argument to \code{\link[=build_table]{build_table()}}. -Alternative values for the others must be calculated within \code{afun} based on a combination of extra arguments and -the unmodified values provided by the tabulation framework. -} + \examples{ lyt <- basic_table() \%>\% split_cols_by("ARM") \%>\% From b03289323cbc60b00d4d34dc6c77968ef7b042e0 Mon Sep 17 00:00:00 2001 From: Joe Zhu Date: Sat, 13 Dec 2025 19:06:22 +0800 Subject: [PATCH 09/15] Trigger Build From bfc1c75a3b28726f9a5d5b93550b6db322cc3c5f Mon Sep 17 00:00:00 2001 From: Joe Zhu Date: Sat, 13 Dec 2025 19:10:06 +0800 Subject: [PATCH 10/15] update wordlist --- inst/WORDLIST | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/inst/WORDLIST b/inst/WORDLIST index f497ed84b1..f5069ba64c 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -11,6 +11,7 @@ biomarker BMEASIFL Bov Bov +Bové Carreras charset Cheatsheet @@ -44,6 +45,7 @@ ie indicies ing initializer +Kelkhoff labelled Layouting layouting @@ -72,6 +74,7 @@ postfix postprocessing Pre pre +Qi reindexed repped responder @@ -83,6 +86,7 @@ rtables Rua Saban Sabans +Sabanés Saibah SKELETOMUSCULAR sortable From 0984860b23ad02066d2ebfac19e47ac8127c4994 Mon Sep 17 00:00:00 2001 From: Gabe Becker Date: Sat, 13 Dec 2025 17:43:31 -0800 Subject: [PATCH 11/15] new tests, perfect* coverage of new code in tt_dotabulation.R --- R/00tabletrees.R | 7 +- R/tt_dotabulation.R | 26 +- tests/testthat/test-lyt-tabulation.R | 809 ++++++++++++++++----------- 3 files changed, 493 insertions(+), 349 deletions(-) diff --git a/R/00tabletrees.R b/R/00tabletrees.R index deae810c62..0410b631aa 100644 --- a/R/00tabletrees.R +++ b/R/00tabletrees.R @@ -875,7 +875,6 @@ AnalyzeMultiVars <- function(var, extra_args = extra_args, indent_mod = indent_mod, label_pos = show_kidlabs, - split_na_str = split_na_str, section_div = section_div_if_multivar, formats_var = formats_var, na_strs_var = na_strs_var @@ -884,6 +883,7 @@ AnalyzeMultiVars <- function(var, all(var %in% names(split_format)) && all(vapply(split_format, is, class2 = "FormatList", TRUE)) if (mv_list_case) { # diff format list for each var + stopifnot(all(var %in% names(split_na_str))) ## split_value does *not* go in more args, not constant across vars pld <- mapply( AnalyzeVarSplit, @@ -896,6 +896,7 @@ AnalyzeMultiVars <- function(var, cformat = cformat, ## in case they're in the wrong order for some insane reason split_format = split_format[var], + split_na_str = split_na_str[var], inclNAs = inclNAs, MoreArgs = moreargs, ## rvis), SIMPLIFY = FALSE @@ -912,7 +913,9 @@ AnalyzeMultiVars <- function(var, cfun = cfun, cformat = cformat, inclNAs = inclNAs, - MoreArgs = c(moreargs, list(split_format = split_format)), ## rvis), + MoreArgs = c(moreargs, + list(split_format = split_format, + split_na_str = split_na_str)), ## rvis), SIMPLIFY = FALSE ) } diff --git a/R/tt_dotabulation.R b/R/tt_dotabulation.R index 9a8cb4c661..6e479c1f20 100644 --- a/R/tt_dotabulation.R +++ b/R/tt_dotabulation.R @@ -553,7 +553,7 @@ gen_rowvalues <- function(dfpart, ## return index in tbl that has best partial match to str ## or NA_integer_ if none do inv_pmatch <- function(str, tbl) { - inds <- pmatch(tbl, str) + inds <- pmatch(tbl, str, duplicates.ok = TRUE) found_inds <- which(!is.na(inds)) ret <- NA_integer_ if (length(found_inds) == 1) { @@ -566,6 +566,9 @@ inv_pmatch <- function(str, tbl) { ret } +.got_noname_single <- function(lst) { + is.list(lst) && length(lst) == 1 && is.null(names(lst)) +} .apply_default_formats <- function(kidlst, fmtlst, nastrlst = character()) { if (length(fmtlst) == 0 && length(nastrlst) == 0) { return(kidlst) @@ -582,30 +585,39 @@ inv_pmatch <- function(str, tbl) { if (is.character(nastrlst) && length(nastrlst) >= 1) { missing_nastr_val <- nastrlst nastrlst <- list() + } else if (.got_noname_single(nastrlst)) { + missing_nastr_val <- nastrlst[[1]] + natsrlst <- list() } else { missing_nastr_val <- NA_character_ } - if (!is.list(fmtlst)) { + if (!is.list(fmtlst)) { ## appears impossible?? missing_fmt_val <- fmtlst fmtlst <- list() - } else if (length(fmtlst) == 1 && - is.null(names(fmtlst)) && - is(fmtlst[[1]], "FormatSpec")) { + } else if (.got_noname_single(fmtlst)) { + stopifnot(is(fmtlst[[1]], "FormatSpec")) missing_fmt_val <- fmtlst[[1]] fmtlst <- list() } else { missing_fmt_val <- NULL } - missing_nastrs <- setdiff(names(fmtlst), names(nastrlst)) + if (length(names(fmtlst)) > 0 || length(names(nastrlst)) > 0) { + missing_nastrs <- setdiff(names(fmtlst), names(nastrlst)) + missing_fmts <- setdiff(names(nastrlst), names(fmtlst)) + } else { + missing_nastrs <- names(kidlst) + missing_fmts <- names(kidlst) + } + if (length(missing_nastrs) > 0) { nastrlst[missing_nastrs] <- missing_nastr_val } - missing_fmts <- setdiff(names(nastrlst), names(fmtlst)) if (length(missing_fmts) > 0) { fmtlst[missing_fmts] <- list(missing_fmt_val) } + ## they may be in different orders, if so fix it stopifnot(intersect(names(fmtlst), names(nastrlst)) == names(fmtlst)) nastrlst <- nastrlst[names(fmtlst)] diff --git a/tests/testthat/test-lyt-tabulation.R b/tests/testthat/test-lyt-tabulation.R index c70eceaf1e..2b100f1a0e 100644 --- a/tests/testthat/test-lyt-tabulation.R +++ b/tests/testthat/test-lyt-tabulation.R @@ -2,10 +2,10 @@ context("Tabulation framework") test_that("summarize_row_groups works with provided funcs", { - l1 <- basic_table() %>% - split_cols_by("ARM") %>% - split_rows_by("RACE") %>% - summarize_row_groups() %>% + l1 <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("RACE") |> + summarize_row_groups() |> analyze("AGE", mean) expect_silent( @@ -27,17 +27,17 @@ test_that("complex layout works", { expect_identical(row.names(tab), complx_lyt_rnames) tlvals <- c("Ethnicity", "Factor 2") - lyt2 <- lyt %>% append_topleft(tlvals) + lyt2 <- lyt |> append_topleft(tlvals) tab2 <- build_table(lyt2, rawdat) expect_identical(top_left(tab2), tlvals) }) test_that("existing table in layout works", { - thing2 <- basic_table() %>% - split_cols_by("ARM") %>% + thing2 <- basic_table() |> + split_cols_by("ARM") |> ## add nested column split on SEX with value labels from gend_label - split_cols_by("SEX", "Gender", labels_var = "gend_label") %>% + split_cols_by("SEX", "Gender", labels_var = "gend_label") |> analyze( c("AGE", "AGE"), c("Age Analysis", "Age Analysis Redux"), afun = function(x) list(mean = mean(x), median = median(x)), @@ -48,16 +48,16 @@ test_that("existing table in layout works", { tab2 <- build_table(thing2, rawdat) - thing3 <- basic_table() %>% - split_cols_by("ARM") %>% + thing3 <- basic_table() |> + split_cols_by("ARM") |> ## add nested column split on SEX with value labels from gend_label - split_cols_by("SEX", "Gender", labels_var = "gend_label") %>% - split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label") %>% - summarize_row_groups("RACE", label_fstr = "%s (n)") %>% + split_cols_by("SEX", "Gender", labels_var = "gend_label") |> + split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label") |> + summarize_row_groups("RACE", label_fstr = "%s (n)") |> analyze("AGE", "Age Analysis", afun = function(x) list(mean = mean(x), median = median(x)), format = "xx.xx" - ) %>% + ) |> ## stack an existing table onto the layout and thus the generated table add_existing_table(tab2) @@ -68,10 +68,10 @@ test_that("existing table in layout works", { test_that("Nested splits in column space work", { dat2 <- subset(ex_adsl, SEX %in% c("M", "F")) - tbl2 <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by("SEX", split_fun = drop_split_levels) %>% - analyze(c("AGE", "STRATA1")) %>% + tbl2 <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by("SEX", split_fun = drop_split_levels) |> + analyze(c("AGE", "STRATA1")) |> build_table(dat2) mf <- matrix_form(tbl2) @@ -90,15 +90,15 @@ test_that("Nested splits in column space work", { test_that("labelkids parameter works", { - yeslabellyt <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by("SEX", "Gender", labels_var = "gend_label") %>% - split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label", child_labels = "visible") %>% - summarize_row_groups("RACE", label_fstr = "%s (n)") %>% + yeslabellyt <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by("SEX", "Gender", labels_var = "gend_label") |> + split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label", child_labels = "visible") |> + summarize_row_groups("RACE", label_fstr = "%s (n)") |> split_rows_by("FACTOR2", "Factor2", split_fun = remove_split_levels("C"), labels_var = "fac2_label", child_labels = "visible" - ) %>% + ) |> analyze( "AGE", "Age Analysis", afun = function(x) list(mean = mean(x), median = median(x)), @@ -114,15 +114,15 @@ test_that("labelkids parameter works", { ) - misslabellyt <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by("SEX", "Gender", labels_var = "gend_label") %>% - split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label", child_labels = "default") %>% - summarize_row_groups("RACE", label_fstr = "%s (n)") %>% + misslabellyt <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by("SEX", "Gender", labels_var = "gend_label") |> + split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label", child_labels = "default") |> + summarize_row_groups("RACE", label_fstr = "%s (n)") |> split_rows_by("FACTOR2", "Factor2", split_fun = remove_split_levels("C"), labels_var = "fac2_label", child_labels = "default" - ) %>% + ) |> analyze( "AGE", "Age Analysis", afun = function(x) list(mean = mean(x), median = median(x)), @@ -136,15 +136,15 @@ test_that("labelkids parameter works", { ) - nolabellyt <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by("SEX", "Gender", labels_var = "gend_label") %>% - split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label", child_labels = "hidden") %>% - summarize_row_groups("RACE", label_fstr = "%s (n)") %>% + nolabellyt <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by("SEX", "Gender", labels_var = "gend_label") |> + split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label", child_labels = "hidden") |> + summarize_row_groups("RACE", label_fstr = "%s (n)") |> split_rows_by("FACTOR2", "Factor2", split_fun = remove_split_levels("C"), labels_var = "fac2_label", child_labels = "hidden" - ) %>% + ) |> analyze( "AGE", "Age Analysis", afun = function(x) list(mean = mean(x), median = median(x)), @@ -159,15 +159,15 @@ test_that("labelkids parameter works", { c("Caucasian (n)", "mean", "median", "mean") ) - mixedlyt2 <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by("SEX", "Gender", labels_var = "gend_label") %>% - split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label", child_labels = "hidden") %>% - summarize_row_groups("RACE", label_fstr = "%s (n)") %>% + mixedlyt2 <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by("SEX", "Gender", labels_var = "gend_label") |> + split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label", child_labels = "hidden") |> + summarize_row_groups("RACE", label_fstr = "%s (n)") |> split_rows_by("FACTOR2", "Factor2", split_fun = remove_split_levels("C"), labels_var = "fac2_label", child_labels = "hidden" - ) %>% + ) |> analyze( "AGE", "Age Analysis", afun = function(x) list(mean = mean(x), median = median(x)), @@ -182,15 +182,15 @@ test_that("labelkids parameter works", { ) - mixedlyt <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by("SEX", "Gender", labels_var = "gend_label") %>% - split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label", child_labels = "visible") %>% - summarize_row_groups("RACE", label_fstr = "%s (n)") %>% + mixedlyt <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by("SEX", "Gender", labels_var = "gend_label") |> + split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label", child_labels = "visible") |> + summarize_row_groups("RACE", label_fstr = "%s (n)") |> split_rows_by("FACTOR2", "Factor2", split_fun = remove_split_levels("C"), labels_var = "fac2_label", child_labels = "visible" - ) %>% + ) |> analyze( "AGE", "Age Analysis", afun = function(x) list(mean = mean(x), median = median(x)), @@ -205,16 +205,16 @@ test_that("labelkids parameter works", { ) - varshowlyt <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by("SEX", "Gender", labels_var = "gend_label") %>% - split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label") %>% - summarize_row_groups("RACE", label_fstr = "%s (n)") %>% + varshowlyt <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by("SEX", "Gender", labels_var = "gend_label") |> + split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label") |> + summarize_row_groups("RACE", label_fstr = "%s (n)") |> split_rows_by("FACTOR2", "Factor2", split_fun = remove_split_levels("C"), labels_var = "fac2_label", label_pos = "visible" - ) %>% + ) |> analyze( "AGE", "Age Analysis", afun = function(x) list(mean = mean(x), median = median(x)), @@ -234,9 +234,9 @@ test_that("ref_group comparisons work", { skip_if_not_installed("tibble") require(tibble, quietly = TRUE) - blthing <- basic_table() %>% - split_cols_by("ARM", ref_group = "ARM1") %>% - analyze("AGE", show_labels = "hidden") %>% + blthing <- basic_table() |> + split_cols_by("ARM", ref_group = "ARM1") |> + analyze("AGE", show_labels = "hidden") |> analyze("AGE", refcompmean, show_labels = "hidden", table_names = "AGE2") ## function(x) list(mean = mean(x))) @@ -249,19 +249,19 @@ test_that("ref_group comparisons work", { c3 <- bltab[2, 2, drop = TRUE] expect_equivalent(c2 - c1, c3) - lyt <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by("SEX", ref_group = "F") %>% - analyze("AGE", mean, show_labels = "hidden") %>% + lyt <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by("SEX", ref_group = "F") |> + analyze("AGE", mean, show_labels = "hidden") |> analyze("AGE", refcompmean, show_labels = "hidden", table_names = "AGE2a" - ) %>% + ) |> split_rows_by("RACE", nested = FALSE, split_fun = drop_split_levels - ) %>% - analyze("AGE", mean, show_labels = "hidden") %>% + ) |> + analyze("AGE", mean, show_labels = "hidden") |> analyze("AGE", refcompmean, show_labels = "hidden", table_names = "AGE2b") bltab2 <- build_table(lyt, DM) @@ -287,12 +287,12 @@ test_that("ref_group comparisons work", { "B_C", "Arms B & C", c("B: Placebo", "C: Combination"), list() ) - l3 <- basic_table(show_colcounts = TRUE) %>% + l3 <- basic_table(show_colcounts = TRUE) |> split_cols_by( "ARM", split_fun = add_combo_levels(combodf, keep_levels = c("A_", "B_C")), ref_group = "A_" - ) %>% + ) |> analyze(c("AGE", "AGE"), afun = list(mean, refcompmean), show_labels = "hidden", table_names = c("AGE1", "AGE2") @@ -307,9 +307,9 @@ test_that("ref_group comparisons work", { }) test_that("missing vars caught", { - misscol <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by("SX", "Gender") %>% + misscol <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by("SX", "Gender") |> analyze("AGE", "Age Analysis", afun = function(x) list(mean = mean(x), median = median(x)), format = "xx.xx" @@ -320,10 +320,10 @@ test_that("missing vars caught", { "Split variable [[]SX[]] not found in data being tabulated." ) - missrsplit <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by("SEX", "gend_label") %>% - split_rows_by("RACER", "ethn_label") %>% + missrsplit <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by("SEX", "gend_label") |> + split_rows_by("RACER", "ethn_label") |> analyze("AGE", "Age Analysis", afun = function(x) list(mean = mean(x), median = median(x)), format = "xx.xx" @@ -334,10 +334,10 @@ test_that("missing vars caught", { "Split variable [[]RACER[]] not found in data being tabulated." ) - missrsplit <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by("SEX", "gend_label") %>% - split_rows_by("RACE", "ethnNA_label") %>% + missrsplit <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by("SEX", "gend_label") |> + split_rows_by("RACE", "ethnNA_label") |> analyze("AGE", "Age Analysis", afun = function(x) list(mean = mean(x), median = median(x)), format = "xx.xx" @@ -348,10 +348,10 @@ test_that("missing vars caught", { "Value label variable [[]ethnNA_label[]] not found in data being tabulated." ) - missavar <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by("SEX", labels_var = "gend_label") %>% - split_rows_by("RACE", labels_var = "ethn_label") %>% + missavar <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by("SEX", labels_var = "gend_label") |> + split_rows_by("RACE", labels_var = "ethn_label") |> analyze("AGGE", "Age Analysis", afun = function(x) list(mean = mean(x), median = median(x)), format = "xx.xx" @@ -373,9 +373,9 @@ test_that("error localization works", { in_rows(myrow = 5) } - lyt <- basic_table() %>% - split_rows_by("ARM") %>% - split_rows_by("RACE") %>% + lyt <- basic_table() |> + split_rows_by("ARM") |> + split_rows_by("RACE") |> analyze("BMRKR1", afun = afun) # nolint start expect_error( @@ -390,10 +390,10 @@ test_that("error localization works", { in_rows(val = 5) } - lyt2 <- basic_table() %>% - split_rows_by("ARM") %>% - summarize_row_groups(cfun = cfun) %>% - split_rows_by("RACE") %>% + lyt2 <- basic_table() |> + split_rows_by("ARM") |> + summarize_row_groups(cfun = cfun) |> + split_rows_by("RACE") |> analyze("BMRKR1", afun = mean) expect_error( @@ -405,10 +405,10 @@ test_that("error localization works", { stop("oopsie daisy") } - lyt3 <- basic_table() %>% - split_rows_by("ARM") %>% - summarize_row_groups() %>% - split_rows_by("RACE", split_fun = splfun) %>% + lyt3 <- basic_table() |> + split_rows_by("ARM") |> + summarize_row_groups() |> + split_rows_by("RACE", split_fun = splfun) |> analyze("BMRKR1", afun = mean) # nolint start expect_error( @@ -428,9 +428,9 @@ test_that("cfun args", { .names = labelstr ) } - lyt <- basic_table() %>% - split_cols_by("ARM") %>% - split_rows_by("SEX") %>% + lyt <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("SEX") |> summarize_row_groups(cfun = cfun1) tbl <- build_table(lyt, rawdat) @@ -448,9 +448,9 @@ test_that("cfun args", { ) ) } - lyt <- basic_table() %>% - split_cols_by("ARM") %>% - split_rows_by("SEX") %>% + lyt <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("SEX") |> summarize_row_groups("AGE", cfun = cfun2) tbl <- build_table(lyt, rawdat) @@ -461,28 +461,28 @@ test_that("cfun args", { ## regression test for automatically not-nesting ## when a non-analyze comes after an analyze test_that("split under analyze", { - dontnest <- basic_table(show_colcounts = TRUE) %>% - split_cols_by(var = "ARM") %>% - analyze("AGE") %>% - split_rows_by("VAR3") %>% - analyze("AGE") %>% + dontnest <- basic_table(show_colcounts = TRUE) |> + split_cols_by(var = "ARM") |> + analyze("AGE") |> + split_rows_by("VAR3") |> + analyze("AGE") |> build_table(rawdat) expect_equal(nrow(dontnest), 5) }) test_that("label_var works as expected", { - yeslblslyt <- basic_table(show_colcounts = TRUE) %>% - split_cols_by(var = "ARM") %>% - split_rows_by("SEX", labels_var = "gend_label") %>% + yeslblslyt <- basic_table(show_colcounts = TRUE) |> + split_cols_by(var = "ARM") |> + split_rows_by("SEX", labels_var = "gend_label") |> analyze("AGE") yeslbls <- build_table(yeslblslyt, rawdat) expect_identical(row.names(yeslbls)[1], "Male") - nolbls <- basic_table(show_colcounts = TRUE) %>% - split_cols_by(var = "ARM") %>% - split_rows_by("SEX") %>% - analyze("AGE") %>% + nolbls <- basic_table(show_colcounts = TRUE) |> + split_cols_by(var = "ARM") |> + split_rows_by("SEX") |> + analyze("AGE") |> build_table(rawdat) expect_identical(row.names(nolbls)[1], "M") @@ -502,16 +502,16 @@ test_that("label_var works as expected", { test_that("factors with unobserved levels work as expected", { ## default behavior is that empty levels are NOT dropped ## rows - lyt <- basic_table() %>% - split_rows_by("SEX") %>% + lyt <- basic_table() |> + split_rows_by("SEX") |> analyze("AGE") tab <- build_table(lyt, DM) expect_identical(dim(tab), c(8L, 1L)) ## cols - lyt2 <- basic_table() %>% - split_cols_by("SEX") %>% + lyt2 <- basic_table() |> + split_cols_by("SEX") |> analyze("AGE") tab2 <- build_table(lyt2, DM) expect_identical(dim(tab2), c(1L, 4L)) @@ -519,9 +519,9 @@ test_that("factors with unobserved levels work as expected", { test_that(".N_row argument in afun works correctly", { - lyt <- basic_table() %>% - split_cols_by("ARM") %>% - split_rows_by("SEX") %>% + lyt <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("SEX") |> analyze("AGE", afun = function(x, .N_row) .N_row) tab <- build_table(lyt, rawdat) rows <- collect_leaves(tab) @@ -544,9 +544,9 @@ test_that("extra args works", { } ) - l <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by_multivar(c("VALUE", "PCTDIFF")) %>% + l <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by_multivar(c("VALUE", "PCTDIFF")) |> analyze_colvars(afun = colfuns) l @@ -554,9 +554,9 @@ test_that("extra args works", { tbl_noex <- build_table(l, rawdat2) ## one for each different function in colfuns, assigned correctly - l2 <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by_multivar(c("VALUE", "PCTDIFF")) %>% + l2 <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by_multivar(c("VALUE", "PCTDIFF")) |> analyze_colvars(afun = colfuns, extra_args = list(list(add = 5), list(cutoff = 100))) @@ -597,9 +597,9 @@ test_that("extra args works", { ) ## single argument passed to all functions - l2b <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by_multivar(c("VALUE", "PCTDIFF")) %>% + l2b <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by_multivar(c("VALUE", "PCTDIFF")) |> analyze_colvars(afun = colfuns, extra_args = list(na.rm = FALSE)) tbl_ex2 <- build_table(l2b, rawdat2) @@ -608,7 +608,7 @@ test_that("extra args works", { ## one argument for a single function. - lyt <- basic_table() %>% + lyt <- basic_table() |> analyze("Sepal.Length", afun = function(x, a) { in_rows(mean_a = rcell(mean(x) + a, format = "xx")) }, extra_args = list(a = 1)) @@ -618,7 +618,7 @@ test_that("extra args works", { expect_equal(tbl[1, 1, drop = TRUE], mean(iris$Sepal.Length) + 1) ## two arguments for a single function - lyt2 <- basic_table() %>% + lyt2 <- basic_table() |> analyze("Sepal.Length", afun = function(x, a, b) { in_rows(mean_a = rcell(mean(x) + a + b, format = "xx")) }, extra_args = list(a = 1, b = 3)) @@ -630,13 +630,13 @@ test_that("extra args works", { test_that("Colcounts work correctly", { - lyt1 <- basic_table(show_colcounts = TRUE) %>% + lyt1 <- basic_table(show_colcounts = TRUE) |> analyze("AGE") tbl1 <- build_table(lyt1, DM) expect_identical(col_counts(tbl1), nrow(DM)) - lyt2 <- lyt1 %>% split_cols_by("ARM") + lyt2 <- lyt1 |> split_cols_by("ARM") tbl2 <- build_table(lyt2, DM) expect_identical( @@ -659,16 +659,16 @@ test_that("Colcounts work correctly", { tbl4 <- basic_table( show_colcounts = TRUE, colcount_format = "xx (xx%)" - ) %>% - split_cols_by("ARM") %>% + ) |> + split_cols_by("ARM") |> build_table(DM) mf_tbl4_colcounts <- matrix_form(tbl4)$strings[2, ] expect_identical(mf_tbl4_colcounts, c("", "121 (100%)", "106 (100%)", "129 (100%)")) ## setting col_counts in build_table turns on visibility for leaf col counts - lyt5 <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by("STRATA1") %>% + lyt5 <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by("STRATA1") |> analyze("AGE") tbl5 <- build_table(lyt5, ex_adsl, col_counts = 1:9) @@ -695,9 +695,9 @@ test_that("content extra args for summarize_row_groups works", { ) } ## specify single set of args for all columns - l <- basic_table() %>% - split_cols_by("ARM") %>% - split_rows_by("SEX") %>% + l <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("SEX") |> summarize_row_groups( cfun = sfun, extra_args = list(a = 9) @@ -712,9 +712,9 @@ test_that("content extra args for summarize_row_groups works", { ) ## specify different arg for each column - l2 <- basic_table() %>% - split_cols_by("ARM") %>% - split_rows_by("SEX") %>% + l2 <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("SEX") |> summarize_row_groups( cfun = sfun, extra_args = list( @@ -733,9 +733,9 @@ test_that("content extra args for summarize_row_groups works", { ## specify arg for only one col - l3 <- basic_table() %>% - split_cols_by("ARM") %>% - split_rows_by("SEX") %>% + l3 <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("SEX") |> summarize_row_groups( cfun = sfun, extra_args = list(list(a = 9)) @@ -751,8 +751,8 @@ test_that("content extra args for summarize_row_groups works", { ## works on root split - l4 <- basic_table() %>% - split_cols_by("ARM") %>% + l4 <- basic_table() |> + split_cols_by("ARM") |> summarize_row_groups( cfun = sfun, extra_args = list(a = 9) @@ -772,9 +772,9 @@ test_that(".df_row analysis function argument works", { rcell(c(nrow(.df_row), .N_col), format = "(xx.x, xx.x)") } - l <- basic_table() %>% - split_cols_by("ARM") %>% - split_rows_by("SEX") %>% + l <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("SEX") |> analyze("AGE", afun) tbl <- build_table(l, rawdat) @@ -812,9 +812,9 @@ test_that("analysis function arguments work with NA rows in data", { b_var = factor(c(NA, NA, "x", "x", "y", "x", "x", "y", "x", NA)) ) - l <- basic_table() %>% - add_overall_col("all pts") %>% - split_rows_by("a_var") %>% + l <- basic_table() |> + add_overall_col("all pts") |> + split_rows_by("a_var") |> analyze("b_var", afun = afun) tbl <- build_table(l, df) @@ -840,8 +840,8 @@ test_that("analyze_colvars inclNAs works", { b = c(1, NA) ) - l <- basic_table() %>% - split_cols_by_multivar(c("a", "b")) %>% + l <- basic_table() |> + split_cols_by_multivar(c("a", "b")) |> analyze_colvars(afun = length, inclNAs = TRUE) # We expect: @@ -854,8 +854,8 @@ test_that("analyze_colvars inclNAs works", { res1 <- cell_values(tab) expect_equal(ans, res1) - l2 <- basic_table() %>% - split_cols_by_multivar(c("a", "b")) %>% + l2 <- basic_table() |> + split_cols_by_multivar(c("a", "b")) |> analyze_colvars(afun = length, inclNAs = FALSE) ans2 <- lapply(test, function(x) sum(!is.na(x))) @@ -875,12 +875,12 @@ test_that("analyze_colvars works generally", { d = 4, e = 5 ) - l1 <- basic_table() %>% - split_cols_by_multivar(c("a", "b", "c", "d")) %>% + l1 <- basic_table() |> + split_cols_by_multivar(c("a", "b", "c", "d")) |> analyze_colvars(afun = identity) tab1 <- build_table(l1, test) - l2 <- basic_table() %>% - split_cols_by_multivar(c("a", "b", "c", "d", "e")) %>% + l2 <- basic_table() |> + split_cols_by_multivar(c("a", "b", "c", "d", "e")) |> analyze_colvars(afun = identity) tab2 <- build_table(l2, test) @@ -891,9 +891,9 @@ test_that("analyze_colvars works generally", { function(x, labelstr) 8 ) - l3 <- basic_table() %>% - split_cols_by_multivar(c("a", "b", "c", "d")) %>% - summarize_row_groups(cfun = colfuns, format = "xx") %>% + l3 <- basic_table() |> + split_cols_by_multivar(c("a", "b", "c", "d")) |> + summarize_row_groups(cfun = colfuns, format = "xx") |> analyze_colvars(afun = identity) tab3 <- build_table(l3, test) expect_identical( @@ -905,9 +905,9 @@ test_that("analyze_colvars works generally", { c(summary = "My Summary Row") ) - l4 <- basic_table() %>% - split_cols_by_multivar(c("a", "b", "c", "d")) %>% - summarize_row_groups() %>% + l4 <- basic_table() |> + split_cols_by_multivar(c("a", "b", "c", "d")) |> + summarize_row_groups() |> analyze_colvars(afun = identity) tab4 <- build_table(l4, test) ## this broke before due to formatting missmatches @@ -916,10 +916,10 @@ test_that("analyze_colvars works generally", { expect_identical(obj_format(rws4[[1]]), "xx (xx.x%)") expect_identical(obj_format(rws4[[2]]), NULL) - l5 <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by_multivar(c("AGE", "BMRKR1")) %>% - split_rows_by("RACE") %>% + l5 <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by_multivar(c("AGE", "BMRKR1")) |> + split_rows_by("RACE") |> summarize_row_groups( cfun = list( function(x, labelstr) "first fun", @@ -940,8 +940,8 @@ test_that("analyze_colvars works generally", { ## single column in split_cols_by_multivar and analyze_colvars - one_col_lyt <- basic_table() %>% - split_cols_by_multivar(vars = "Sepal.Width") %>% + one_col_lyt <- basic_table() |> + split_cols_by_multivar(vars = "Sepal.Width") |> analyze_colvars(afun = mean) one_col_tbl <- build_table(one_col_lyt, iris) @@ -952,8 +952,8 @@ test_that("analyze_colvars works generally", { # na_str argument works test$d <- NA - l2 <- basic_table() %>% - split_cols_by_multivar(c("a", "b", "c", "d")) %>% + l2 <- basic_table() |> + split_cols_by_multivar(c("a", "b", "c", "d")) |> analyze_colvars(afun = mean, na_str = "no data") tab2 <- build_table(l2, test) expect_identical( @@ -965,10 +965,10 @@ test_that("analyze_colvars works generally", { test_that("alt_counts_df works", { minidm <- DM[1, ] - lyt <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% - split_rows_by("SEX") %>% - summarize_row_groups() %>% + lyt <- basic_table(show_colcounts = TRUE) |> + split_cols_by("ARM") |> + split_rows_by("SEX") |> + summarize_row_groups() |> analyze("AGE") tbl <- build_table(lyt, DM, minidm) @@ -990,22 +990,22 @@ test_that("alt_counts_df works", { test_that("deeply nested and uneven column layouts work", { - lyt <- basic_table(show_colcounts = TRUE) %>% - split_cols_by(var = "ARM") %>% - split_cols_by("STRATA1") %>% - split_cols_by("STRATA2") %>% - add_overall_col("All Patients") %>% + lyt <- basic_table(show_colcounts = TRUE) |> + split_cols_by(var = "ARM") |> + split_cols_by("STRATA1") |> + split_cols_by("STRATA2") |> + add_overall_col("All Patients") |> analyze("AGE") tbl <- build_table(lyt, ex_adsl) ## printing machinery works str <- toString(tbl) expect_identical(ncol(tbl), 19L) - lyt2 <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% - split_cols_by("STRATA1") %>% - split_cols_by("STRATA2", nested = FALSE) %>% - add_overall_col("All Patients") %>% + lyt2 <- basic_table(show_colcounts = TRUE) |> + split_cols_by("ARM") |> + split_cols_by("STRATA1") |> + split_cols_by("STRATA2", nested = FALSE) |> + add_overall_col("All Patients") |> analyze("AGE") tbl2 <- build_table(lyt2, ex_adsl) @@ -1016,17 +1016,17 @@ test_that("deeply nested and uneven column layouts work", { test_that("topleft label position works", { - lyt <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% + lyt <- basic_table(show_colcounts = TRUE) |> + split_cols_by("ARM") |> ## add nested column split on SEX with value lables from gend_label - split_cols_by("SEX", "Gender", labels_var = "gend_label") %>% + split_cols_by("SEX", "Gender", labels_var = "gend_label") |> ## No row splits have been introduced, so this adds ## a root split and puts summary content on it labelled Overall (N) - ## add_colby_total(label = "All") %>% - ## summarize_row_groups(label = "Overall (N)", format = "(N=xx)") %>% + ## add_colby_total(label = "All") |> + ## summarize_row_groups(label = "Overall (N)", format = "(N=xx)") |> ## add a new subtable that splits on RACE, value labels from ethn_label - split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label", label_pos = "topleft") %>% - summarize_row_groups("RACE", label_fstr = "%s (n)") %>% + split_rows_by("RACE", "Ethnicity", labels_var = "ethn_label", label_pos = "topleft") |> + summarize_row_groups("RACE", label_fstr = "%s (n)") |> ## ## Add nested row split within Race categories for FACTOR2 ## using a split function that excludes level C @@ -1035,9 +1035,9 @@ test_that("topleft label position works", { split_fun = remove_split_levels("C"), labels_var = "fac2_label", label_pos = "topleft" - ) %>% + ) |> ## Add count summary within FACTOR2 categories - summarize_row_groups("FACTOR2") %>% + summarize_row_groups("FACTOR2") |> ## Add analysis/data rows by analyzing AGE variable ## Note afun is a function that returns 2 values in a named list ## this will create 2 data rows @@ -1054,12 +1054,12 @@ test_that("topleft label position works", { ) ## https://github.com/insightsengineering/rtables/issues/657 - tab2 <- basic_table() %>% - split_cols_by("ARM") %>% - split_rows_by("RACE", split_fun = drop_split_levels, split_label = "RACE", label_pos = "hidden", page_by = TRUE) %>% - split_rows_by("STRATA1", split_fun = drop_split_levels, split_label = "Strata", label_pos = "topleft") %>% - split_rows_by("SEX", split_fun = drop_split_levels, split_label = "Gender", label_pos = "topleft") %>% - analyze("AGE", mean, var_labels = "Age", format = "xx.xx") %>% + tab2 <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("RACE", split_fun = drop_split_levels, split_label = "RACE", label_pos = "hidden", page_by = TRUE) |> + split_rows_by("STRATA1", split_fun = drop_split_levels, split_label = "Strata", label_pos = "topleft") |> + split_rows_by("SEX", split_fun = drop_split_levels, split_label = "Gender", label_pos = "topleft") |> + analyze("AGE", mean, var_labels = "Age", format = "xx.xx") |> build_table(DM) ptab <- paginate_table(tab2) @@ -1069,16 +1069,16 @@ test_that("topleft label position works", { ) ## https://github.com/insightsengineering/rtables/issues/651 - lyt2 <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% - split_rows_by("SEX", split_fun = drop_split_levels, page_by = TRUE) %>% + lyt2 <- basic_table(show_colcounts = TRUE) |> + split_cols_by("ARM") |> + split_rows_by("SEX", split_fun = drop_split_levels, page_by = TRUE) |> analyze("AGE") expect_error(build_table(lyt2, DM[0, ]), "Page-by split resulted in zero") - lyt3 <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% - split_rows_by("SEX", split_fun = drop_split_levels, page_by = TRUE) %>% - split_rows_by("COUNTRY", split_fun = drop_split_levels, page_by = TRUE) %>% + lyt3 <- basic_table(show_colcounts = TRUE) |> + split_cols_by("ARM") |> + split_rows_by("SEX", split_fun = drop_split_levels, page_by = TRUE) |> + split_rows_by("COUNTRY", split_fun = drop_split_levels, page_by = TRUE) |> analyze("AGE") baddm <- DM @@ -1092,10 +1092,10 @@ test_that("topleft label position works", { expect_error(build_table(lyt3, baddm), error_msg, fixed = TRUE) # Similar error if the problematic split is done on alt_counts_df (related to #651) - lyt4 <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% - split_rows_by("SEX", split_fun = drop_split_levels, page_by = TRUE) %>% - split_rows_by("COUNTRY", split_fun = drop_split_levels, page_by = TRUE) %>% + lyt4 <- basic_table(show_colcounts = TRUE) |> + split_cols_by("ARM") |> + split_rows_by("SEX", split_fun = drop_split_levels, page_by = TRUE) |> + split_rows_by("COUNTRY", split_fun = drop_split_levels, page_by = TRUE) |> analyze("AGE", afun = function(x, .alt_df) mean(x)) error_msg2 <- paste0( @@ -1137,13 +1137,13 @@ test_that(".spl_context works in content and analysis functions", { } - lyt <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by("SEX", split_fun = keep_split_levels(c("M", "F"))) %>% - split_rows_by("COUNTRY", split_fun = keep_split_levels(c("CHN", "USA"))) %>% - summarize_row_groups() %>% - split_rows_by("STRATA1") %>% - summarize_row_groups(cfun = cfun) %>% + lyt <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by("SEX", split_fun = keep_split_levels(c("M", "F"))) |> + split_rows_by("COUNTRY", split_fun = keep_split_levels(c("CHN", "USA"))) |> + summarize_row_groups() |> + split_rows_by("STRATA1") |> + summarize_row_groups(cfun = cfun) |> analyze("AGE", afun = afun) tab <- build_table(lyt, DM) @@ -1180,14 +1180,14 @@ test_that(".spl_context works in content and analysis functions", { test_that("cut functions work", { ctnames <- c("young", "medium", "old") ## split_cols_by_cuts - l <- basic_table() %>% - split_cols_by("ARM") %>% + l <- basic_table() |> + split_cols_by("ARM") |> split_cols_by_cuts("AGE", split_label = "Age", cuts = c(0, 25, 35, 1000), cutlabels = ctnames - ) %>% - analyze(c("BMRKR2", "STRATA2")) %>% + ) |> + analyze(c("BMRKR2", "STRATA2")) |> append_topleft("counts") tbl <- build_table(l, ex_adsl) @@ -1208,15 +1208,15 @@ test_that("cut functions work", { c("counts", rep(ctnames, 3)) ) - lcm <- basic_table() %>% - split_cols_by("ARM") %>% + lcm <- basic_table() |> + split_cols_by("ARM") |> split_cols_by_cuts("AGE", split_label = "Age", cuts = c(0, 25, 35, 1000), cutlabels = c("young", "young+medium", "all"), cumulative = TRUE - ) %>% - analyze(c("BMRKR2", "STRATA2")) %>% + ) |> + analyze(c("BMRKR2", "STRATA2")) |> append_topleft("counts") tblcm <- build_table(lcm, ex_adsl) @@ -1228,14 +1228,14 @@ test_that("cut functions work", { unname(unlist(cell_values(tblcm, medpth, bpth))) ) ## split_rows_by_cuts - l2 <- basic_table() %>% - split_cols_by("ARM") %>% + l2 <- basic_table() |> + split_cols_by("ARM") |> split_rows_by_cuts("AGE", split_label = "Age", cuts = c(0, 25, 35, 1000), cutlabels = ctnames - ) %>% - analyze("BMRKR2") %>% + ) |> + analyze("BMRKR2") |> append_topleft("counts") @@ -1249,14 +1249,14 @@ test_that("cut functions work", { ) - l2cm <- basic_table() %>% - split_cols_by("ARM") %>% + l2cm <- basic_table() |> + split_cols_by("ARM") |> split_rows_by_cuts("AGE", split_label = "Age", cuts = c(0, 25, 35, 1000), cutlabels = ctnames, cumulative = TRUE - ) %>% - analyze("BMRKR2") %>% + ) |> + analyze("BMRKR2") |> append_topleft("counts") @@ -1278,28 +1278,28 @@ test_that("cut functions work", { ) # split_cols_by_quartiles - l3 <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by_cutfun("AGE") %>% ## (quartiles("AGE", split_label = "Age") %>% - analyze("BMRKR2") %>% + l3 <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by_cutfun("AGE") |> ## (quartiles("AGE", split_label = "Age") |> + analyze("BMRKR2") |> append_topleft("counts") tbl3 <- build_table(l3, ex_adsl) - l3b <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by_cuts("AGE", cuts = rtables:::qtile_cuts(ex_adsl$AGE)) %>% - analyze("BMRKR2") %>% + l3b <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by_cuts("AGE", cuts = rtables:::qtile_cuts(ex_adsl$AGE)) |> + analyze("BMRKR2") |> append_topleft("counts") tbl3b <- build_table(l3b, ex_adsl) expect_identical(tbl3, tbl3b) - l3c <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by_quartiles("AGE") %>% - analyze("BMRKR2") %>% + l3c <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by_quartiles("AGE") |> + analyze("BMRKR2") |> append_topleft("counts") tbl3c <- build_table(l3c, ex_adsl) @@ -1310,18 +1310,18 @@ test_that("cut functions work", { ) - l3c_cm <- basic_table() %>% - split_cols_by("ARM") %>% - split_cols_by_quartiles("AGE", cumulative = TRUE) %>% - analyze("BMRKR2") %>% + l3c_cm <- basic_table() |> + split_cols_by("ARM") |> + split_cols_by_quartiles("AGE", cumulative = TRUE) |> + analyze("BMRKR2") |> append_topleft("counts") tbl3c_cm <- build_table(l3c_cm, ex_adsl) # split_rows_by_quartiles - l4 <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% - split_rows_by_quartiles("AGE", split_label = "Age") %>% - analyze("BMRKR2") %>% + l4 <- basic_table(show_colcounts = TRUE) |> + split_cols_by("ARM") |> + split_rows_by_quartiles("AGE", split_label = "Age") |> + analyze("BMRKR2") |> append_topleft(c("Age Quartiles", " Counts BMRKR2")) tbl4 <- build_table(l4, ex_adsl) @@ -1338,10 +1338,10 @@ test_that("cut functions work", { valslst4[names(valslst3)] ) - l4cm <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM") %>% - split_rows_by_quartiles("AGE", split_label = "Age", cumulative = TRUE) %>% - analyze("BMRKR2") %>% + l4cm <- basic_table(show_colcounts = TRUE) |> + split_cols_by("ARM") |> + split_rows_by_quartiles("AGE", split_label = "Age", cumulative = TRUE) |> + analyze("BMRKR2") |> append_topleft(c("Age Cumulative Quartiles", " Counts BMRKR2")) tbl4cm <- build_table(l4cm, ex_adsl) @@ -1367,9 +1367,9 @@ test_that("empty factor levels represented correctly when ref group is set", { ) - tbl <- basic_table() %>% - split_cols_by("grp", ref_group = "a") %>% - analyze("val") %>% + tbl <- basic_table() |> + split_cols_by("grp", ref_group = "a") |> + analyze("val") |> build_table(df) expect_identical(ncol(tbl), 2L) @@ -1384,8 +1384,8 @@ test_that("error on empty level of splitting variable", { mydf2 <- mydf mydf2$x <- factor(mydf2$x) - lyt1 <- basic_table() %>% - split_cols_by("x") %>% + lyt1 <- basic_table() |> + split_cols_by("x") |> analyze("y") expect_error( build_table(lyt1, mydf), @@ -1396,8 +1396,8 @@ test_that("error on empty level of splitting variable", { "Got empty string level in splitting variable x" ) - lyt2 <- basic_table() %>% - split_rows_by("x") %>% + lyt2 <- basic_table() |> + split_rows_by("x") |> analyze("y") expect_error( @@ -1422,16 +1422,16 @@ test_that("error when afun gives differing numbers of rows is informative", { my_broken_afun <- afunconst() - lyt <- basic_table() %>% - split_cols_by("ARM") %>% + lyt <- basic_table() |> + split_cols_by("ARM") |> analyze("AGE", my_broken_afun) expect_error(build_table(lyt, DM), "Number of rows generated by analysis function do not match across all columns.") }) test_that("warning when same name siblings", { - lyt <- basic_table() %>% - analyze("AGE", mean) %>% + lyt <- basic_table() |> + analyze("AGE", mean) |> analyze("AGE", mean, var_labels = "AGE2") expect_warning( @@ -1457,7 +1457,7 @@ test_that("error when inset < 0 or non-number", { }) test_that("error when ref_group value not a level of var when using split_cols_by", { - lyt <- basic_table() %>% + lyt <- basic_table() |> split_cols_by("ARM", ref_group = "test_level") expect_error( tbl <- build_table(lyt, DM), @@ -1502,42 +1502,42 @@ test_that("qtable works", { nm <- tail(.spl_context$value, 1) rcell(NROW(df), label = nm) } - t0b <- basic_table(show_colcounts = TRUE) %>% - analyze(names(ex_adsl)[1], count) %>% + t0b <- basic_table(show_colcounts = TRUE) |> + analyze(names(ex_adsl)[1], count) |> build_table(ex_adsl) nice_comp_table(t0, t0b) t1 <- qtable(ex_adsl, row_vars = "ARM") - t1b <- basic_table(show_colcounts = TRUE) %>% - split_rows_by("ARM", child_labels = "hidden") %>% - analyze(names(ex_adsl)[1], count_use_nms) %>% - append_topleft("count") %>% + t1b <- basic_table(show_colcounts = TRUE) |> + split_rows_by("ARM", child_labels = "hidden") |> + analyze(names(ex_adsl)[1], count_use_nms) |> + append_topleft("count") |> build_table(ex_adsl) nice_comp_table(t1, t1b) t2 <- qtable(ex_adsl, col_vars = "ARM") - t2b <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM", child_labels = "hidden") %>% - analyze(names(ex_adsl)[1], count) %>% + t2b <- basic_table(show_colcounts = TRUE) |> + split_cols_by("ARM", child_labels = "hidden") |> + analyze(names(ex_adsl)[1], count) |> build_table(ex_adsl) nice_comp_table(t2, t2b) t3 <- qtable(ex_adsl, row_vars = "SEX", col_vars = "ARM") - t3b <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM", child_labels = "hidden") %>% - split_rows_by("SEX", child_labels = "hidden", split_fun = drop_split_levels) %>% - analyze(names(ex_adsl)[1], count_use_nms) %>% - append_topleft("count") %>% + t3b <- basic_table(show_colcounts = TRUE) |> + split_cols_by("ARM", child_labels = "hidden") |> + split_rows_by("SEX", child_labels = "hidden", split_fun = drop_split_levels) |> + analyze(names(ex_adsl)[1], count_use_nms) |> + append_topleft("count") |> build_table(ex_adsl) nice_comp_table(t3, t3b) t4 <- qtable(ex_adsl, row_vars = c("COUNTRY", "SEX"), col_vars = c("ARM", "STRATA1")) - t4b <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM", child_labels = "hidden") %>% - split_cols_by("STRATA1") %>% - split_rows_by("COUNTRY", split_fun = drop_split_levels) %>% - split_rows_by("SEX", split_fun = drop_split_levels, child_labels = "hidden") %>% - analyze(names(ex_adsl)[1], count_use_nms) %>% - append_topleft("count") %>% + t4b <- basic_table(show_colcounts = TRUE) |> + split_cols_by("ARM", child_labels = "hidden") |> + split_cols_by("STRATA1") |> + split_rows_by("COUNTRY", split_fun = drop_split_levels) |> + split_rows_by("SEX", split_fun = drop_split_levels, child_labels = "hidden") |> + analyze(names(ex_adsl)[1], count_use_nms) |> + append_topleft("count") |> build_table(ex_adsl) nice_comp_table(t4, t4b) @@ -1549,21 +1549,21 @@ test_that("qtable works", { mean_use_nm <- function(x, .spl_context, ...) { rcell(mean(x, ...), format = "xx.xx", label = tail(.spl_context$value, 1)) } - t5b <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM", split_fun = drop_split_levels, child_labels = "hidden") %>% - split_cols_by("STRATA1", split_fun = drop_split_levels) %>% - split_rows_by("COUNTRY", split_fun = drop_split_levels) %>% - split_rows_by("SEX", child_labels = "hidden", split_fun = drop_split_levels) %>% - analyze("AGE", mean_use_nm) %>% - append_topleft("AGE - mean") %>% + t5b <- basic_table(show_colcounts = TRUE) |> + split_cols_by("ARM", split_fun = drop_split_levels, child_labels = "hidden") |> + split_cols_by("STRATA1", split_fun = drop_split_levels) |> + split_rows_by("COUNTRY", split_fun = drop_split_levels) |> + split_rows_by("SEX", child_labels = "hidden", split_fun = drop_split_levels) |> + analyze("AGE", mean_use_nm) |> + append_topleft("AGE - mean") |> build_table(ex_adsl) nice_comp_table(t5, t5b) t6 <- qtable(ex_adsl, row_vars = "SEX", col_vars = "ARM", avar = "AGE", afun = summary_list) - t6b <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM", split_fun = drop_split_levels, child_labels = "hidden") %>% - split_rows_by("SEX", split_fun = drop_split_levels) %>% - analyze("AGE", summary_list2) %>% - append_topleft("AGE - summary_list") %>% + t6b <- basic_table(show_colcounts = TRUE) |> + split_cols_by("ARM", split_fun = drop_split_levels, child_labels = "hidden") |> + split_rows_by("SEX", split_fun = drop_split_levels) |> + analyze("AGE", summary_list2) |> + append_topleft("AGE - summary_list") |> build_table(ex_adsl) nice_comp_table(t6, t6b) @@ -1575,11 +1575,11 @@ test_that("qtable works", { rcell(suppressWarnings(range(x)), label = tail(.spl_context$value, 1), format = "xx.x / xx.x") } - t7b <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM", split_fun = drop_split_levels, child_labels = "hidden") %>% - split_rows_by("SEX", child_labels = "hidden", split_fun = drop_split_levels) %>% - analyze("AGE", range_use_nms) %>% - append_topleft("AGE - range") %>% + t7b <- basic_table(show_colcounts = TRUE) |> + split_cols_by("ARM", split_fun = drop_split_levels, child_labels = "hidden") |> + split_rows_by("SEX", child_labels = "hidden", split_fun = drop_split_levels) |> + analyze("AGE", range_use_nms) |> + append_topleft("AGE - range") |> build_table(ex_adsl) nice_comp_table(t7, t7b) @@ -1594,14 +1594,14 @@ test_that("qtable works", { col_vars = c("ARM"), avar = "AGE", afun = summary_list, summarize_groups = TRUE ) - t9b <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARM", split_fun = drop_split_levels, child_labels = "hidden") %>% - split_rows_by("COUNTRY", split_fun = drop_split_levels) %>% - summarize_row_groups() %>% - split_rows_by("SEX", split_fun = drop_split_levels) %>% - summarize_row_groups() %>% - analyze("AGE", summary_list2) %>% - append_topleft("AGE - summary_list") %>% + t9b <- basic_table(show_colcounts = TRUE) |> + split_cols_by("ARM", split_fun = drop_split_levels, child_labels = "hidden") |> + split_rows_by("COUNTRY", split_fun = drop_split_levels) |> + summarize_row_groups() |> + split_rows_by("SEX", split_fun = drop_split_levels) |> + summarize_row_groups() |> + analyze("AGE", summary_list2) |> + append_topleft("AGE - summary_list") |> build_table(ex_adsl) nice_comp_table(t9, t9b) @@ -1664,8 +1664,8 @@ test_that("qtable works", { ## https://github.com/insightsengineering/rtables/issues/671 test_that("problematic labels are caught and give informative error message", { - lyt <- basic_table() %>% - split_rows_by("Species") %>% + lyt <- basic_table() |> + split_rows_by("Species") |> analyze("Sepal.Length", afun = make_afun(simple_analysis, .labels = list(Mean = "this is {test}"))) expect_error(build_table(lyt, iris), "Labels cannot contain [{] or [}] due to") @@ -1684,8 +1684,8 @@ test_that("No superfluous warning when ref group is set with custom split fun", ) } - lyt <- basic_table() %>% - split_cols_by("Species", ref_group = "virginica", split_fun = make_split_fun(post = list(reorder_facets))) %>% + lyt <- basic_table() |> + split_cols_by("Species", ref_group = "virginica", split_fun = make_split_fun(post = list(reorder_facets))) |> analyze("Sepal.Length") expect_silent(build_table(lyt, iris)) }) @@ -1709,18 +1709,18 @@ test_that("path uniqueness/sibling name uniqueness is enforced correctly", { } ## analyze and then split on same variable - lyt1 <- basic_table() %>% - analyze("STRATA1") %>% - split_rows_by("STRATA1") %>% - analyze("AGE") %>% + lyt1 <- basic_table() |> + analyze("STRATA1") |> + split_rows_by("STRATA1") |> + analyze("AGE") |> analyze("STRATA1", nested = FALSE) tbl1 <- build_and_check_row_paths(lyt1, TRUE) - lyt1b <- basic_table() %>% - analyze("STRATA1") %>% - split_rows_by("STRATA1", parent_name = "STRATA1[2]") %>% - analyze("AGE") %>% + lyt1b <- basic_table() |> + analyze("STRATA1") |> + split_rows_by("STRATA1", parent_name = "STRATA1[2]") |> + analyze("AGE") |> analyze("STRATA1", table_names = "STRATA1[3]", nested = FALSE) tbl1b <- build_and_check_row_paths(lyt1b, FALSE) @@ -1734,7 +1734,7 @@ test_that("path uniqueness/sibling name uniqueness is enforced correctly", { ) } - lyt2 <- basic_table() %>% + lyt2 <- basic_table() |> analyze("AGE", afun = bad_acfun) tbl2 <- build_and_check_row_paths(lyt2, TRUE) @@ -1744,14 +1744,14 @@ test_that("path uniqueness/sibling name uniqueness is enforced correctly", { ## containing table, probably shouldn't because generally content tables aren't ## named, since you use the @content path element to get them, but for now ## we leave this behavior and match it in the uniqify case. - lyt3 <- basic_table() %>% - analyze(c("STRATA1", "AGE")) %>% + lyt3 <- basic_table() |> + analyze(c("STRATA1", "AGE")) |> analyze(c("STRATA1", "AGE"), nested = FALSE) tbl3 <- build_and_check_row_paths(lyt3, TRUE) - lyt3b <- basic_table() %>% - analyze(c("STRATA1", "AGE")) %>% + lyt3b <- basic_table() |> + analyze(c("STRATA1", "AGE")) |> analyze(c("STRATA1", "AGE"), nested = FALSE, parent_name = "ma_STRATA1_AGE[2]") tbl3b <- build_and_check_row_paths(lyt3b, FALSE) expect_identical(tbl3, tbl3b) @@ -1867,6 +1867,17 @@ test_that("formats_var works in analyze()", { all(get_formatted_cells(tbla)[c(5, 10, 15), ] == "global na cha cha cha") ) + lytb <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("PARAMCD") |> + analyze("AVAL", + fmts_afun, + formats_var = "formats", + na_str = list("global na cha cha cha") + ) + + tblb <- build_table(lytb, adlb) + ## works when also specifying na_strs_var lyt2 <- basic_table() |> split_cols_by("ARM") |> @@ -1876,9 +1887,20 @@ test_that("formats_var works in analyze()", { tbl2 <- build_table(lyt2, adlb) fmtcells2 <- get_formatted_cells(tbl2) - expect_true(all(fmtcells2[5, ] == "NA") && - all(fmtcells2[10, ] == "n/a") && - all(fmtcells2[15, ] == "-")) + expect_true(all(fmtcells2[5, ] == "NA")) + expect_true(all(fmtcells2[10, ] == "n/a")) + expect_true(all(fmtcells2[15, ] == "-")) + + adlb_b <- adlb + adlb_b$na_strs <- ifelse(adlb_b$PARAMCD == "ALT", list(list("NA")), + ifelse(adlb_b$PARAMCD == "CRP", + list(list("n/a")), + list(list("-")))) + + tbl2b <- build_table(lyt2, adlb_b) + ## tabletree objects not identical for some reason but... + expect_identical(get_formatted_cells(tbl2), + get_formatted_cells(tbl2b)) ## precendence and interaction with .formats use in in_rows @@ -1957,11 +1979,63 @@ test_that("formats_var works in analyze()", { ## most specific for multiple partial matches adlb2 <- adlb - ## This should do nothing because STRATA1 is a more specific partial match than STRAT + ## This should do nothing because STRATA1 is an exact match adlb2$formats <- lapply(adlb2$formats, function(x) c(x, list(STRAT = "xx.xxx"))) tbl4b <- build_table(lyt4, adlb2) expect_identical(tbl4, tbl4b) + + ## remove perfect match to make sure partial match kicks in + adlb3 <- adlb2 + adlb3$formats <- lapply(adlb2$formats, function(x) { + x[["STRATA1"]] <- NULL + x$STRAT = "xx.x" + x + }) + tbl4c <- build_table(lyt4, adlb3) + expect_equal( + get_formatted_cells(tbl4c[-c(1, 5, 9),]), + matrix( + vapply( + unlist(cell_values(tbl4c)), + format_value, + format = "xx.x", + "" + ), + ncol = 3, + byrow = TRUE + ) + ) + + adlb4 <- adlb3 + ## this should do nothing because STRAT is a better partial match + adlb4$formats <- lapply(adlb3$formats, function(x) c(list(STR = "xx"), x)) + tbl4d <- build_table(lyt4, adlb4) + expect_identical(tbl4c, tbl4d) + + adlb5 <- adlb + adlb5$formats <- list(list()) + adlb5$na_strs <- list(list()) + tbl4e <- build_table(lyt4, adlb5) + fmtcells4e <- get_formatted_cells(tbl4e) + expect_equal( + get_formatted_cells(tbl4e[-c(1, 5, 9),]), + matrix( + vapply( + unlist(cell_values(tbl4e)), + format_value, + format = "xx", + "" + ), + ncol = 3, + byrow = TRUE + ) + ) + + adlb6 <- adlb + adlb6$formats <- list(list("xx.x")) + tbl4f <- build_table(lyt4, adlb6) + expect_identical(tbl4c, tbl4f) }) test_that("New format as list of formats for diff vars in analyze works", { @@ -2097,6 +2171,61 @@ test_that("New format as list of formats for diff vars in analyze works", { ) ) + + lyt2a <- basic_table() |> + analyze(c("AGE", "BMRKR1"), + afun = fmts_afun, + format = varfmts, + na_str = "eh? what?" + ) + + tbl2a <- build_table(lyt2a, ex_adsl) + + fmtcells2a <- get_formatted_cells(tbl2a) + expect_true(all(fmtcells2a[c(5, 10), 1] == "eh? what?")) + expect_equal(fmtcells2[-c(5, 10), ], fmtcells2a[-c(5, 10), ]) + + lyt2b <- basic_table() |> + analyze( + c("AGE", "BMRKR1"), + afun = fmts_afun, + format = list(AGE = function(x, ...) "what?", + BMRKR1 = function(x, ...) "nah"), + na_str = list(AGE = "-", + BMRKR1 = "X") + ) + + tbl2b <- build_table(lyt2b, ex_adsl) + + fmtcells2b <- get_formatted_cells(tbl2b) + expect_equal( + fmtcells2b, + matrix( + ncol = 1, + c( + "", + rep("what?", 3), + "-", + "", + rep("nah", 3), + "X" + ) + ) + ) + + lyt2c <- basic_table() |> + analyze( + c("AGE", "BMRKR1"), + afun = fmts_afun, + format = list(AGE = list(function(x, ...) "what?"), + BMRKR1 = list(function(x, ...) "nah")), + na_str = list(AGE = "-", + BMRKR1 = "X") + ) + + tbl2c <- build_table(lyt2c, ex_adsl) + expect_identical(tbl2b, tbl2c) + ## part two, single afun partial matches lyt3 <- basic_table() |> From e535d2dfecd5a7f506469156866830fed42a52a7 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Sun, 14 Dec 2025 01:46:41 +0000 Subject: [PATCH 12/15] [skip style] [skip vbump] Restyle files --- R/00tabletrees.R | 10 ++++-- tests/testthat/test-lyt-tabulation.R | 50 +++++++++++++++++----------- 2 files changed, 38 insertions(+), 22 deletions(-) diff --git a/R/00tabletrees.R b/R/00tabletrees.R index 0410b631aa..a3493ee5e6 100644 --- a/R/00tabletrees.R +++ b/R/00tabletrees.R @@ -913,9 +913,13 @@ AnalyzeMultiVars <- function(var, cfun = cfun, cformat = cformat, inclNAs = inclNAs, - MoreArgs = c(moreargs, - list(split_format = split_format, - split_na_str = split_na_str)), ## rvis), + MoreArgs = c( + moreargs, + list( + split_format = split_format, + split_na_str = split_na_str + ) + ), ## rvis), SIMPLIFY = FALSE ) } diff --git a/tests/testthat/test-lyt-tabulation.R b/tests/testthat/test-lyt-tabulation.R index 2b100f1a0e..9db1f7b175 100644 --- a/tests/testthat/test-lyt-tabulation.R +++ b/tests/testthat/test-lyt-tabulation.R @@ -1893,14 +1893,18 @@ test_that("formats_var works in analyze()", { adlb_b <- adlb adlb_b$na_strs <- ifelse(adlb_b$PARAMCD == "ALT", list(list("NA")), - ifelse(adlb_b$PARAMCD == "CRP", - list(list("n/a")), - list(list("-")))) + ifelse(adlb_b$PARAMCD == "CRP", + list(list("n/a")), + list(list("-")) + ) + ) tbl2b <- build_table(lyt2, adlb_b) ## tabletree objects not identical for some reason but... - expect_identical(get_formatted_cells(tbl2), - get_formatted_cells(tbl2b)) + expect_identical( + get_formatted_cells(tbl2), + get_formatted_cells(tbl2b) + ) ## precendence and interaction with .formats use in in_rows @@ -1988,13 +1992,13 @@ test_that("formats_var works in analyze()", { ## remove perfect match to make sure partial match kicks in adlb3 <- adlb2 adlb3$formats <- lapply(adlb2$formats, function(x) { - x[["STRATA1"]] <- NULL - x$STRAT = "xx.x" - x + x[["STRATA1"]] <- NULL + x$STRAT <- "xx.x" + x }) tbl4c <- build_table(lyt4, adlb3) expect_equal( - get_formatted_cells(tbl4c[-c(1, 5, 9),]), + get_formatted_cells(tbl4c[-c(1, 5, 9), ]), matrix( vapply( unlist(cell_values(tbl4c)), @@ -2019,7 +2023,7 @@ test_that("formats_var works in analyze()", { tbl4e <- build_table(lyt4, adlb5) fmtcells4e <- get_formatted_cells(tbl4e) expect_equal( - get_formatted_cells(tbl4e[-c(1, 5, 9),]), + get_formatted_cells(tbl4e[-c(1, 5, 9), ]), matrix( vapply( unlist(cell_values(tbl4e)), @@ -2189,10 +2193,14 @@ test_that("New format as list of formats for diff vars in analyze works", { analyze( c("AGE", "BMRKR1"), afun = fmts_afun, - format = list(AGE = function(x, ...) "what?", - BMRKR1 = function(x, ...) "nah"), - na_str = list(AGE = "-", - BMRKR1 = "X") + format = list( + AGE = function(x, ...) "what?", + BMRKR1 = function(x, ...) "nah" + ), + na_str = list( + AGE = "-", + BMRKR1 = "X" + ) ) tbl2b <- build_table(lyt2b, ex_adsl) @@ -2217,14 +2225,18 @@ test_that("New format as list of formats for diff vars in analyze works", { analyze( c("AGE", "BMRKR1"), afun = fmts_afun, - format = list(AGE = list(function(x, ...) "what?"), - BMRKR1 = list(function(x, ...) "nah")), - na_str = list(AGE = "-", - BMRKR1 = "X") + format = list( + AGE = list(function(x, ...) "what?"), + BMRKR1 = list(function(x, ...) "nah") + ), + na_str = list( + AGE = "-", + BMRKR1 = "X" + ) ) tbl2c <- build_table(lyt2c, ex_adsl) - expect_identical(tbl2b, tbl2c) + expect_identical(tbl2b, tbl2c) ## part two, single afun partial matches From c6a8e9464492d5d72e8e40dd9f682425dbb15835 Mon Sep 17 00:00:00 2001 From: Joe Zhu Date: Sun, 14 Dec 2025 11:21:44 +0800 Subject: [PATCH 13/15] Trigger Build From 2e03a891a21f87c8f97e2dc0922d70fac6e027a7 Mon Sep 17 00:00:00 2001 From: Joe Zhu Date: Sun, 14 Dec 2025 19:39:00 +0800 Subject: [PATCH 14/15] update doc --- R/argument_conventions.R | 6 ++++-- man/analyze.Rd | 6 ++++-- man/avarspl.Rd | 6 ++++-- man/lyt_args.Rd | 6 ++++-- 4 files changed, 16 insertions(+), 8 deletions(-) diff --git a/R/argument_conventions.R b/R/argument_conventions.R index 9555a5ca6d..82c9665a8d 100644 --- a/R/argument_conventions.R +++ b/R/argument_conventions.R @@ -98,8 +98,10 @@ gen_args <- function(df, alt_counts_df, spl, pos, tt, tr, verbose, colwidths, ob #' functions. See [formatters::list_valid_format_labels()] for a list of all available format strings. #' @param format_na_str (`string`)\cr string which should be displayed when formatted if this cell's value(s) #' are all `NA`. -#' @param formats_var (`string` or `NULL`)\cr `NULL` (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the `format` argument; i.e., they will not override formats (other than `"default"`) set within the afun. Cannot be used simultaneously with `format`. -#' @param na_strs_var (`string` or `NULL`)\cr `NULL` (the default) or the name of the list column containing named lists of default NA strings to use. These will be applied with the same precedence as the `format` argument; i.e., they will not override formats (other than `"default"`) set within the afun. Cannot be used simultaneously with `format`. Cannot be used if `formats_var` is `NULL`. +#' @param formats_var (`string` or `NULL`)\cr `NULL` (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the `format` argument; i.e., they will not override formats (other than `"default"`) set within the afun. +#' Cannot be used simultaneously with `format`. +#' @param na_strs_var (`string` or `NULL`)\cr `NULL` (the default) or the name of the list column containing named lists of default NA strings to use. These will be applied with the same precedence as the `format` argument; i.e., they will not override formats (other than `"default"`) set within the afun. +#' Cannot be used simultaneously with `format`. Cannot be used if `formats_var` is `NULL`. #' @param indent_mod (`numeric`)\cr modifier for the default indent position for the structure created by this #' function (subtable, content table, or row) *and all of that structure's children*. Defaults to 0, which #' corresponds to the unmodified default behavior. diff --git a/man/analyze.Rd b/man/analyze.Rd index 4803c19787..493c26d575 100644 --- a/man/analyze.Rd +++ b/man/analyze.Rd @@ -44,11 +44,13 @@ analyzing a single variable.} strings (\code{"xx.x"}) or function. In cases such as \code{analyze} calls, they can be character vectors or lists of functions. See \code{\link[formatters:list_formats]{formatters::list_valid_format_labels()}} for a list of all available format strings.} -\item{formats_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}.} +\item{formats_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. +Cannot be used simultaneously with \code{format}.} \item{na_str}{(\code{string})\cr string that should be displayed when the value of \code{x} is missing. Defaults to \code{"NA"}.} -\item{na_strs_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default NA strings to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}. Cannot be used if \code{formats_var} is \code{NULL}.} +\item{na_strs_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default NA strings to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. +Cannot be used simultaneously with \code{format}. Cannot be used if \code{formats_var} is \code{NULL}.} \item{nested}{(\code{logical})\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 diff --git a/man/avarspl.Rd b/man/avarspl.Rd index a0c1dd78c9..88b04f781b 100644 --- a/man/avarspl.Rd +++ b/man/avarspl.Rd @@ -108,9 +108,11 @@ analyzed at the same level of nesting.} \item{section_div}{(\code{string})\cr string which should be repeated as a section divider after each group defined by this split instruction, or \code{NA_character_} (the default) for no section divider.} -\item{formats_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}.} +\item{formats_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. +Cannot be used simultaneously with \code{format}.} -\item{na_strs_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default NA strings to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}. Cannot be used if \code{formats_var} is \code{NULL}.} +\item{na_strs_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default NA strings to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. +Cannot be used simultaneously with \code{format}. Cannot be used if \code{formats_var} is \code{NULL}.} \item{.payload}{(\code{list})\cr used internally, not intended to be set by end users.} diff --git a/man/lyt_args.Rd b/man/lyt_args.Rd index e1c9ce537d..907e5dcaa3 100644 --- a/man/lyt_args.Rd +++ b/man/lyt_args.Rd @@ -190,9 +190,11 @@ to the \emph{split} or \emph{group of sibling analyses}, for \verb{split_rows_by \verb{analyze*} when analyzing more than one variable, respectively. Ignored when analyzing a single variable.} -\item{formats_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}.} +\item{formats_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. +Cannot be used simultaneously with \code{format}.} -\item{na_strs_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default NA strings to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}. Cannot be used if \code{formats_var} is \code{NULL}.} +\item{na_strs_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default NA strings to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. +Cannot be used simultaneously with \code{format}. Cannot be used if \code{formats_var} is \code{NULL}.} } \value{ No return value. From 8a3a0578ff0482ca516c499c837ec8f0f5b68508 Mon Sep 17 00:00:00 2001 From: Joe Zhu Date: Sun, 14 Dec 2025 19:44:36 +0800 Subject: [PATCH 15/15] update --- R/argument_conventions.R | 8 ++++++-- man/analyze.Rd | 8 ++++++-- man/avarspl.Rd | 8 ++++++-- man/lyt_args.Rd | 8 ++++++-- 4 files changed, 24 insertions(+), 8 deletions(-) diff --git a/R/argument_conventions.R b/R/argument_conventions.R index 82c9665a8d..60258e6a92 100644 --- a/R/argument_conventions.R +++ b/R/argument_conventions.R @@ -98,9 +98,13 @@ gen_args <- function(df, alt_counts_df, spl, pos, tt, tr, verbose, colwidths, ob #' functions. See [formatters::list_valid_format_labels()] for a list of all available format strings. #' @param format_na_str (`string`)\cr string which should be displayed when formatted if this cell's value(s) #' are all `NA`. -#' @param formats_var (`string` or `NULL`)\cr `NULL` (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the `format` argument; i.e., they will not override formats (other than `"default"`) set within the afun. +#' @param formats_var (`string` or `NULL`)\cr `NULL` (the default) or the name of the list column containing named +#' lists of default formats to use. These will be applied with the same precedence as the `format` argument; i.e., +#' they will not override formats (other than `"default"`) set within the afun. #' Cannot be used simultaneously with `format`. -#' @param na_strs_var (`string` or `NULL`)\cr `NULL` (the default) or the name of the list column containing named lists of default NA strings to use. These will be applied with the same precedence as the `format` argument; i.e., they will not override formats (other than `"default"`) set within the afun. +#' @param na_strs_var (`string` or `NULL`)\cr `NULL` (the default) or the name of the list column containing named +#' lists of default NA strings to use. These will be applied with the same precedence as the `format` argument; i.e., +#' they will not override formats (other than `"default"`) set within the afun. #' Cannot be used simultaneously with `format`. Cannot be used if `formats_var` is `NULL`. #' @param indent_mod (`numeric`)\cr modifier for the default indent position for the structure created by this #' function (subtable, content table, or row) *and all of that structure's children*. Defaults to 0, which diff --git a/man/analyze.Rd b/man/analyze.Rd index 493c26d575..b03755d533 100644 --- a/man/analyze.Rd +++ b/man/analyze.Rd @@ -44,12 +44,16 @@ analyzing a single variable.} strings (\code{"xx.x"}) or function. In cases such as \code{analyze} calls, they can be character vectors or lists of functions. See \code{\link[formatters:list_formats]{formatters::list_valid_format_labels()}} for a list of all available format strings.} -\item{formats_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. +\item{formats_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named +lists of default formats to use. These will be applied with the same precedence as the \code{format} argument; i.e., +they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}.} \item{na_str}{(\code{string})\cr string that should be displayed when the value of \code{x} is missing. Defaults to \code{"NA"}.} -\item{na_strs_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default NA strings to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. +\item{na_strs_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named +lists of default NA strings to use. These will be applied with the same precedence as the \code{format} argument; i.e., +they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}. Cannot be used if \code{formats_var} is \code{NULL}.} \item{nested}{(\code{logical})\cr whether this layout instruction should be applied within the existing layout structure diff --git a/man/avarspl.Rd b/man/avarspl.Rd index 88b04f781b..94d16afb7e 100644 --- a/man/avarspl.Rd +++ b/man/avarspl.Rd @@ -108,10 +108,14 @@ analyzed at the same level of nesting.} \item{section_div}{(\code{string})\cr string which should be repeated as a section divider after each group defined by this split instruction, or \code{NA_character_} (the default) for no section divider.} -\item{formats_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. +\item{formats_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named +lists of default formats to use. These will be applied with the same precedence as the \code{format} argument; i.e., +they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}.} -\item{na_strs_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default NA strings to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. +\item{na_strs_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named +lists of default NA strings to use. These will be applied with the same precedence as the \code{format} argument; i.e., +they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}. Cannot be used if \code{formats_var} is \code{NULL}.} \item{.payload}{(\code{list})\cr used internally, not intended to be set by end users.} diff --git a/man/lyt_args.Rd b/man/lyt_args.Rd index 907e5dcaa3..7a3d5009c8 100644 --- a/man/lyt_args.Rd +++ b/man/lyt_args.Rd @@ -190,10 +190,14 @@ to the \emph{split} or \emph{group of sibling analyses}, for \verb{split_rows_by \verb{analyze*} when analyzing more than one variable, respectively. Ignored when analyzing a single variable.} -\item{formats_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default formats to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. +\item{formats_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named +lists of default formats to use. These will be applied with the same precedence as the \code{format} argument; i.e., +they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}.} -\item{na_strs_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named lists of default NA strings to use. These will be applied with the same precedence as the \code{format} argument; i.e., they will not override formats (other than \code{"default"}) set within the afun. +\item{na_strs_var}{(\code{string} or \code{NULL})\cr \code{NULL} (the default) or the name of the list column containing named +lists of default NA strings to use. These will be applied with the same precedence as the \code{format} argument; i.e., +they will not override formats (other than \code{"default"}) set within the afun. Cannot be used simultaneously with \code{format}. Cannot be used if \code{formats_var} is \code{NULL}.} } \value{