diff --git a/DESCRIPTION b/DESCRIPTION index c47fea308..9608277cd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -29,7 +29,7 @@ URL: https://github.com/insightsengineering/rtables, https://insightsengineering.github.io/rtables/ BugReports: https://github.com/insightsengineering/rtables/issues Depends: - formatters (>= 0.5.7.9000), + formatters (>= 0.5.7.9001), magrittr (>= 1.5), methods, R (>= 2.10) diff --git a/NAMESPACE b/NAMESPACE index 63e320dec..07ef0d830 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,7 +10,11 @@ export("col_footnotes<-") export("col_info<-") export("col_total<-") export("colcount_format<-") +export("colcount_na_str<-") +export("colcount_visible<-") export("content_table<-") +export("facet_colcount<-") +export("facet_colcounts_visible<-") export("fnotes_at_path<-") export("header_section_div<-") export("horizontal_sep<-") @@ -74,8 +78,11 @@ export(col_paths) export(col_paths_summary) export(col_total) export(colcount_format) +export(colcount_na_str) +export(colcount_visible) export(collect_leaves) export(coltree) +export(coltree_structure) export(compare_rtables) export(cont_n_allcols) export(cont_n_onecol) @@ -91,6 +98,7 @@ export(export_as_docx) export(export_as_pdf) export(export_as_tsv) export(export_as_txt) +export(facet_colcount) export(find_degen_struct) export(format_rcell) export(get_formatted_cells) @@ -138,6 +146,7 @@ export(remove_split_levels) export(reorder_split_levels) export(result_df_specs) export(rheader) +export(rm_all_colcounts) export(row_cells) export(row_footnotes) export(row_paths) @@ -208,7 +217,10 @@ exportMethods("col_footnotes<-") exportMethods("col_info<-") exportMethods("col_total<-") exportMethods("colcount_format<-") +exportMethods("colcount_na_str<-") +exportMethods("colcount_visible<-") exportMethods("content_table<-") +exportMethods("facet_colcount<-") exportMethods("fnotes_at_path<-") exportMethods("horizontal_sep<-") exportMethods("main_footer<-") @@ -239,10 +251,13 @@ exportMethods(col_footnotes) exportMethods(col_info) exportMethods(col_total) exportMethods(colcount_format) +exportMethods(colcount_na_str) +exportMethods(colcount_visible) exportMethods(collect_leaves) exportMethods(coltree) exportMethods(content_table) exportMethods(dim) +exportMethods(facet_colcount) exportMethods(head) exportMethods(horizontal_sep) exportMethods(length) @@ -266,6 +281,7 @@ exportMethods(rbind2) exportMethods(ref_index) exportMethods(ref_msg) exportMethods(ref_symbol) +exportMethods(rm_all_colcounts) exportMethods(row.names) exportMethods(row_cells) exportMethods(row_footnotes) diff --git a/NEWS.md b/NEWS.md index f90869a0d..d6ddabcda 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,15 +1,33 @@ ## rtables 0.6.7.9006 ### New Features - * Added `top_level_section_div` for `basic_table` to set section dividers for top level rows. - * Added `keep_label_rows` to `as_result_df` to have these lines visible. - * `sort_at_path` now gives informative error messages when the given path does not exist. - * Add support for truetype fonts based on formatters `>= 0.5.6.9007`. Nearly all functions related to pagination or export now accept `fontspec` argument and pass it around accordingly, by @gmbecker. + * Add support for truetype fonts based on `formatters` version `>= 0.5.6.9007`. Nearly all functions related to pagination or export now accept `fontspec` argument and pass it around accordingly, by @gmbecker. * Core splitting machinery can now be overridden in column space via `make_split_fun` provided that `core_split` associates the generated facets with subsetting expressions. Subsetting expressions remain unnecessary for splits in row space. By @gmbecker. * ValueWrapper objects now carry around subsetting expressions for use during tabulation, by @gmbecker. * `make_split_res`, `add_to_split_result` now accept a list of subsetting expressions which will be attached to the values, by @gmbecker. * New `value_expr` internal getter and setter methods, by @gmbecker. + * All tables are now guaranteed to have fully path-traversable column structures (all facets in column space uniquely reachable via pathing) @gmbecker. + * Display of higher order (non-leaf) column counts is now supported (#135) @gmbecker. + * Column count visibility and format can be set independently for each block of sibling facets (#752) @gmbecker. + * `split_cols_by*` functions now accept `show_colcounts` and `colcount_format` arguments. + * New (column-) path based `colcount_visible` getter and setter for changing column count visibility in an already built table @gmbecker. + * New (column-) path based `facet_colcount` getter and setter column count value at arbitrary point in column structure of built table @gmbecker. + * New `facet_colcounts_visible` setter to conveniently set the column count visibility of a set of sibling facets in column space + * New `rm_all_colcounts` convenience function for turning off visibility all column counts throughout the column structure @gmbecker. - +### Bug Fixes + * Fixed bug in `as_html` preventing indentation from being applied in `Viewer` output. + * `col_counts<-` and `col_total<-` methods now explicitly convert `value` to integer, by @gmbecker. + * `col_gap` is now respected in `nlines` row methods, and thus by `make_row_df`, by @gmbecker. + +### Miscellaneous + * Added `lifecycle` badge files for deprecated documentation. + * Deprecated the `gap` and `check_headers` arguments to `rbindl_rtables` using `lifecycle`. + +## rtables 0.6.7 +### New Features + * Added `top_level_section_div` for `basic_table` to set section dividers for top level rows. + * Added `keep_label_rows` to `as_result_df` to have these lines visible. + * `sort_at_path` now gives informative error messages when the given path does not exist. ### Bug Fixes * Fixed `rlistings` decoration (e.g. titles and footers) expansion when there are new lines. Moved relevant handling from `rtables`' `matrix_form` function to `formatters`' dedicated `mform_handle_newlines` function. @@ -22,12 +40,9 @@ * `col_counts<-` and `col_total<-` methods now explicitly convert `value` to integer, by @gmbecker. * `col_gap` is now respected in `nlines` row methods, and thus by `make_row_df`, by @gmbecker. * Updated `as_html` to accommodate `\n` characters. - ### Miscellaneous * Removed deprecated functions `add_analyzed_var` and `trim_zero_rows`. - * Added `lifecycle` badge files for deprecated documentation. - * Deprecated the `gap` and `check_headers` arguments to `rbindl_rtables` using `lifecycle`. ## rtables 0.6.6 ### New Features diff --git a/R/00tabletrees.R b/R/00tabletrees.R index db8d04f6f..26eac6a83 100644 --- a/R/00tabletrees.R +++ b/R/00tabletrees.R @@ -148,7 +148,9 @@ setClass("Split", content_indent_modifier = "integer", content_extra_args = "list", page_title_prefix = "character", - child_section_div = "character" + child_section_div = "character", + child_show_colcounts = "logical", + child_colcount_format = "FormatSpec" ) ) @@ -194,7 +196,9 @@ VarLevelSplit <- function(var, cvar = "", cextra_args = list(), page_prefix = NA_character_, - section_div = NA_character_) { + section_div = NA_character_, + show_colcounts = FALSE, + colcount_format = NULL) { child_labels <- match.arg(child_labels) if (is.null(labels_var)) { labels_var <- var @@ -220,7 +224,9 @@ VarLevelSplit <- function(var, split_label_position = label_pos, content_extra_args = cextra_args, page_title_prefix = page_prefix, - child_section_div = section_div + child_section_div = section_div, + child_show_colcounts = show_colcounts, + child_colcount_format = colcount_format ) } @@ -238,6 +244,8 @@ AllSplit <- function(split_label = "", cindent_mod = 0L, cvar = "", cextra_args = list(), + show_colcounts = FALSE, + colcount_format = NULL, ...) { if (is.null(split_name)) { if (nzchar(split_label)) { @@ -263,7 +271,9 @@ AllSplit <- function(split_label = "", split_label_position = "hidden", content_extra_args = cextra_args, page_title_prefix = NA_character_, - child_section_div = NA_character_ + child_section_div = NA_character_, + child_show_colcounts = show_colcounts, + child_colcount_format = colcount_format ) } @@ -286,7 +296,9 @@ RootSplit <- function(split_label = "", cfun = NULL, cformat = NULL, cna_str = N content_var = cvar, split_label_position = "hidden", content_extra_args = cextra_args, - child_section_div = NA_character_ + child_section_div = NA_character_, + child_show_colcounts = FALSE, + child_colcount_format = "(N=xx)" ) } @@ -330,7 +342,9 @@ ManualSplit <- function(levels, label, name = "manual", split_na_str = NA_character_, split_label_position = label_pos, page_title_prefix = page_prefix, - child_section_div = section_div + child_section_div = section_div, + child_show_colcounts = FALSE, + child_colcount_format = "(N=xx)" ) } @@ -403,7 +417,9 @@ MultiVarSplit <- function(vars, label_pos = "visible", split_fun = NULL, page_prefix = NA_character_, - section_div = NA_character_) { + section_div = NA_character_, + show_colcounts = FALSE, + colcount_format = NULL) { check_ok_label(split_label) ## no topleft allowed label_pos <- match.arg(label_pos, label_pos_values[-3]) @@ -436,7 +452,9 @@ MultiVarSplit <- function(vars, content_extra_args = cextra_args, split_fun = split_fun, page_title_prefix = page_prefix, - child_section_div = section_div + child_section_div = section_div, + child_show_colcounts = show_colcounts, + child_colcount_format = colcount_format ) } @@ -489,7 +507,9 @@ make_static_cut_split <- function(var, label_pos = "visible", cumulative = FALSE, page_prefix = NA_character_, - section_div = NA_character_) { + section_div = NA_character_, + show_colcounts = FALSE, + colcount_format = NULL) { cls <- if (cumulative) "CumulativeCutSplit" else "VarStaticCutSplit" check_ok_label(split_label) @@ -526,7 +546,9 @@ make_static_cut_split <- function(var, split_label_position = label_pos, content_extra_args = cextra_args, page_title_prefix = page_prefix, - child_section_div = section_div + child_section_div = section_div, + child_show_colcounts = show_colcounts, + child_colcount_format = colcount_format ) } @@ -573,7 +595,9 @@ VarDynCutSplit <- function(var, cextra_args = list(), label_pos = "visible", page_prefix = NA_character_, - section_div = NA_character_) { + section_div = NA_character_, + show_colcounts = FALSE, + colcount_format = NULL) { check_ok_label(split_label) label_pos <- match.arg(label_pos, label_pos_values) child_labels <- match.arg(child_labels) @@ -597,7 +621,9 @@ VarDynCutSplit <- function(var, split_label_position = label_pos, content_extra_args = cextra_args, page_title_prefix = page_prefix, - child_section_div = section_div + child_section_div = section_div, + child_show_colcounts = show_colcounts, + child_colcount_format = colcount_format ) } @@ -673,7 +699,9 @@ AnalyzeVarSplit <- function(var, var_label_position = label_pos, content_var = cvar, page_title_prefix = NA_character_, - child_section_div = section_div + child_section_div = section_div, + child_show_colcounts = FALSE, + child_colcount_format = NA_character_ ) ## no content_extra_args } @@ -717,7 +745,9 @@ AnalyzeColVarSplit <- function(afun, var_label_position = label_pos, content_var = cvar, page_title_prefix = NA_character_, - child_section_div = section_div + child_section_div = section_div, + child_show_colcounts = FALSE, + child_colcount_format = NA_character_ ) ## no content_extra_args } @@ -911,7 +941,9 @@ VarLevWBaselineSplit <- function(var, split_na_str = NA_character_, valorder = NULL, split_name = var, - extra_args = list()) { + extra_args = list(), + show_colcounts = FALSE, + colcount_format = NULL) { check_ok_label(split_label) new("VarLevWBaselineSplit", payload = var, @@ -937,7 +969,9 @@ VarLevWBaselineSplit <- function(var, content_var = cvar, ## so long as this is columnspace only page_title_prefix = NA_character_, - child_section_div = NA_character_ + child_section_div = NA_character_, + child_show_colcounts = show_colcounts, + child_colcount_format = colcount_format ) } @@ -1067,11 +1101,15 @@ setClass("LayoutAxisTree", } ) +## this is only used for columns!!!! setClass("LayoutAxisLeaf", contains = "VLayoutLeaf", ## "VNodeInfo", representation( func = "function", - col_footnotes = "list" + display_columncounts = "logical", + columncount_format = "FormatSpec", # character", + col_footnotes = "list", + column_count = "integer" ) ) @@ -1079,8 +1117,9 @@ setClass("LayoutColTree", contains = "LayoutAxisTree", representation( display_columncounts = "logical", - columncount_format = "character", - col_footnotes = "list" + columncount_format = "FormatSpec", # "character", + col_footnotes = "list", + column_count = "integer" ) ) @@ -1092,9 +1131,10 @@ LayoutColTree <- function(lev = 0L, spl = EmptyAllSplit, tpos = TreePos(), summary_function = NULL, - disp_colcounts = FALSE, - colcount_format = "(N=xx)", - footnotes = list()) { ## , + disp_ccounts = FALSE, + colcount_format = NULL, + footnotes = list(), + colcount) { ## , ## sub = expression(TRUE), ## svar = NA_character_, ## slab = NA_character_) { @@ -1115,23 +1155,27 @@ LayoutColTree <- function(lev = 0L, ## subset = sub, ## splitvar = svar, label = label, - display_columncounts = disp_colcounts, + display_columncounts = disp_ccounts, columncount_format = colcount_format, - col_footnotes = footnotes + col_footnotes = footnotes, + column_count = colcount ) } LayoutColLeaf <- function(lev = 0L, name = label, label = "", - tpos = TreePos()) { + tpos = TreePos(), + colcount, + disp_ccounts = FALSE, + colcount_format = NULL) { check_ok_label(label) new("LayoutColLeaf", level = lev, name = .chkname(name), label = label, - pos_in_tree = tpos ## , - ## subset = sub#, - ## N_count = n, - ## splitvar = svar + pos_in_tree = tpos, + column_count = colcount, + display_columncounts = disp_ccounts, + columncount_format = colcount_format ) } @@ -1178,7 +1222,7 @@ setClass( #' #' @export #' @rdname cinfo -InstantiatedColumnInfo <- function(treelyt = LayoutColTree(), +InstantiatedColumnInfo <- function(treelyt = LayoutColTree(colcount = total_cnt), csubs = list(expression(TRUE)), extras = list(list()), cnts = NA_integer_, @@ -1210,6 +1254,15 @@ InstantiatedColumnInfo <- function(treelyt = LayoutColTree(), ) } + if (!is.na(dispcounts)) { + pths <- col_paths(treelyt) + for (path in pths) { + colcount_visible(treelyt, path) <- dispcounts + } + } else { ## na leaves the children as they are and dispcols goes to whether any of them are displayed for the leaves + dispcounts <- any(vapply(leaves, disp_ccounts, NA)) + } + new("InstantiatedColumnInfo", tree_layout = treelyt, subset_exprs = csubs, @@ -1750,7 +1803,7 @@ setClass("PreDataColLayout", contains = "PreDataAxisLayout", representation( display_columncounts = "logical", - columncount_format = "character" + columncount_format = "FormatSpec" # "character" ) ) @@ -1760,7 +1813,7 @@ PreDataColLayout <- function(x = SplitVector(), rtsp = RootSplit(), ..., lst = list(x, ...), - disp_colcounts = FALSE, + disp_colcounts = NA, colcount_format = "(N=xx)") { ret <- new("PreDataColLayout", lst, display_columncounts = disp_colcounts, diff --git a/R/argument_conventions.R b/R/argument_conventions.R index f004a0fa1..3c4a99641 100644 --- a/R/argument_conventions.R +++ b/R/argument_conventions.R @@ -122,6 +122,11 @@ gen_args <- function(df, alt_counts_df, spl, pos, tt, tr, verbose, colwidths, ob #' uniqueness. #' @param vars (`character`)\cr vector of variable names. #' @param var_labels (`character`)\cr vector of labels for one or more variables. +#' @param show_colcounts (`logical(1)`)\cr should column counts be displayed at the level +#' facets created by this split. Defaults to `FALSE`. +#' @param colcount_format (`character(1)`)\cr if `show_colcounts` is `TRUE`, the +#' format which should be used to display column counts for facets generated by +#' this split. Defaults to `"(N=xx)"`. #' #' @inherit gen_args return #' @@ -136,7 +141,8 @@ lyt_args <- function(lyt, var, vars, label, labels_var, varlabels, varnames, spl indent_mod, show_labels, label_pos, # visible_label, var_labels, cvar, table_names, topleft, align, page_by, page_prefix, - format_na_str, section_div, na_str) { + format_na_str, section_div, na_str, show_colcounts, + colcount_format) { NULL } diff --git a/R/colby_constructors.R b/R/colby_constructors.R index fc43a32d7..19bd7dd47 100644 --- a/R/colby_constructors.R +++ b/R/colby_constructors.R @@ -364,7 +364,9 @@ split_cols_by <- function(lyt, nested = TRUE, child_labels = c("default", "visible", "hidden"), extra_args = list(), - ref_group = NULL) { ## , + ref_group = NULL, + show_colcounts = FALSE, + colcount_format = NULL) { ## , if (is.null(ref_group)) { spl <- VarLevelSplit( var = var, @@ -373,7 +375,9 @@ split_cols_by <- function(lyt, split_format = format, child_labels = child_labels, split_fun = split_fun, - extra_args = extra_args + extra_args = extra_args, + show_colcounts = show_colcounts, + colcount_format = colcount_format ) } else { spl <- VarLevWBaselineSplit( @@ -382,7 +386,9 @@ split_cols_by <- function(lyt, split_label = split_label, split_fun = split_fun, labels_var = labels_var, - split_format = format + split_format = format, + show_colcounts = show_colcounts, + colcount_format = colcount_format ) } pos <- next_cpos(lyt, nested) @@ -576,13 +582,18 @@ split_cols_by_multivar <- function(lyt, varlabels = vars, varnames = NULL, nested = TRUE, - extra_args = list()) { + extra_args = list(), + ## for completeness even though it doesn't make sense + show_colcounts = FALSE, + colcount_format = NULL) { spl <- MultiVarSplit( vars = vars, split_label = "", varlabels = varlabels, varnames = varnames, split_fun = split_fun, - extra_args = extra_args + extra_args = extra_args, + show_colcounts = show_colcounts, + colcount_format = colcount_format ) pos <- next_cpos(lyt, nested) split_cols(lyt, spl, pos) @@ -738,13 +749,17 @@ split_cols_by_cuts <- function(lyt, var, cuts, cutlabels = NULL, split_label = var, nested = TRUE, - cumulative = FALSE) { + cumulative = FALSE, + show_colcounts = FALSE, + colcount_format = NULL) { spl <- make_static_cut_split( var = var, split_label = split_label, cuts = cuts, cutlabels = cutlabels, - cumulative = cumulative + cumulative = cumulative, + show_colcounts = show_colcounts, + colcount_format = colcount_format ) ## if(cumulative) ## spl = as(spl, "CumulativeCutSplit") @@ -788,13 +803,17 @@ split_cols_by_cutfun <- function(lyt, var, split_label = var, nested = TRUE, extra_args = list(), - cumulative = FALSE) { + cumulative = FALSE, + show_colcounts = FALSE, + colcount_format = NULL) { spl <- VarDynCutSplit(var, split_label, cutfun = cutfun, cutlabelfun = cutlabelfun, extra_args = extra_args, cumulative = cumulative, - label_pos = "hidden" + label_pos = "hidden", + show_colcounts = show_colcounts, + colcount_format = colcount_format ) pos <- next_cpos(lyt, nested) split_cols(lyt, spl, pos) @@ -805,7 +824,9 @@ split_cols_by_cutfun <- function(lyt, var, split_cols_by_quartiles <- function(lyt, var, split_label = var, nested = TRUE, extra_args = list(), - cumulative = FALSE) { + cumulative = FALSE, + show_colcounts = FALSE, + colcount_format = NULL) { split_cols_by_cutfun( lyt = lyt, var = var, @@ -821,7 +842,9 @@ split_cols_by_quartiles <- function(lyt, var, split_label = var, }, nested = nested, extra_args = extra_args, - cumulative = cumulative + cumulative = cumulative, + show_colcounts = show_colcounts, + colcount_format = colcount_format ) ## spl = VarDynCutSplit(var, split_label, cutfun = qtile_cuts, ## cutlabelfun = function(x) c("[min, Q1]", @@ -1807,6 +1830,7 @@ setMethod( #' @param ... one or more vectors of levels to appear in the column space. If more than one set of levels is given, #' the values of the second are nested within each value of the first, and so on. #' @param .lst (`list`)\cr a list of sets of levels, by default populated via `list(...)`. +#' @param ccount_format (`FormatSpec`)\cr the format to use when counts are displayed. #' #' @return An `InstantiatedColumnInfo` object, suitable for declaring the column structure for a manually constructed #' table. @@ -1831,7 +1855,7 @@ setMethod( #' #' @author Gabriel Becker #' @export -manual_cols <- function(..., .lst = list(...)) { +manual_cols <- function(..., .lst = list(...), ccount_format = NULL) { if (is.null(names(.lst))) { names(.lst) <- paste("colsplit", seq_along(.lst)) } @@ -1840,10 +1864,78 @@ manual_cols <- function(..., .lst = list(...)) { levels = .lst, label = names(.lst) )) - ctree <- splitvec_to_coltree(data.frame(), splvec = splvec, pos = TreePos()) - InstantiatedColumnInfo(treelyt = ctree) + ctree <- splitvec_to_coltree(data.frame(), splvec = splvec, pos = TreePos(), global_cc_format = ccount_format) + + ret <- InstantiatedColumnInfo(treelyt = ctree) + rm_all_colcounts(ret) } + +#' Set all column counts at all levels of nesting to NA +#' +#' @inheritParams gen_args +#' +#' @return `obj` with all column counts reset to missing +#' +#' @export +#' @examples +#' lyt <- basic_table() %>% +#' split_cols_by("ARM") %>% +#' split_cols_by("SEX") %>% +#' analyze("AGE") +#' tbl <- build_table(lyt, ex_adsl) +#' +#' # before +#' col_counts(tbl) +#' tbl <- rm_all_colcounts(tbl) +#' col_counts(tbl) +setGeneric("rm_all_colcounts", function(obj) standardGeneric("rm_all_colcounts")) + +#' @rdname rm_all_colcounts +#' @export +setMethod( + "rm_all_colcounts", "VTableTree", + function(obj) { + cinfo <- col_info(obj) + cinfo <- rm_all_colcounts(cinfo) + col_info(obj) <- cinfo + obj + } +) + +#' @rdname rm_all_colcounts +#' @export +setMethod( + "rm_all_colcounts", "InstantiatedColumnInfo", + function(obj) { + ctree <- coltree(obj) + ctree <- rm_all_colcounts(ctree) + coltree(obj) <- ctree + obj + } +) + +#' @rdname rm_all_colcounts +#' @export +setMethod( + "rm_all_colcounts", "LayoutColTree", + function(obj) { + obj@column_count <- NA_integer_ + tree_children(obj) <- lapply(tree_children(obj), rm_all_colcounts) + obj + } +) + +#' @rdname rm_all_colcounts +#' @export +setMethod( + "rm_all_colcounts", "LayoutColLeaf", + function(obj) { + obj@column_count <- NA_integer_ + obj + } +) + #' Returns a function that coerces the return values of a function to a list #' #' @param f (`function`)\cr the function to wrap. @@ -1905,10 +1997,15 @@ list_wrap_df <- function(f) { #' Every layout must start with a basic table. #' #' @inheritParams constr_args -#' @param show_colcounts (`flag`)\cr whether column counts should be displayed in the resulting table when this -#' layout is applied to data. +#' @param show_colcounts (`logical(1)`)\cr Indicates whether the lowest level of +#' applied to data. `NA`, the default, indicates that the `show_colcounts` +#' argument(s) passed to the relevant calls to `split_cols_by*` +#' functions. Non-missing values will override the behavior specified in +#' column splitting layout instructions which create the lowest level, or +#' leaf, columns. #' @param colcount_format (`string`)\cr format for use when displaying the column counts. Must be 1d, or 2d -#' where one component is a percent. See Details below. +#' where one component is a percent. This will also apply to any displayed higher +#' level column counts where an explicit format was not specified. Defaults to `"(N=xx)"`. See Details below. #' @param top_level_section_div (`character(1)`)\cr if assigned a single character, the first (top level) split #' or division of the table will be highlighted by a line made of that character. See [section_div] for more #' information. @@ -1964,7 +2061,7 @@ basic_table <- function(title = "", subtitles = character(), main_footer = character(), prov_footer = character(), - show_colcounts = FALSE, + show_colcounts = NA, # FALSE, colcount_format = "(N=xx)", header_section_div = NA_character_, top_level_section_div = NA_character_, @@ -1985,9 +2082,13 @@ basic_table <- function(title = "", top_level_section_div = top_level_section_div, table_inset = as.integer(inset) ) - if (show_colcounts) { - ret <- add_colcounts(ret, format = colcount_format) - } + + ## unconditional now, NA case is handled in cinfo construction + disp_ccounts(ret) <- show_colcounts + colcount_format(ret) <- colcount_format + ## if (isTRUE(show_colcounts)) { + ## ret <- add_colcounts(ret, format = colcount_format) + ## } ret } diff --git a/R/make_split_fun.R b/R/make_split_fun.R index acceb40e0..32794b2bb 100644 --- a/R/make_split_fun.R +++ b/R/make_split_fun.R @@ -91,13 +91,6 @@ validate_split_result <- function(pinfo, component = NULL) { #' These functions performs various housekeeping tasks to ensure that the split result list is as the rtables #' internals expect it, most of which are not relevant to end users. #' -#' @note Column splitting will not work correctly if a split function -#' calls `make_split_result` without specifying subset expressions; -#' row splitting will work as normal. This is due to the fact that -#' subsetting expressions are used during column splitting to -#' represent the data associated with facets, while actual data -#' subsets are used during row splitting. -#' #' @examples #' splres <- make_split_result( #' values = c("hi", "lo"), @@ -352,6 +345,7 @@ add_combo_facet <- function(name, label = name, levels, extra = list()) { datpart <- list(do.call(rbind, ret$datasplit[levels])) } + val <- LevelComboSplitValue( val = name, extr = extra, combolevels = levels, label = label, sub_expr = subexpr diff --git a/R/make_subset_expr.R b/R/make_subset_expr.R index 0392df010..f6c8b3e61 100644 --- a/R/make_subset_expr.R +++ b/R/make_subset_expr.R @@ -152,9 +152,8 @@ setMethod( } } - if (is.null(ex2)) { - ex2 <- expression(TRUE) - } + ## if(is.null(ex2)) + ## ex2 <- expression(TRUE) stopifnot(is.expression(ex1), is.expression(ex2)) as.expression(bquote((.(a)) & .(b), list(a = ex1[[1]], b = ex2[[1]]))) } @@ -222,7 +221,19 @@ create_colinfo <- function(lyt, df, rtpos = TreePos(), if (is.null(topleft)) { topleft <- top_left(lyt) } - ctree <- coltree(clayout, df = df, rtpos = rtpos) + cc_format <- colcount_format(lyt) %||% "(N=xx)" + + ## do it this way for full backwards compatibility + if (is.null(alt_counts_df)) { + alt_counts_df <- df + } + ctree <- coltree(clayout, df = df, rtpos = rtpos, alt_counts_df = alt_counts_df, ccount_format = cc_format) + if (!is.na(disp_ccounts(lyt))) { + leaf_pths <- make_col_df(ctree, visible_only = TRUE, na_str = "", ccount_format = cc_format)$path + for (path in leaf_pths) { + colcount_visible(ctree, path) <- disp_ccounts(lyt) + } + } cexprs <- make_col_subsets(ctree, df) colextras <- col_extra_args(ctree) @@ -233,20 +244,17 @@ create_colinfo <- function(lyt, df, rtpos = TreePos(), ## the counts will obviously be wrong. if (is.null(counts)) { counts <- rep(NA_integer_, length(cexprs)) - } else { - if (length(counts) != length(cexprs)) { - stop( - "Length of overriding counts must equal number of columns. Got ", - length(counts), " values for ", length(cexprs), " columns. ", - "Use NAs to specify that the default counting machinery should be ", - "used for that position." - ) - } - counts <- as.integer(counts) + } else if (length(counts) != length(cexprs)) { + stop( + "Length of overriding counts must equal number of columns. Got ", + length(counts), " values for ", length(cexprs), " columns. ", + "Use NAs to specify that the default counting machinery should be ", + "used for that position." + ) } counts_df_name <- "alt_counts_df" - if (is.null(alt_counts_df)) { + if (identical(alt_counts_df, df)) { # is.null(alt_counts_df)) { alt_counts_df <- df counts_df_name <- "df" } @@ -259,18 +267,6 @@ create_colinfo <- function(lyt, df, rtpos = TreePos(), 0L } else { vec <- try(eval(ex, envir = alt_counts_df), silent = TRUE) - if (is(vec, "try-error")) { - stop(sprintf( - paste( - counts_df_name, "appears", - "incompatible with column-split", - "structure. Offending column subset", - "expression: %s\nOriginal error", - "message: %s" - ), deparse(ex[[1]]), - conditionMessage(attr(vec, "condition")) - )) - } if (is(vec, "numeric")) { length(vec) } else if (is(vec, "logical")) { ## sum(is.na(.)) ???? @@ -283,14 +279,18 @@ create_colinfo <- function(lyt, df, rtpos = TreePos(), if (is.null(total)) { total <- sum(counts) } - format <- colcount_format(lyt) + + cpths <- col_paths(ctree) + for (i in seq_along(cpths)) { + facet_colcount(ctree, cpths[[i]]) <- counts[i] + } InstantiatedColumnInfo( treelyt = ctree, csubs = cexprs, extras = colextras, cnts = counts, dispcounts = disp_ccounts(lyt), - countformat = format, + countformat = cc_format, total_cnt = total, topleft = topleft ) diff --git a/R/tree_accessors.R b/R/tree_accessors.R index b31b13e4b..6d8844a6b 100644 --- a/R/tree_accessors.R +++ b/R/tree_accessors.R @@ -345,6 +345,18 @@ setMethod( function(obj) obj@subset ) +#' @rdname int_methods +setGeneric("tree_pos<-", function(obj, value) standardGeneric("tree_pos<-")) + +#' @rdname int_methods +setMethod( + "tree_pos<-", "VLayoutNode", + function(obj, value) { + obj@pos_in_tree <- value + obj + } +) + ## setMethod("pos_subset", "VNodeInfo", ## function(obj) pos_subset(tree_pos(obj))) @@ -372,6 +384,33 @@ setMethod( function(obj) pos_splits(tree_pos(obj)) ) +#' @rdname int_methods +setGeneric("pos_splits<-", function(obj, value) standardGeneric("pos_splits<-")) + +#' @rdname int_methods +setMethod( + "pos_splits<-", "TreePos", + function(obj, value) { + obj@splits <- value + obj + } +) + +#' @rdname int_methods +setMethod( + "pos_splits<-", "VLayoutNode", + function(obj, value) { + pos <- tree_pos(obj) + pos_splits(pos) <- value + tree_pos(obj) <- pos + obj + obj + } +) + + + + #' @rdname int_methods setGeneric("pos_splvals", function(obj) standardGeneric("pos_splvals")) @@ -390,6 +429,33 @@ setMethod( function(obj) pos_splvals(tree_pos(obj)) ) +#' @rdname int_methods +setGeneric("pos_splvals<-", function(obj, value) standardGeneric("pos_splvals<-")) + +#' @rdname int_methods +setMethod( + "pos_splvals<-", "TreePos", + function(obj, value) { + obj@s_values <- value + obj + } +) + +## setMethod("pos_splvals", "VNodeInfo", +## function(obj) pos_splvals(tree_pos(obj))) + +#' @rdname int_methods +setMethod( + "pos_splvals<-", "VLayoutNode", + function(obj, value) { + pos <- tree_pos(obj) + pos_splvals(pos) <- value + tree_pos(obj) <- pos + obj + } +) + + #' @rdname int_methods setGeneric("pos_splval_labels", function(obj) standardGeneric("pos_splval_labels")) @@ -1769,7 +1835,6 @@ setMethod("value_expr", "ValueWrapper", function(obj) obj@subset_expression) setMethod("value_expr", "ANY", function(obj) NULL) ## no setters for now, we'll see about that. - #' @rdname int_methods setGeneric("spl_varlabels", function(obj) standardGeneric("spl_varlabels")) @@ -1966,17 +2031,20 @@ setMethod( ) #' @rdname col_accessors +#' @param ccount_format (`FormatSpec`)\cr The format to be used by default for column +#' counts throughout this column tree (i.e. if not overridden by a more specific format +#' specification). #' @export setGeneric( "coltree", - function(obj, df = NULL, rtpos = TreePos()) standardGeneric("coltree") + function(obj, df = NULL, rtpos = TreePos(), alt_counts_df = df, ccount_format = "(N=xx)") standardGeneric("coltree") ) #' @rdname col_accessors #' @exportMethod coltree setMethod( "coltree", "InstantiatedColumnInfo", - function(obj, df = NULL, rtpos = TreePos()) { + function(obj, df = NULL, rtpos = TreePos(), alt_counts_df = df, ccount_format) { if (!is.null(df)) { warning("Ignoring df argument and retrieving already-computed LayoutColTree") } @@ -1988,14 +2056,16 @@ setMethod( #' @export coltree setMethod( "coltree", "PreDataTableLayouts", - function(obj, df, rtpos) coltree(clayout(obj), df, rtpos) + function(obj, df, rtpos, alt_counts_df = df, ccount_format) { + coltree(clayout(obj), df, rtpos, alt_counts_df = alt_counts_df, ccount_format = ccount_format) + } ) #' @rdname col_accessors #' @export coltree setMethod( "coltree", "PreDataColLayout", - function(obj, df, rtpos) { + function(obj, df, rtpos, alt_counts_df = df, ccount_format) { obj <- set_def_child_ord(obj, df) kids <- lapply( obj, @@ -2003,7 +2073,9 @@ setMethod( splitvec_to_coltree( df = df, splvec = x, - pos = rtpos + pos = rtpos, + alt_counts_df = alt_counts_df, + global_cc_format = ccount_format ) } ) @@ -2014,7 +2086,9 @@ setMethod( lev = 0L, kids = kids, tpos = rtpos, - spl = RootSplit() + spl = RootSplit(), + colcount = NROW(alt_counts_df), + colcount_format = ccount_format ) } disp_ccounts(res) <- disp_ccounts(obj) @@ -2026,21 +2100,21 @@ setMethod( #' @export coltree setMethod( "coltree", "LayoutColTree", - function(obj, df, rtpos) obj + function(obj, df, rtpos, alt_counts_df, ccount_format) obj ) #' @rdname col_accessors #' @export coltree setMethod( "coltree", "VTableTree", - function(obj, df, rtpos) coltree(col_info(obj)) + function(obj, df, rtpos, alt_counts_df, ccount_format) coltree(col_info(obj)) ) #' @rdname col_accessors #' @export coltree setMethod( "coltree", "TableRow", - function(obj, df, rtpos) coltree(col_info(obj)) + function(obj, df, rtpos, alt_counts_df, ccount_format) coltree(col_info(obj)) ) setGeneric("coltree<-", function(obj, value) standardGeneric("coltree<-")) @@ -2149,6 +2223,7 @@ setMethod( } ) +#' @seealso [facet_colcount()] #' @export #' @rdname col_accessors setGeneric("col_counts", function(obj, path = NULL) standardGeneric("col_counts")) @@ -2157,7 +2232,17 @@ setGeneric("col_counts", function(obj, path = NULL) standardGeneric("col_counts" #' @rdname col_accessors setMethod( "col_counts", "InstantiatedColumnInfo", - function(obj, path = NULL) obj@counts[.path_to_pos(path, obj, cols = TRUE)] + function(obj, path = NULL) { + if (is.null(path)) { + lfs <- collect_leaves(coltree(obj)) + ret <- vapply(lfs, facet_colcount, 1L, path = NULL) + } else { + ret <- facet_colcount(obj, path) + } + ## required for strict backwards compatibility, + ## even though its undesirable behavior. + unname(ret) + } ) #' @export @@ -2176,8 +2261,26 @@ setGeneric("col_counts<-", function(obj, path = NULL, value) standardGeneric("co setMethod( "col_counts<-", "InstantiatedColumnInfo", function(obj, path = NULL, value) { - ## all methods funnel to this one so ensure integer-ness here. - obj@counts[.path_to_pos(path, obj, cols = TRUE)] <- as.integer(value) + ## obj@counts[.path_to_pos(path, obj, cols = TRUE)] <- value + ## obj + if (!is.null(path)) { + all_paths <- list(path) + } else { + all_paths <- make_col_df(obj, visible_only = TRUE)$path + } + if (length(value) != length(all_paths)) { + stop( + "Got ", length(value), " values for ", + length(all_paths), " column paths", + if (is.null(path)) " (from path = NULL)", + "." + ) + } + ctree <- coltree(obj) + for (i in seq_along(all_paths)) { + facet_colcount(ctree, all_paths[[i]]) <- value[i] + } + coltree(obj) <- ctree obj } ) @@ -2266,6 +2369,24 @@ setMethod( function(obj) obj@display_columncounts ) +#' @rdname int_methods +setMethod( + "disp_ccounts", "LayoutColTree", + function(obj) obj@display_columncounts +) + +#' @rdname int_methods +setMethod( + "disp_ccounts", "LayoutColLeaf", + function(obj) obj@display_columncounts +) + +#' @rdname int_methods +setMethod( + "disp_ccounts", "Split", + function(obj) obj@child_show_colcounts +) + #' @rdname int_methods setGeneric("disp_ccounts<-", function(obj, value) standardGeneric("disp_ccounts<-")) @@ -2307,6 +2428,15 @@ setMethod( } ) +#' @rdname int_methods +setMethod( + "disp_ccounts<-", "LayoutColLeaf", + function(obj, value) { + obj@display_columncounts <- value + obj + } +) + #' @rdname int_methods setMethod( "disp_ccounts<-", "PreDataTableLayouts", @@ -2318,6 +2448,366 @@ setMethod( } ) + +## this is a horrible hack but when we have non-nested siblings at the top level +## the beginning of the "path <-> position" relationship breaks down. +## we probably *should* have e.g., c("root", "top_level_splname_1", +## "top_level_splname_1, "top_level_splname_1_value", ...) +## but its pretty clear why no one will be happy with that, I think +## so we punt on the problem for now with an explicit workaround +## +## those first non-nested siblings currently have (incorrect) +## empty tree_pos elements so we just look at the obj_name + +pos_singleton_path <- function(obj) { + pos <- tree_pos(obj) + splvals <- pos_splvals(pos) + length(splvals) == 0 || + (length(splvals) == 1 && is.na(unlist(value_names(splvals)))) +} + +## close to a duplicate of tt_at_path, but... not quite :( +#' @rdname int_methods +coltree_at_path <- function(obj, path, ...) { + if (length(path) == 0) { + return(obj) + } + stopifnot( + is(path, "character"), + length(path) > 0 + ) + if (any(grepl("@content", path, fixed = TRUE))) { + stop("@content token is not valid for column paths.") + } + + cur <- obj + curpath <- pos_to_path(tree_pos(obj)) # path + num_consume_path <- 2 + while (!identical(curpath, path) && !is(cur, "LayoutColLeaf")) { # length(curpath) > 0) { + kids <- tree_children(cur) + kidmatch <- find_kid_path_match(kids, path) + if (length(kidmatch) == 0) { + stop( + "unable to match full path: ", paste(path, sep = "->"), + "\n path of last match: ", paste(curpath, sep = "->") + ) + } + cur <- kids[[kidmatch]] + curpath <- pos_to_path(tree_pos(cur)) + } + cur +} + +find_kid_path_match <- function(kids, path) { + if (length(kids) == 0) { + return(integer()) + } + kidpaths <- lapply(kids, function(k) pos_to_path(tree_pos(k))) + + matches <- vapply(kidpaths, function(kpth) identical(path[seq_along(kpth)], kpth), NA) + firstkidpos <- tree_pos(kids[[1]]) + if (all(matches) && pos_singleton_path(kids[[1]])) { + kidpaths <- lapply(seq_along(kidpaths), function(i) c(kidpaths[[i]], obj_name(kids[[i]]))) + matches <- vapply(kidpaths, function(kpth) identical(path[seq_along(kpth)], kpth), NA) + } + which(matches) +} + + +## almost a duplicate of recursive_replace, but I spent a bunch +## of time ramming my head against the different way pathing happens +## in column space (unfortunately) before giving up building +## coltree_at_path around recursive_replace, so here we are. + +ct_recursive_replace <- function(ctree, path, value, pos = 1) { + pos <- tree_pos(ctree) + curpth <- pos_to_path(pos) + if (identical(path, curpth)) { + return(value) + } else if (is(ctree, "LayoutColLeaf")) { + stop( + "unable to match full path: ", paste(path, sep = "->"), + "\n path at leaf: ", paste(curpth, sep = "->") + ) + } + kids <- tree_children(ctree) + kids_singl <- pos_singleton_path(kids[[1]]) + kidind <- find_kid_path_match(kids, path) + + if (length(kidind) == 0) { + stop("Path appears invalid for this tree at step ", path[1]) + } else if (length(kidind) > 1) { + stop( + "singleton step (root, cbind_root, etc) in path appears to have matched multiple children. ", + "This shouldn't happen, please contact the maintainers." + ) + } + + kids[[kidind]] <- ct_recursive_replace( + kids[[kidind]], + path, value + ) + tree_children(ctree) <- kids + ctree +} + +`coltree_at_path<-` <- function(obj, path, value) { + obj <- ct_recursive_replace(obj, path, value) + obj +} + +#' Set visibility of column counts for a group of sibling facets +#' +#' @inheritParams gen_args +#' @param path (`character`)\cr the path *to the parent of the +#' desired siblings*. The last element in the path should +#' be a split name. +#' @return obj, modified with the desired column count. +#' display behavior +#' +#' @seealso [colcount_visible()] +#' +#' @export +`facet_colcounts_visible<-` <- function(obj, path, value) { + coldf <- make_col_df(obj, visible_only = FALSE) + allpaths <- coldf$path + lenpath <- length(path) + match_paths <- vapply(allpaths, function(path_i) { + (length(path_i) == lenpath + 1) && + (all(head(path_i, -1) == path)) + }, TRUE) + for (curpath in allpaths[match_paths]) { + colcount_visible(obj, curpath) <- value + } + obj +} + +#' Get or set column count for a facet in column space +#' +#' @inheritParams gen_args +#' @param path character. This path must end on a +#' split value, e.g., the level of a categorical variable +#' that was split on in column space, but it need not +#' be the path to an individual column. +#' +#' @return for `facet_colcount` the current count associated +#' with that facet in column space, for `facet_colcount<-`, +#' `obj` modified with the new column count for the specified +#' facet. +#' +#' @note Updating a lower-level (more specific) +#' column count manually **will not** update the +#' counts for its parent facets. This cannot be made +#' automatic because the rtables framework does not +#' require sibling facets to be mutually exclusive +#' (e.g., total "arm", faceting into cumulative +#' quantiles, etc) and thus the count of a parent facet +#' will not always be simply the sum of the counts for +#' all of its children. +#' +#' @seealso [col_counts()] +#' +#' @examples +#' lyt <- basic_table() %>% +#' split_cols_by("ARM", show_colcounts = TRUE) %>% +#' split_cols_by("SEX", +#' split_fun = keep_split_levels(c("F", "M")), +#' show_colcounts = TRUE +#' ) %>% +#' split_cols_by("STRATA1", show_colcounts = TRUE) %>% +#' analyze("AGE") +#' +#' tbl <- build_table(lyt, ex_adsl) +#' +#' facet_colcount(tbl, c("ARM", "A: Drug X")) +#' facet_colcount(tbl, c("ARM", "A: Drug X", "SEX", "F")) +#' facet_colcount(tbl, c("ARM", "A: Drug X", "SEX", "F", "STRATA1", "A")) +#' +#' ## modify specific count after table creation +#' facet_colcount(tbl, c("ARM", "A: Drug X", "SEX", "F", "STRATA1", "A")) <- 25 +#' +#' ## show black space for certain counts by assign NA +#' +#' facet_colcount(tbl, c("ARM", "A: Drug X", "SEX", "F", "STRATA1", "C")) <- NA +#' +#' @export +setGeneric( + "facet_colcount", + function(obj, path) standardGeneric("facet_colcount") +) + +#' @rdname facet_colcount +#' @export +setMethod( + "facet_colcount", "LayoutColTree", + function(obj, path = NULL) { + ## if(length(path) == 0L) + ## stop("face_colcount requires a non-null path") #nocov + subtree <- coltree_at_path(obj, path) + subtree@column_count + } +) + +#' @rdname facet_colcount +#' @export +setMethod( + "facet_colcount", "LayoutColLeaf", + function(obj, path = NULL) { + ## not sure if we should check for null here as above + obj@column_count + } +) + +#' @rdname facet_colcount +#' @export +setMethod( + "facet_colcount", "VTableTree", + function(obj, path) facet_colcount(coltree(obj), path = path) +) + +#' @rdname facet_colcount +#' @export +setMethod( + "facet_colcount", "InstantiatedColumnInfo", + function(obj, path) facet_colcount(coltree(obj), path = path) +) + +#' @rdname facet_colcount +#' @export +setGeneric( + "facet_colcount<-", + function(obj, path, value) standardGeneric("facet_colcount<-") +) + +#' @rdname facet_colcount +#' @export +setMethod( + "facet_colcount<-", "LayoutColTree", + function(obj, path, value) { + ct <- coltree_at_path(obj, path) + ct@column_count <- as.integer(value) + coltree_at_path(obj, path) <- ct + obj + } +) + +#' @rdname facet_colcount +#' @export +setMethod( + "facet_colcount<-", "LayoutColLeaf", + function(obj, path, value) { + obj@column_count <- as.integer(value) + obj + } +) + +#' @rdname facet_colcount +#' @export +setMethod( + "facet_colcount<-", "VTableTree", + function(obj, path, value) { + cinfo <- col_info(obj) + facet_colcount(cinfo, path) <- value + col_info(obj) <- cinfo + obj + } +) + +#' @rdname facet_colcount +#' @export +setMethod( + "facet_colcount<-", "InstantiatedColumnInfo", + function(obj, path, value) { + ct <- coltree(obj) + facet_colcount(ct, path) <- value + coltree(obj) <- ct + obj + } +) + +#' Value and Visibility of specific column counts by path +#' +#' @inheritParams gen_args +#' +#' @return for `colcount_visible` a logical scalar +#' indicating whether the specified position in +#' the column hierarchy is set to display its column count; +#' for `colcount_visible<-`, `obj` updated with +#' the specified count displaying behavior set. +#' +#' @note Users generally should not call `colcount_visible` +#' directly, as setting sibling facets to have differing +#' column count visibility will result in an error when +#' printing or paginating the table. +#' +#' @export +setGeneric("colcount_visible", function(obj, path) standardGeneric("colcount_visible")) + +#' @rdname colcount_visible +#' @export +setMethod( + "colcount_visible", "VTableTree", + function(obj, path) colcount_visible(coltree(obj), path) +) + +#' @rdname colcount_visible +#' @export +setMethod( + "colcount_visible", "InstantiatedColumnInfo", + function(obj, path) colcount_visible(coltree(obj), path) +) + +#' @rdname colcount_visible +#' @export +setMethod( + "colcount_visible", "LayoutColTree", + function(obj, path) { + subtree <- coltree_at_path(obj, path) + disp_ccounts(subtree) + } +) + +#' @rdname colcount_visible +#' @export +setGeneric("colcount_visible<-", function(obj, path, value) standardGeneric("colcount_visible<-")) + +#' @rdname colcount_visible +#' @export +setMethod( + "colcount_visible<-", "VTableTree", + function(obj, path, value) { + ctree <- coltree(obj) + colcount_visible(ctree, path) <- value + coltree(obj) <- ctree + obj + } +) + +#' @rdname colcount_visible +#' @export +setMethod( + "colcount_visible<-", "InstantiatedColumnInfo", + function(obj, path, value) { + ctree <- coltree(obj) + colcount_visible(ctree, path) <- value + coltree(obj) <- ctree + obj + } +) + + +#' @rdname colcount_visible +#' @export +setMethod( + "colcount_visible<-", "LayoutColTree", + function(obj, path, value) { + subtree <- coltree_at_path(obj, path) + disp_ccounts(subtree) <- value + coltree_at_path(obj, path) <- subtree + obj + } +) + #' @rdname int_methods #' @export setGeneric("colcount_format", function(obj) standardGeneric("colcount_format")) @@ -2350,6 +2840,29 @@ setMethod( function(obj) colcount_format(clayout(obj)) ) +#' @rdname int_methods +#' @export +setMethod( + "colcount_format", "Split", + function(obj) obj@child_colcount_format +) + +#' @rdname int_methods +#' @export +setMethod( + "colcount_format", "LayoutColTree", + function(obj) obj@columncount_format +) + +#' @rdname int_methods +#' @export +setMethod( + "colcount_format", "LayoutColLeaf", + function(obj) obj@columncount_format +) + + + #' @rdname int_methods #' @export setGeneric( @@ -2401,6 +2914,56 @@ setMethod( } ) +## It'd probably be better if this had the full set of methods as above +## but its not currently modelled in the class and probably isn't needed +## super much +#' @rdname int_methods +#' @export +setGeneric("colcount_na_str", function(obj) standardGeneric("colcount_na_str")) + +#' @rdname int_methods +#' @export +setMethod( + "colcount_na_str", "InstantiatedColumnInfo", + function(obj) obj@columncount_na_str +) + +#' @rdname int_methods +#' @export +setMethod( + "colcount_na_str", "VTableNodeInfo", + function(obj) colcount_na_str(col_info(obj)) +) + +#' @rdname int_methods +#' @export +setGeneric( + "colcount_na_str<-", + function(obj, value) standardGeneric("colcount_na_str<-") +) + +#' @export +#' @rdname int_methods +setMethod( + "colcount_na_str<-", "InstantiatedColumnInfo", + function(obj, value) { + obj@columncount_na_str <- value + obj + } +) + +#' @rdname int_methods +#' @export +setMethod( + "colcount_na_str<-", "VTableNodeInfo", + function(obj, value) { + cinfo <- col_info(obj) + colcount_na_str(cinfo) <- value + col_info(obj) <- cinfo + obj + } +) + #' Exported for use in `tern` #' #' Does the `table`/`row`/`InstantiatedColumnInfo` object contain no column structure information? diff --git a/R/tt_compatibility.R b/R/tt_compatibility.R index 85959a126..da9998ec6 100644 --- a/R/tt_compatibility.R +++ b/R/tt_compatibility.R @@ -384,6 +384,7 @@ only_first_annot <- function(all_annots) { #' @aliases rbind #' @export rbindl_rtables <- function(x, gap = lifecycle::deprecated(), check_headers = lifecycle::deprecated()) { + ## nocov start if (lifecycle::is_present(gap)) { lifecycle::deprecate_warn( when = "0.3.2", @@ -396,6 +397,7 @@ rbindl_rtables <- function(x, gap = lifecycle::deprecated(), check_headers = lif what = "rbindl_rtables(check_headers)" ) } + ## nocov end firstcols <- col_info(x[[1]]) i <- 1 @@ -543,22 +545,108 @@ setMethod( } ) -combine_cinfo <- function(..., new_total = NULL) { +EmptyTreePos <- TreePos() + +## this is painful to do right but we were doing it wrong +## before and it now matters because count display information +## is in the tree which means all points in the structure +## must be pathable, which they aren't if siblings have +## identical names +fix_col_nm_recursive <- function(ct, newname, rename_obj = TRUE, oldnm) { + if (rename_obj) { + obj_name(ct) <- newname + } + if (is(ct, "LayoutColTree")) { + kids <- tree_children(ct) + kidnms <- names(kids) + newkids <- lapply(kids, fix_col_nm_recursive, + newname = newname, + rename_obj = FALSE, + oldnm = oldnm + ) + names(newkids) <- kidnms + tree_children(ct) <- newkids + } + mypos <- tree_pos(ct) + if (!identical(mypos, EmptyTreePos)) { + spls <- pos_splits(mypos) + firstspl <- spls[[1]] + if (obj_name(firstspl) == oldnm) { + obj_name(firstspl) <- newname + spls[[1]] <- firstspl + pos_splits(mypos) <- spls + tree_pos(ct) <- mypos + } + } + if (!rename_obj) { + spls <- pos_splits(mypos) + splvals <- pos_splvals(mypos) + pos_splits(mypos) <- c( + list(AllSplit(split_name = newname)), + spls + ) + pos_splvals(mypos) <- c( + list(SplitValue(NA_character_, + sub_expr = quote(TRUE) + )), + splvals + ) + tree_pos(ct) <- mypos + } + ct +} + +fix_nms <- function(ct) { + if (is(ct, "LayoutColLeaf")) { + return(ct) + } + kids <- lapply(tree_children(ct), fix_nms) + names(kids) <- vapply(kids, obj_name, "") + tree_children(ct) <- kids + ct +} + +make_cbind_names <- function(num, tokens) { + cbind_tokens <- grep("^(new_)*cbind_tbl", tokens, value = TRUE) + ret <- paste0("cbind_tbl_", seq_len(num)) + if (length(cbind_tokens) == 0) { + return(ret) + } + oldprefixes <- gsub("cbind_tbl.*", "", cbind_tokens) + oldprefix <- oldprefixes[which.max(nchar(oldprefixes))] + paste0("new_", oldprefix, ret) +} + +combine_cinfo <- function(..., new_total = NULL, sync_count_vis) { tabs <- list(...) chk_cbindable_many(tabs) cinfs <- lapply(tabs, col_info) stopifnot(are(cinfs, "InstantiatedColumnInfo")) ctrees <- lapply(cinfs, coltree) - - newctree <- LayoutColTree(kids = ctrees) + oldnms <- nms <- vapply(ctrees, obj_name, "") + path_els <- unique(unlist(lapply(ctrees, col_paths), recursive = TRUE)) + nms <- make_cbind_names(num = length(oldnms), tokens = path_els) + + ctrees <- mapply(function(ct, nm, oldnm) { + ct <- fix_col_nm_recursive(ct, nm, rename_obj = TRUE, oldnm = "") # oldnm) + ct + }, ct = ctrees, nm = nms, oldnm = oldnms, SIMPLIFY = FALSE) + names(ctrees) <- nms + + newctree <- LayoutColTree(kids = ctrees, colcount = NA_integer_, name = "cbind_root") + newctree <- fix_nms(newctree) newcounts <- unlist(lapply(cinfs, col_counts)) if (is.null(new_total)) { new_total <- sum(newcounts) } newexprs <- unlist(lapply(cinfs, col_exprs), recursive = FALSE) newexargs <- unlist(lapply(cinfs, col_extra_args), recursive = FALSE) %||% vector("list", length(newcounts)) - newdisp <- any(vapply(cinfs, disp_ccounts, NA)) + if (!sync_count_vis) { + newdisp <- NA + } else { + newdisp <- any(vapply(cinfs, disp_ccounts, NA)) + } alltls <- lapply(cinfs, top_left) newtl <- character() if (!are(tabs, "TableRow")) { @@ -662,6 +750,10 @@ chk_cbindable_many <- function(lst) { #' #' @param x (`TableTree` or `TableRow`)\cr a table or row object. #' @param ... one or more further objects of the same class as `x`. +#' @param sync_count_vis (`logical(1)`)\cr should column count +#' visibility be synced across the new and existing columns. +#' Currently defaults to `TRUE` for backwards compatibility but +#' this may change in future releases. #' #' @inherit rbindl_rtables return #' @@ -680,9 +772,9 @@ chk_cbindable_many <- function(lst) { #' col_paths_summary(t2) #' #' @export -cbind_rtables <- function(x, ...) { +cbind_rtables <- function(x, ..., sync_count_vis = TRUE) { lst <- list(...) - newcinfo <- combine_cinfo(x, ...) + newcinfo <- combine_cinfo(x, ..., sync_count_vis = sync_count_vis) recurse_cbindl(x, cinfo = newcinfo, .list = lst) } diff --git a/R/tt_dotabulation.R b/R/tt_dotabulation.R index 64bd620b7..04a49373b 100644 --- a/R/tt_dotabulation.R +++ b/R/tt_dotabulation.R @@ -1133,8 +1133,9 @@ recursive_applysplit <- function(df, #' @inheritParams gen_args #' @inheritParams lyt_args #' @param col_counts (`numeric` or `NULL`)\cr `r lifecycle::badge("deprecated")` if non-`NULL`, column counts -#' which override those calculated automatically during tabulation. Must specify "counts" for *all* -#' resulting columns if non-`NULL`. `NA` elements will be replaced with the automatically calculated counts. +#' *for leaf-columns only* which override those calculated automatically during tabulation. Must specify +#' "counts" for *all* leaf-columns if non-`NULL`. `NA` elements will be replaced with the automatically +#' calculated counts. Turns on display of leaf-column counts when non-`NULL`. #' @param col_total (`integer(1)`)\cr the total observations across all columns. Defaults to `nrow(df)`. #' @param ... ignored. #' @@ -1240,7 +1241,7 @@ build_table <- function(lyt, df, if (any(alt_params) && is.null(alt_counts_df)) { stop( "Layout contains afun/cfun functions that have optional parameters ", - ".alt_df and/or .alt_df_row, but no alt_count_df was provided in ", + ".alt_df and/or .alt_df_row, but no alt_counts_df was provided in ", "build_table()." ) } @@ -1253,7 +1254,14 @@ build_table <- function(lyt, df, topleft ) if (!is.null(col_counts)) { - disp_ccounts(cinfo) <- TRUE + toreplace <- !is.na(col_counts) + newccs <- col_counts(cinfo) ## old actual counts + newccs[toreplace] <- col_counts[toreplace] + col_counts(cinfo) <- newccs + leaf_paths <- col_paths(cinfo) + for (pth in leaf_paths) { + colcount_visible(cinfo, pth) <- TRUE + } } rlyt <- rlayout(lyt) rtspl <- root_spl(rlyt) @@ -1551,7 +1559,9 @@ setMethod( splitvec_to_coltree <- function(df, splvec, pos = NULL, lvl = 1L, label = "", - spl_context = context_df_row(cinfo = NULL)) { + spl_context = context_df_row(cinfo = NULL), + alt_counts_df = df, + global_cc_format) { stopifnot( lvl <= length(splvec) + 1L, is(splvec, "SplitVector") @@ -1561,15 +1571,20 @@ splitvec_to_coltree <- function(df, splvec, pos = NULL, if (lvl == length(splvec) + 1L) { ## XXX this should be a LayoutColree I Think. nm <- unlist(tail(value_names(pos), 1)) %||% "" + spl <- tail(pos_splits(pos), 1)[[1]] + fmt <- colcount_format(spl) %||% global_cc_format LayoutColLeaf( lev = lvl - 1L, label = label, tpos = pos, - name = nm + name = nm, + colcount = NROW(alt_counts_df), + disp_ccounts = disp_ccounts(spl), + colcount_format = fmt ) } else { spl <- splvec[[lvl]] - nm <- if (is.null(pos)) { + nm <- if (is.null(pos) || length(pos_splits(pos)) == 0) { obj_name(spl) } else { unlist(tail( @@ -1585,7 +1600,7 @@ splitvec_to_coltree <- function(df, splvec, pos = NULL, vals <- rawpart[["values"]] labs <- rawpart[["labels"]] - + force(alt_counts_df) kids <- mapply( function(dfpart, value, partlab) { ## we could pass subset expression in here but the spec @@ -1599,21 +1614,48 @@ splitvec_to_coltree <- function(df, splvec, pos = NULL, ## subset expressions handled inside make_child_pos, ## value is (optionally, for the moment) carrying it around newpos <- make_child_pos(pos, spl, value, partlab) + acdf_subset_expr <- make_subset_expr(spl, value) + new_acdf_subset <- try(eval(acdf_subset_expr, alt_counts_df), silent = TRUE) + if (is(new_acdf_subset, "try-error")) { + stop(sprintf( + paste( + ifelse(identical(df, alt_counts_df), "df", "alt_counts_df"), + "appears incompatible with column-split", + "structure. Offending column subset", + "expression: %s\nOriginal error", + "message: %s" + ), deparse(acdf_subset_expr[[1]]), + conditionMessage(attr(new_acdf_subset, "condition")) + )) + } + splitvec_to_coltree(dfpart, splvec, newpos, lvl + 1L, partlab, - spl_context = rbind(spl_context, newprev) + spl_context = rbind(spl_context, newprev), + alt_counts_df = alt_counts_df[new_acdf_subset, , drop = FALSE], + global_cc_format = global_cc_format ) }, dfpart = datparts, value = vals, partlab = labs, SIMPLIFY = FALSE ) + disp_cc <- FALSE + cc_format <- global_cc_format # this doesn't matter probably, but its technically more correct + if (lvl > 1) { + disp_cc <- disp_ccounts(splvec[[lvl - 1]]) + cc_format <- colcount_format(splvec[[lvl - 1]]) %||% global_cc_format + } + names(kids) <- value_names(vals) LayoutColTree( lev = lvl, label = label, spl = spl, kids = kids, tpos = pos, name = nm, - summary_function = content_fun(spl) + summary_function = content_fun(spl), + colcount = NROW(alt_counts_df), + disp_ccounts = disp_cc, + colcount_format = cc_format ) } } diff --git a/R/tt_export.R b/R/tt_export.R index 6583f73cc..354d36080 100644 --- a/R/tt_export.R +++ b/R/tt_export.R @@ -853,14 +853,15 @@ tt_to_flextable <- function(tt, # Header addition -> NB: here we have a problem with (N=xx) hdr <- body[seq_len(hnum), , drop = FALSE] - # IMPORTANT: Fix of (N=xx) which is by default on a new line but we usually do not - # want this, and it depends on the size of the table, it is not another - # row with different columns -> All of this should be fixed at source (in toString) + # XXX NOT NECESSARY change of (N=xx) which is by default on a new line but we do not + # want this in docx, and it depends on the size of the table, it is not another + # row with different columns -> All of this should be fixed at source (in matrix_form) + # See .tbl_header_mat for this change if (hnum > 1) { # otherwise nothing to do det_nclab <- apply(hdr, 2, grepl, pattern = "\\(N=[0-9]+\\)$") has_nclab <- apply(det_nclab, 1, any) - if (isFALSE(counts_in_newline) && any(has_nclab)) { - whsnc <- which(has_nclab) # which rows have it + whsnc <- which(has_nclab) # which rows have it -> more than one is not supported + if (isFALSE(counts_in_newline) && any(has_nclab) && length(whsnc) == 1L) { what_is_nclab <- det_nclab[whsnc, ] # condition for popping the interested row by merging the upper one diff --git a/R/tt_paginate.R b/R/tt_paginate.R index d3f3ff81e..ac7caa6a7 100644 --- a/R/tt_paginate.R +++ b/R/tt_paginate.R @@ -143,7 +143,12 @@ col_dfrow <- function(col, nsibs = NA_integer_, leaf_indices = cnum, span = length(leaf_indices), - col_fnotes = list()) { + col_fnotes = list(), + col_count = facet_colcount(col, NULL), + ccount_visible = disp_ccounts(col), + ccount_format = colcount_format(col), + ccount_na_str, + global_cc_format) { if (is.null(pth)) { pth <- pos_to_path(tree_pos(col)) } @@ -158,7 +163,11 @@ col_dfrow <- function(col, leaf_indices = I(list(leaf_indices)), total_span = span, col_fnotes = I(list(col_fnotes)), - n_col_fnotes = length(col_fnotes) + n_col_fnotes = length(col_fnotes), + col_count = col_count, + ccount_visible = ccount_visible, + ccount_format = ccount_format %||% global_cc_format, + ccount_na_str = ccount_na_str ) } @@ -168,11 +177,13 @@ pos_to_path <- function(pos) { path <- character() for (i in seq_along(spls)) { + nm <- obj_name(spls[[i]]) + val_i <- value_names(vals[[i]]) path <- c( path, obj_name(spls[[i]]), ## rawvalues(vals[[i]])) - value_names(vals[[i]]) + if (!is.na(val_i)) val_i ) } path @@ -439,7 +450,9 @@ setGeneric("inner_col_df", function(ct, colnum = 0L, sibpos = NA_integer_, nsibs = NA_integer_, - ncolref = 0L) { + ncolref = 0L, + na_str, + global_cc_format) { standardGeneric("inner_col_df") }) @@ -449,19 +462,25 @@ setGeneric("inner_col_df", function(ct, #' `data.frame`. #' #' @inheritParams formatters::make_row_df -#' +#' @param ccount_format (`FormatSpec`)\cr The format to be used by default for +#' column counts if one is not specified for an individual column count. +#' @param na_str (`character(1)`)\cr The string to display when a column count is NA. Users should not need to set this. #' @export make_col_df <- function(tt, colwidths = NULL, - visible_only = TRUE) { - ctree <- coltree(tt) ## this is a null op if its already a coltree object + visible_only = TRUE, + na_str = "", + ccount_format = colcount_format(tt) %||% "(N=xx)") { + ctree <- coltree(tt, ccount_format = colcount_format(tt)) ## this is a null op if its already a coltree object rows <- inner_col_df(ctree, ## colwidths is currently unused anyway... propose_column_widths(matrix_form(tt, indent_rownames=TRUE)), colwidths = colwidths, visible_only = visible_only, colnum = 1L, sibpos = 1L, - nsibs = 1L + nsibs = 1L, + na_str = na_str, + global_cc_format = ccount_format ) ## nsiblings includes current so 1 means "only child" do.call(rbind, rows) @@ -472,14 +491,18 @@ setMethod( function(ct, colwidths, visible_only, colnum, sibpos, - nsibs) { + nsibs, + na_str, + global_cc_format) { list(col_dfrow( col = ct, cnum = colnum, sibpos = sibpos, nsibs = nsibs, leaf_indices = colnum, - col_fnotes = col_footnotes(ct) + col_fnotes = col_footnotes(ct), + ccount_na_str = na_str, + global_cc_format = global_cc_format )) } ) @@ -489,7 +512,9 @@ setMethod( function(ct, colwidths, visible_only, colnum, sibpos, - nsibs) { + nsibs, + na_str, + global_cc_format) { kids <- tree_children(ct) ret <- vector("list", length(kids)) for (i in seq_along(kids)) { @@ -500,7 +525,9 @@ setMethod( colnum = colnum, sibpos = i, nsibs = length(kids), - visible_only = visible_only + visible_only = visible_only, + na_str = na_str, + global_cc_format = global_cc_format ) ) colnum <- max(newrows$abs_pos, colnum, na.rm = TRUE) + 1 @@ -518,7 +545,9 @@ setMethod( sibpos = sibpos, nsibs = nsibs, pth = thispth, - col_fnotes = col_footnotes(ct) + col_fnotes = col_footnotes(ct), + ccount_na_str = na_str, + global_cc_format = global_cc_format )) ret <- c(thisone, ret) } diff --git a/R/tt_showmethods.R b/R/tt_showmethods.R index ff37df50e..a0b305454 100644 --- a/R/tt_showmethods.R +++ b/R/tt_showmethods.R @@ -156,6 +156,56 @@ setMethod( } ) + +#' Display column tree structure +#' +#' Displays the tree structure of the columns of a +#' table or column structure object. +#' +#' @inheritParams gen_args +#' +#' @return Nothing, called for its side effect of displaying +#' a summary to the terminal. +#' +#' @examples +#' lyt <- basic_table() %>% +#' split_cols_by("ARM") %>% +#' split_cols_by("STRATA1") %>% +#' split_cols_by("SEX", nested = FALSE) %>% +#' analyze("AGE") +#' +#' tbl <- build_table(lyt, ex_adsl) +#' coltree_structure(tbl) +#' @export +coltree_structure <- function(obj) { + ctree <- coltree(obj) + cat(layoutmsg2(ctree)) +} + +lastposmsg <- function(pos) { + spls <- pos_splits(pos) + splvals <- value_names(pos_splvals(pos)) + indiv_msgs <- unlist(mapply(function(spl, valnm) paste(obj_name(spl), valnm, sep = ": "), + spl = spls, + valnm = splvals, + SIMPLIFY = FALSE + )) + paste(indiv_msgs, collapse = " -> ") +} + +layoutmsg2 <- function(obj, level = 1) { + nm <- obj_name(obj) + pos <- tree_pos(obj) + nopos <- identical(pos, EmptyTreePos) + + msg <- paste0(strrep(" ", times = 2 * (level - 1)), "[", nm, "] (", if (nopos) "no pos" else lastposmsg(pos), ")\n") + if (is(obj, "LayoutAxisTree")) { + kids <- tree_children(obj) + msg <- c(msg, unlist(lapply(kids, layoutmsg2, level = level + 1))) + } + msg +} + setGeneric("spltype_abbrev", function(obj) standardGeneric("spltype_abbrev")) setMethod( diff --git a/R/tt_sort.R b/R/tt_sort.R index b6d8cace7..cf8607490 100644 --- a/R/tt_sort.R +++ b/R/tt_sort.R @@ -23,7 +23,8 @@ cont_n_allcols <- function(tt) { #' @param j (`numeric(1)`)\cr index of column used for scoring. #' #' @seealso For examples and details, please read the documentation for [sort_at_path()] and the -#' [Sorting and Pruning](https://insightsengineering.github.io/rtables/main/articles/sorting_pruning.html) vignette. +#' [Sorting and Pruning](https://insightsengineering.github.io/rtables/latest-tag/articles/sorting_pruning.html) +#' vignette. #' #' @export #' @rdname score_funs @@ -79,7 +80,8 @@ cont_n_onecol <- function(j) { #' [table_structure()]. #' #' Note that sorting needs a deeper understanding of table structure in `rtables`. Please consider reading the related -#' vignette ([Sorting and Pruning](https://insightsengineering.github.io/rtables/main/articles/sorting_pruning.html)) +#' vignette +#' ([Sorting and Pruning](https://insightsengineering.github.io/rtables/latest-tag/articles/sorting_pruning.html)) #' and explore table structure with useful functions like [table_structure()] and [row_paths_summary()]. It is also #' very important to understand the difference between "content" rows and "data" rows. The first one analyzes and #' describes the split variable generally and is generated with [summarize_row_groups()], while the second one is diff --git a/R/tt_toString.R b/R/tt_toString.R index 9a3a03173..4a5d7c9fb 100644 --- a/R/tt_toString.R +++ b/R/tt_toString.R @@ -150,10 +150,12 @@ table_shell_str <- function(tt, widths = NULL, col_gap = 3, hsep = default_hsep( #' has indented row names (strings pre-fixed). #' @param expand_newlines (`flag`)\cr whether the matrix form generated should expand rows whose values contain #' newlines into multiple 'physical' rows (as they will appear when rendered into ASCII). Defaults to `TRUE`. -#' @param fontspec (`font_spec` or `NULL`)\cr Font specification that should be -#' assumed during wrapping, as returned by [formatters::font_spec()]. -#' @param col_gap (`numeric(1)`)\cr The column gap to assume between columns, in -#' number of spaces assuming `fontspec` (this reduces to number of characters for monospace fonts). +#' @param fontspec (`font_spec`)\cr The font that should be used by default when +#' rendering this `MatrixPrintForm` object, or NULL (the default). +#' @param col_gap (`numeric(1)`)]\cr The number of spaces (in the font specified +#' by `fontspec`) that should be placed between columns when the table +#' is rendered directly to text (e.g., by `toString` or `export_as_txt`). Defaults +#' to `3`. #' #' @details #' The strings in the return object are defined as follows: row labels are those determined by `make_row_df` and cell @@ -203,6 +205,7 @@ setMethod( fontspec = NULL, col_gap = 3L) { stopifnot(is(obj, "VTableTree")) + check_ccount_vis_ok(obj) header_content <- .tbl_header_mat(obj) # first col are for row.names sr <- make_row_df(obj, fontspec = fontspec) @@ -328,6 +331,36 @@ setMethod( } ) + +check_ccount_vis_ok <- function(tt) { + ctree <- coltree(tt) + tlkids <- tree_children(ctree) + lapply(tlkids, ccvis_check_subtree) + invisible(NULL) +} + +ccvis_check_subtree <- function(ctree) { + kids <- tree_children(ctree) + if (is.null(kids)) { + return(invisible(NULL)) + } + vals <- vapply(kids, disp_ccounts, TRUE) + if (length(unique(vals)) > 1) { + unmatch <- which(!duplicated(vals))[1:2] + stop( + "Detected different colcount visibility among sibling facets (those ", + "arising from the same split_cols_by* layout instruction). This is ", + "not supported.\n", + "Set count values to NA if you want a blank space to appear as the ", + "displayed count for particular facets.\n", + "First disagreement occured at paths:\n", + .path_to_disp(pos_to_path(tree_pos(kids[[unmatch[1]]]))), "\n", + .path_to_disp(pos_to_path(tree_pos(kids[[unmatch[2]]]))) + ) + } + lapply(kids, ccvis_check_subtree) + invisible(NULL) +} .quick_handle_nl <- function(str_v) { if (any(grepl("\n", str_v))) { return(unlist(strsplit(str_v, "\n", fixed = TRUE))) @@ -442,7 +475,12 @@ get_formatted_fnotes <- function(tt) { remain <- seq_len(nrow(coldf)) chunks <- list() cur <- 1 + na_str <- colcount_na_str(tt) + ## XXX this would be better as the facet-associated + ## format but I don't know that we need to + ## support that level of differentiation anyway... + cc_format <- colcount_format(tt) ## each iteration of this loop identifies ## all rows corresponding to one top-level column ## label and its children, then processes those @@ -453,7 +491,9 @@ get_formatted_fnotes <- function(tt) { endblock <- which(coldf$abs_pos == max(inds)) stopifnot(endblock >= rw) - chunks[[cur]] <- .do_header_chunk(coldf[rw:endblock, ]) + chunk_res <- .do_header_chunk(coldf[rw:endblock, ], cc_format, na_str = na_str) + chunk_res <- unlist(chunk_res, recursive = FALSE) + chunks[[cur]] <- chunk_res remain <- remain[remain > endblock] cur <- cur + 1 } @@ -483,23 +523,22 @@ get_formatted_fnotes <- function(tt) { return(chunks) } - chunks[needpad] <- lapply( - chunks[needpad], - function(chk) { + for (i in seq_along(lens)) { + if (lens[i] < padto) { + chk <- chunks[[i]] span <- sum(vapply(chk[[length(chk)]], cell_cspan, 1L)) - needed <- padto - length(chk) - c( - replicate(rcell("", colspan = span), - n = needed + chunks[[i]] <- c( + replicate(list(list(rcell("", colspan = span))), + n = padto - lens[i] ), chk ) } - ) + } chunks } -.do_header_chunk <- function(coldf) { +.do_header_chunk <- function(coldf, cc_format, na_str) { ## hard assumption that coldf is a section ## of a column dataframe summary that was ## created with visible_only=FALSE @@ -510,20 +549,54 @@ get_formatted_fnotes <- function(tt) { seq_along(spldfs), function(i) { rws <- spldfs[[i]] - - thisbit <- lapply( + thisbit_vals <- lapply( seq_len(nrow(rws)), function(ri) { - rcell(rws[ri, "label", drop = TRUE], + cellii <- rcell(rws[ri, "label", drop = TRUE], colspan = rws$total_span[ri], footnotes = rws[ri, "col_fnotes", drop = TRUE][[1]] ) + cellii } ) - .pad_end(thisbit, nleafcols) + ret <- list(.pad_end(thisbit_vals, padto = nleafcols)) + anycounts <- any(rws$ccount_visible) + if (anycounts) { + thisbit_ns <- lapply( + seq_len(nrow(rws)), + function(ri) { + vis_ri <- rws$ccount_visible[ri] + val <- if (vis_ri) rws$col_count[ri] else NULL + fmt <- rws$ccount_format[ri] + if (is.character(fmt)) { + cfmt_dim <- names(which(sapply(formatters::list_valid_format_labels(), function(x) any(x == fmt)))) + if (cfmt_dim == "2d") { + if (grepl("%", fmt)) { + val <- c(val, 1) ## XXX This is the old behavior but it doesn't take into account parent counts... + } else { + stop( + "This 2d format is not supported for column counts. ", + "Please choose a 1d format or a 2d format that includes a % value." + ) + } + } else if (cfmt_dim == "3d") { + stop("3d formats are not supported for column counts.") + } + } + cellii <- rcell( + val, + colspan = rws$total_span[ri], + format = fmt, # cc_format, + format_na_str = na_str + ) + cellii + } + ) + ret <- c(ret, list(.pad_end(thisbit_ns, padto = nleafcols))) + } + ret } ) - toret } @@ -534,8 +607,8 @@ get_formatted_fnotes <- function(tt) { nc <- ncol(tt) body <- matrix(rapply(rows, function(x) { cs <- row_cspans(x) - if (is.null(cs)) cs <- rep(1, ncol(x)) - rep(row_values(x), cs) + strs <- get_formatted_cells(x) + strs }), ncol = nc, byrow = TRUE) span <- matrix(rapply(rows, function(x) { @@ -551,34 +624,6 @@ get_formatted_fnotes <- function(tt) { }) ) - if (disp_ccounts(cinfo)) { - counts <- col_counts(cinfo) - cformat <- colcount_format(cinfo) - - # allow 2d column count formats (count (%) only) - cfmt_dim <- names(which(sapply(formatters::list_valid_format_labels(), function(x) any(x == cformat)))) - if (cfmt_dim == "2d") { - if (grepl("%", cformat)) { - counts <- lapply(counts, function(x) c(x, 1)) - } else { - stop( - "This 2d format is not supported for column counts. ", - "Please choose a 1d format or a 2d format that includes a % value." - ) - } - } else if (cfmt_dim == "3d") { - stop("3d formats are not supported for column counts.") - } - - body <- rbind(body, vapply(counts, format_rcell, - character(1), - format = cformat, - na_str = "" - )) - span <- rbind(span, rep(1, nc)) - fnote <- rbind(fnote, rep(list(list()), nc)) - } - tl <- top_left(cinfo) lentl <- length(tl) nli <- nrow(body) diff --git a/_pkgdown.yml b/_pkgdown.yml index 52ae63cef..396a98b42 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -71,6 +71,7 @@ articles: - custom_appearance - title_footer - sorting_pruning + - col_counts - title: \{rtables\} Concepts contents: @@ -184,6 +185,7 @@ reference: - title: Layout Structure Information contents: - vars_in_layout + - coltree_structure - title: Access and Modify contents: @@ -196,6 +198,10 @@ reference: - clear_indent_mods - head - section_div + - colcount_visible + - facet_colcount + - facet_colcounts_visible<- + - rm_all_colcounts - title: Validating and Fixing Table Structure contents: diff --git a/inst/WORDLIST b/inst/WORDLIST index d929f7c6f..3f73ecc58 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,39 +1,11 @@ +amongst Bové -CRAN's Carreras +charset Cheatsheet Chohan -FFFL -Godwin -Heng -Hoffmann -Kelkhoff -Layouting -Lewandowski -Maximo -Modelling -NSE -Paszty -Pharma -Phuse -Pre -Qi -RStudio -Resync -Rua -STUDYID -Sabanés -Saibah -Stoilova -Subtable -Subtables -Tadeusz -Unstratified -ValueWrapper -Yung -amongst -charset combinatorial +CRAN's customizations de decrementing @@ -42,47 +14,80 @@ dplyr emph facetted facetting +FFFL flextable formatter -formatters +forseeable funder getter getters +Godwin +Heng +Hoffmann ing initializer iteratively +Kelkhoff labelled +Layouting layouting +Lewandowski mandatorily +Maximo +Modelling monospace multivariable +NSE orderable +Paszty pathing +Pharma +Phuse postfix postprocessing +Pre pre priori programmatically +Qi +quartiles reindexed repo repped responder +Resync reusability roadmap +RStudio +rtables +Rua +Sabanés +Saibah sortable spl +Stoilova +STUDYID subsplits +Subtable subtable subtable's +Subtables subtables summarization tableone +Tadeusz todo +traversable truetype unaggregated unicode univariable unpruned +Unstratified unstratified useR +ValueWrapper +visibilty +visiblities xtable +Yung diff --git a/man/MultiVarSplit.Rd b/man/MultiVarSplit.Rd index 149ce8642..4cb050e3c 100644 --- a/man/MultiVarSplit.Rd +++ b/man/MultiVarSplit.Rd @@ -24,7 +24,9 @@ MultiVarSplit( label_pos = "visible", split_fun = NULL, page_prefix = NA_character_, - section_div = NA_character_ + section_div = NA_character_, + show_colcounts = FALSE, + colcount_format = NULL ) } \arguments{ @@ -84,6 +86,13 @@ the children of a split/table.} \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{show_colcounts}{(\code{logical(1)})\cr should column counts be displayed at the level +facets created by this split. Defaults to \code{FALSE}.} + +\item{colcount_format}{(\code{character(1)})\cr if \code{show_colcounts} is \code{TRUE}, the +format which should be used to display column counts for facets generated by +this split. Defaults to \code{"(N=xx)"}.} } \value{ A \code{MultiVarSplit} object. diff --git a/man/VarLevelSplit.Rd b/man/VarLevelSplit.Rd index 5a1233214..d48a1d0d7 100644 --- a/man/VarLevelSplit.Rd +++ b/man/VarLevelSplit.Rd @@ -27,7 +27,9 @@ VarLevelSplit( cvar = "", cextra_args = list(), page_prefix = NA_character_, - section_div = NA_character_ + section_div = NA_character_, + show_colcounts = FALSE, + colcount_format = NULL ) VarLevWBaselineSplit( @@ -45,7 +47,9 @@ VarLevWBaselineSplit( split_na_str = NA_character_, valorder = NULL, split_name = var, - extra_args = list() + extra_args = list(), + show_colcounts = FALSE, + colcount_format = NULL ) } \arguments{ @@ -104,6 +108,13 @@ the children of a split/table.} \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{show_colcounts}{(\code{logical(1)})\cr should column counts be displayed at the level +facets created by this split. Defaults to \code{FALSE}.} + +\item{colcount_format}{(\code{character(1)})\cr if \code{show_colcounts} is \code{TRUE}, the +format which should be used to display column counts for facets generated by +this split. Defaults to \code{"(N=xx)"}.} + \item{ref_group}{(\code{character})\cr value of \code{var} to be taken as the \code{ref_group}/control to be compared against.} \item{label_fstr}{(\code{string})\cr a \code{sprintf} style format string. For non-comparison splits, it can contain up to diff --git a/man/basic_table.Rd b/man/basic_table.Rd index 2b087b5a4..eab53623b 100644 --- a/man/basic_table.Rd +++ b/man/basic_table.Rd @@ -9,7 +9,7 @@ basic_table( subtitles = character(), main_footer = character(), prov_footer = character(), - show_colcounts = FALSE, + show_colcounts = NA, colcount_format = "(N=xx)", header_section_div = NA_character_, top_level_section_div = NA_character_, @@ -28,11 +28,16 @@ printed on a separate line. Ignored for subtables.} \item{prov_footer}{(\code{character})\cr a vector of strings to use as provenance-related global footer materials (\code{\link[=prov_footer]{prov_footer()}}), where every element is printed on a separate line.} -\item{show_colcounts}{(\code{flag})\cr whether column counts should be displayed in the resulting table when this -layout is applied to data.} +\item{show_colcounts}{(\code{logical(1)})\cr Indicates whether the lowest level of +applied to data. \code{NA}, the default, indicates that the \code{show_colcounts} +argument(s) passed to the relevant calls to \verb{split_cols_by*} +functions. Non-missing values will override the behavior specified in +column splitting layout instructions which create the lowest level, or +leaf, columns.} \item{colcount_format}{(\code{string})\cr format for use when displaying the column counts. Must be 1d, or 2d -where one component is a percent. See Details below.} +where one component is a percent. This will also apply to any displayed higher +level column counts where an explicit format was not specified. Defaults to \code{"(N=xx)"}. See Details below.} \item{header_section_div}{(\code{string})\cr string which will be used to divide the header from the table. See \code{\link[=header_section_div]{header_section_div()}} for the associated getter and setter. Please consider changing last element of diff --git a/man/build_table.Rd b/man/build_table.Rd index 37869f8b0..2c8102bc7 100644 --- a/man/build_table.Rd +++ b/man/build_table.Rd @@ -24,8 +24,9 @@ build_table( \emph{only} when calculating column counts.} \item{col_counts}{(\code{numeric} or \code{NULL})\cr \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} if non-\code{NULL}, column counts -which override those calculated automatically during tabulation. Must specify "counts" for \emph{all} -resulting columns if non-\code{NULL}. \code{NA} elements will be replaced with the automatically calculated counts.} +\emph{for leaf-columns only} which override those calculated automatically during tabulation. Must specify +"counts" for \emph{all} leaf-columns if non-\code{NULL}. \code{NA} elements will be replaced with the automatically +calculated counts. Turns on display of leaf-column counts when non-\code{NULL}.} \item{col_total}{(\code{integer(1)})\cr the total observations across all columns. Defaults to \code{nrow(df)}.} diff --git a/man/cbind_rtables.Rd b/man/cbind_rtables.Rd index 4dbc7a6b0..160f5f0d2 100644 --- a/man/cbind_rtables.Rd +++ b/man/cbind_rtables.Rd @@ -4,12 +4,17 @@ \alias{cbind_rtables} \title{Column-bind two \code{TableTree} objects} \usage{ -cbind_rtables(x, ...) +cbind_rtables(x, ..., sync_count_vis = TRUE) } \arguments{ \item{x}{(\code{TableTree} or \code{TableRow})\cr a table or row object.} \item{...}{one or more further objects of the same class as \code{x}.} + +\item{sync_count_vis}{(\code{logical(1)})\cr should column count +visibility be synced across the new and existing columns. +Currently defaults to \code{TRUE} for backwards compatibility but +this may change in future releases.} } \value{ A formal table object. diff --git a/man/cinfo.Rd b/man/cinfo.Rd index e7c93554b..06a53bcc8 100644 --- a/man/cinfo.Rd +++ b/man/cinfo.Rd @@ -7,7 +7,7 @@ \title{Instantiated column info} \usage{ InstantiatedColumnInfo( - treelyt = LayoutColTree(), + treelyt = LayoutColTree(colcount = total_cnt), csubs = list(expression(TRUE)), extras = list(list()), cnts = NA_integer_, diff --git a/man/col_accessors.Rd b/man/col_accessors.Rd index 7ddebd48a..6ea99b4e8 100644 --- a/man/col_accessors.Rd +++ b/man/col_accessors.Rd @@ -62,19 +62,61 @@ col_info(obj) <- value \S4method{col_info}{TableTree}(obj) <- value -coltree(obj, df = NULL, rtpos = TreePos()) - -\S4method{coltree}{InstantiatedColumnInfo}(obj, df = NULL, rtpos = TreePos()) - -\S4method{coltree}{PreDataTableLayouts}(obj, df = NULL, rtpos = TreePos()) - -\S4method{coltree}{PreDataColLayout}(obj, df = NULL, rtpos = TreePos()) - -\S4method{coltree}{LayoutColTree}(obj, df = NULL, rtpos = TreePos()) - -\S4method{coltree}{VTableTree}(obj, df = NULL, rtpos = TreePos()) - -\S4method{coltree}{TableRow}(obj, df = NULL, rtpos = TreePos()) +coltree( + obj, + df = NULL, + rtpos = TreePos(), + alt_counts_df = df, + ccount_format = "(N=xx)" +) + +\S4method{coltree}{InstantiatedColumnInfo}( + obj, + df = NULL, + rtpos = TreePos(), + alt_counts_df = df, + ccount_format = "(N=xx)" +) + +\S4method{coltree}{PreDataTableLayouts}( + obj, + df = NULL, + rtpos = TreePos(), + alt_counts_df = df, + ccount_format = "(N=xx)" +) + +\S4method{coltree}{PreDataColLayout}( + obj, + df = NULL, + rtpos = TreePos(), + alt_counts_df = df, + ccount_format = "(N=xx)" +) + +\S4method{coltree}{LayoutColTree}( + obj, + df = NULL, + rtpos = TreePos(), + alt_counts_df = df, + ccount_format = "(N=xx)" +) + +\S4method{coltree}{VTableTree}( + obj, + df = NULL, + rtpos = TreePos(), + alt_counts_df = df, + ccount_format = "(N=xx)" +) + +\S4method{coltree}{TableRow}( + obj, + df = NULL, + rtpos = TreePos(), + alt_counts_df = df, + ccount_format = "(N=xx)" +) col_exprs(obj, df = NULL) @@ -120,6 +162,13 @@ generated from a pre-data layout object.} \item{rtpos}{(\code{TreePos})\cr root position.} +\item{alt_counts_df}{(\code{data.frame} or \code{tibble})\cr alternative full dataset the rtables framework will use +\emph{only} when calculating column counts.} + +\item{ccount_format}{(\code{FormatSpec})\cr The format to be used by default for column +counts throughout this column tree (i.e. if not overridden by a more specific format +specification).} + \item{path}{(\code{character} or \code{NULL})\cr \code{col_counts} accessor and setter only. Path (in column structure).} } @@ -131,3 +180,6 @@ Returns various information about columns, depending on the accessor used. \description{ Column information/structure accessors } +\seealso{ +\code{\link[=facet_colcount]{facet_colcount()}} +} diff --git a/man/colcount_visible.Rd b/man/colcount_visible.Rd new file mode 100644 index 000000000..4acb96937 --- /dev/null +++ b/man/colcount_visible.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tree_accessors.R +\name{colcount_visible} +\alias{colcount_visible} +\alias{colcount_visible,VTableTree-method} +\alias{colcount_visible,InstantiatedColumnInfo-method} +\alias{colcount_visible,LayoutColTree-method} +\alias{colcount_visible<-} +\alias{colcount_visible<-,VTableTree-method} +\alias{colcount_visible<-,InstantiatedColumnInfo-method} +\alias{colcount_visible<-,LayoutColTree-method} +\title{Value and Visibility of specific column counts by path} +\usage{ +colcount_visible(obj, path) + +\S4method{colcount_visible}{VTableTree}(obj, path) + +\S4method{colcount_visible}{InstantiatedColumnInfo}(obj, path) + +\S4method{colcount_visible}{LayoutColTree}(obj, path) + +colcount_visible(obj, path) <- value + +\S4method{colcount_visible}{VTableTree}(obj, path) <- value + +\S4method{colcount_visible}{InstantiatedColumnInfo}(obj, path) <- value + +\S4method{colcount_visible}{LayoutColTree}(obj, path) <- value +} +\arguments{ +\item{obj}{(\code{ANY})\cr the object for the accessor to access or modify.} + +\item{path}{(\code{character})\cr a vector path for a position within the structure of a \code{TableTree}. Each element +represents a subsequent choice amongst the children of the previous choice.} + +\item{value}{(\code{ANY})\cr the new value.} +} +\value{ +for \code{colcount_visible} a logical scalar +indicating whether the specified position in +the column hierarchy is set to display its column count; +for \verb{colcount_visible<-}, \code{obj} updated with +the specified count displaying behavior set. +} +\description{ +Value and Visibility of specific column counts by path +} +\note{ +Users generally should not call \code{colcount_visible} +directly, as setting sibling facets to have differing +column count visibility will result in an error when +printing or paginating the table. +} diff --git a/man/coltree_structure.Rd b/man/coltree_structure.Rd new file mode 100644 index 000000000..8a0e24950 --- /dev/null +++ b/man/coltree_structure.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tt_showmethods.R +\name{coltree_structure} +\alias{coltree_structure} +\title{Display column tree structure} +\usage{ +coltree_structure(obj) +} +\arguments{ +\item{obj}{(\code{ANY})\cr the object for the accessor to access or modify.} +} +\value{ +Nothing, called for its side effect of displaying +a summary to the terminal. +} +\description{ +Displays the tree structure of the columns of a +table or column structure object. +} +\examples{ +lyt <- basic_table() \%>\% + split_cols_by("ARM") \%>\% + split_cols_by("STRATA1") \%>\% + split_cols_by("SEX", nested = FALSE) \%>\% + analyze("AGE") + +tbl <- build_table(lyt, ex_adsl) +coltree_structure(tbl) +} diff --git a/man/cutsplits.Rd b/man/cutsplits.Rd index edf7de855..d22786cc6 100644 --- a/man/cutsplits.Rd +++ b/man/cutsplits.Rd @@ -29,7 +29,9 @@ make_static_cut_split( label_pos = "visible", cumulative = FALSE, page_prefix = NA_character_, - section_div = NA_character_ + section_div = NA_character_, + show_colcounts = FALSE, + colcount_format = NULL ) VarDynCutSplit( @@ -52,7 +54,9 @@ VarDynCutSplit( cextra_args = list(), label_pos = "visible", page_prefix = NA_character_, - section_div = NA_character_ + section_div = NA_character_, + show_colcounts = FALSE, + colcount_format = NULL ) } \arguments{ @@ -111,6 +115,13 @@ the children of a split/table.} \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{show_colcounts}{(\code{logical(1)})\cr should column counts be displayed at the level +facets created by this split. Defaults to \code{FALSE}.} + +\item{colcount_format}{(\code{character(1)})\cr if \code{show_colcounts} is \code{TRUE}, the +format which should be used to display column counts for facets generated by +this split. Defaults to \code{"(N=xx)"}.} + \item{cutfun}{(\code{function})\cr function which accepts the \emph{full vector} of \code{var} values and returns cut points to be used (via \code{cut}) when splitting data during tabulation.} diff --git a/man/facet_colcount.Rd b/man/facet_colcount.Rd new file mode 100644 index 000000000..f2d5c318c --- /dev/null +++ b/man/facet_colcount.Rd @@ -0,0 +1,92 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tree_accessors.R +\name{facet_colcount} +\alias{facet_colcount} +\alias{facet_colcount,LayoutColTree-method} +\alias{facet_colcount,LayoutColLeaf-method} +\alias{facet_colcount,VTableTree-method} +\alias{facet_colcount,InstantiatedColumnInfo-method} +\alias{facet_colcount<-} +\alias{facet_colcount<-,LayoutColTree-method} +\alias{facet_colcount<-,LayoutColLeaf-method} +\alias{facet_colcount<-,VTableTree-method} +\alias{facet_colcount<-,InstantiatedColumnInfo-method} +\title{Get or set column count for a facet in column space} +\usage{ +facet_colcount(obj, path) + +\S4method{facet_colcount}{LayoutColTree}(obj, path = NULL) + +\S4method{facet_colcount}{LayoutColLeaf}(obj, path = NULL) + +\S4method{facet_colcount}{VTableTree}(obj, path) + +\S4method{facet_colcount}{InstantiatedColumnInfo}(obj, path) + +facet_colcount(obj, path) <- value + +\S4method{facet_colcount}{LayoutColTree}(obj, path) <- value + +\S4method{facet_colcount}{LayoutColLeaf}(obj, path) <- value + +\S4method{facet_colcount}{VTableTree}(obj, path) <- value + +\S4method{facet_colcount}{InstantiatedColumnInfo}(obj, path) <- value +} +\arguments{ +\item{obj}{(\code{ANY})\cr the object for the accessor to access or modify.} + +\item{path}{character. This path must end on a +split value, e.g., the level of a categorical variable +that was split on in column space, but it need not +be the path to an individual column.} + +\item{value}{(\code{ANY})\cr the new value.} +} +\value{ +for \code{facet_colcount} the current count associated +with that facet in column space, for \verb{facet_colcount<-}, +\code{obj} modified with the new column count for the specified +facet. +} +\description{ +Get or set column count for a facet in column space +} +\note{ +Updating a lower-level (more specific) +column count manually \strong{will not} update the +counts for its parent facets. This cannot be made +automatic because the rtables framework does not +require sibling facets to be mutually exclusive +(e.g., total "arm", faceting into cumulative +quantiles, etc) and thus the count of a parent facet +will not always be simply the sum of the counts for +all of its children. +} +\examples{ +lyt <- basic_table() \%>\% + split_cols_by("ARM", show_colcounts = TRUE) \%>\% + split_cols_by("SEX", + split_fun = keep_split_levels(c("F", "M")), + show_colcounts = TRUE + ) \%>\% + split_cols_by("STRATA1", show_colcounts = TRUE) \%>\% + analyze("AGE") + +tbl <- build_table(lyt, ex_adsl) + +facet_colcount(tbl, c("ARM", "A: Drug X")) +facet_colcount(tbl, c("ARM", "A: Drug X", "SEX", "F")) +facet_colcount(tbl, c("ARM", "A: Drug X", "SEX", "F", "STRATA1", "A")) + +## modify specific count after table creation +facet_colcount(tbl, c("ARM", "A: Drug X", "SEX", "F", "STRATA1", "A")) <- 25 + +## show black space for certain counts by assign NA + +facet_colcount(tbl, c("ARM", "A: Drug X", "SEX", "F", "STRATA1", "C")) <- NA + +} +\seealso{ +\code{\link[=col_counts]{col_counts()}} +} diff --git a/man/facet_colcounts_visible-set.Rd b/man/facet_colcounts_visible-set.Rd new file mode 100644 index 000000000..38ca94a7d --- /dev/null +++ b/man/facet_colcounts_visible-set.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tree_accessors.R +\name{facet_colcounts_visible<-} +\alias{facet_colcounts_visible<-} +\title{Set visibility of column counts for a group of sibling facets} +\usage{ +facet_colcounts_visible(obj, path) <- value +} +\arguments{ +\item{obj}{(\code{ANY})\cr the object for the accessor to access or modify.} + +\item{path}{(\code{character})\cr the path \emph{to the parent of the +desired siblings}. The last element in the path should +be a split name.} + +\item{value}{(\code{ANY})\cr the new value.} +} +\value{ +obj, modified with the desired column count. +display behavior +} +\description{ +Set visibility of column counts for a group of sibling facets +} +\seealso{ +\code{\link[=colcount_visible]{colcount_visible()}} +} diff --git a/man/int_methods.Rd b/man/int_methods.Rd index 0407afafe..d62765a9a 100644 --- a/man/int_methods.Rd +++ b/man/int_methods.Rd @@ -80,13 +80,21 @@ \alias{tree_pos,VLayoutNode-method} \alias{pos_subset} \alias{pos_subset,TreePos-method} +\alias{tree_pos<-} +\alias{tree_pos<-,VLayoutNode-method} \alias{pos_subset,VLayoutNode-method} \alias{pos_splits} \alias{pos_splits,TreePos-method} \alias{pos_splits,VLayoutNode-method} +\alias{pos_splits<-} +\alias{pos_splits<-,TreePos-method} +\alias{pos_splits<-,VLayoutNode-method} \alias{pos_splvals} \alias{pos_splvals,TreePos-method} \alias{pos_splvals,VLayoutNode-method} +\alias{pos_splvals<-} +\alias{pos_splvals<-,TreePos-method} +\alias{pos_splvals<-,VLayoutNode-method} \alias{pos_splval_labels} \alias{pos_splval_labels,TreePos-method} \alias{spl_payload} @@ -273,22 +281,36 @@ \alias{disp_ccounts,InstantiatedColumnInfo-method} \alias{disp_ccounts,PreDataTableLayouts-method} \alias{disp_ccounts,PreDataColLayout-method} +\alias{disp_ccounts,LayoutColTree-method} +\alias{disp_ccounts,LayoutColLeaf-method} +\alias{disp_ccounts,Split-method} \alias{disp_ccounts<-} \alias{disp_ccounts<-,VTableTree-method} \alias{disp_ccounts<-,InstantiatedColumnInfo-method} \alias{disp_ccounts<-,PreDataColLayout-method} \alias{disp_ccounts<-,LayoutColTree-method} +\alias{disp_ccounts<-,LayoutColLeaf-method} \alias{disp_ccounts<-,PreDataTableLayouts-method} +\alias{coltree_at_path} \alias{colcount_format} \alias{colcount_format,InstantiatedColumnInfo-method} \alias{colcount_format,VTableNodeInfo-method} \alias{colcount_format,PreDataColLayout-method} \alias{colcount_format,PreDataTableLayouts-method} +\alias{colcount_format,Split-method} +\alias{colcount_format,LayoutColTree-method} +\alias{colcount_format,LayoutColLeaf-method} \alias{colcount_format<-} \alias{colcount_format<-,InstantiatedColumnInfo-method} \alias{colcount_format<-,VTableNodeInfo-method} \alias{colcount_format<-,PreDataColLayout-method} \alias{colcount_format<-,PreDataTableLayouts-method} +\alias{colcount_na_str} +\alias{colcount_na_str,InstantiatedColumnInfo-method} +\alias{colcount_na_str,VTableNodeInfo-method} +\alias{colcount_na_str<-} +\alias{colcount_na_str<-,InstantiatedColumnInfo-method} +\alias{colcount_na_str<-,VTableNodeInfo-method} \alias{as.vector,TableRow-method} \alias{as.vector,ElementaryTable-method} \alias{spl_cuts} @@ -554,6 +576,10 @@ pos_subset(obj) \S4method{pos_subset}{TreePos}(obj) +tree_pos(obj) <- value + +\S4method{tree_pos}{VLayoutNode}(obj) <- value + \S4method{pos_subset}{VLayoutNode}(obj) pos_splits(obj) @@ -562,12 +588,24 @@ pos_splits(obj) \S4method{pos_splits}{VLayoutNode}(obj) +pos_splits(obj) <- value + +\S4method{pos_splits}{TreePos}(obj) <- value + +\S4method{pos_splits}{VLayoutNode}(obj) <- value + pos_splvals(obj) \S4method{pos_splvals}{TreePos}(obj) \S4method{pos_splvals}{VLayoutNode}(obj) +pos_splvals(obj) <- value + +\S4method{pos_splvals}{TreePos}(obj) <- value + +\S4method{pos_splvals}{VLayoutNode}(obj) <- value + pos_splval_labels(obj) \S4method{pos_splval_labels}{TreePos}(obj) @@ -940,6 +978,12 @@ disp_ccounts(obj) \S4method{disp_ccounts}{PreDataColLayout}(obj) +\S4method{disp_ccounts}{LayoutColTree}(obj) + +\S4method{disp_ccounts}{LayoutColLeaf}(obj) + +\S4method{disp_ccounts}{Split}(obj) + disp_ccounts(obj) <- value \S4method{disp_ccounts}{VTableTree}(obj) <- value @@ -950,8 +994,12 @@ disp_ccounts(obj) <- value \S4method{disp_ccounts}{LayoutColTree}(obj) <- value +\S4method{disp_ccounts}{LayoutColLeaf}(obj) <- value + \S4method{disp_ccounts}{PreDataTableLayouts}(obj) <- value +coltree_at_path(obj, path, ...) + colcount_format(obj) \S4method{colcount_format}{InstantiatedColumnInfo}(obj) @@ -962,6 +1010,12 @@ colcount_format(obj) \S4method{colcount_format}{PreDataTableLayouts}(obj) +\S4method{colcount_format}{Split}(obj) + +\S4method{colcount_format}{LayoutColTree}(obj) + +\S4method{colcount_format}{LayoutColLeaf}(obj) + colcount_format(obj) <- value \S4method{colcount_format}{InstantiatedColumnInfo}(obj) <- value @@ -972,6 +1026,18 @@ colcount_format(obj) <- value \S4method{colcount_format}{PreDataTableLayouts}(obj) <- value +colcount_na_str(obj) + +\S4method{colcount_na_str}{InstantiatedColumnInfo}(obj) + +\S4method{colcount_na_str}{VTableNodeInfo}(obj) + +colcount_na_str(obj) <- value + +\S4method{colcount_na_str}{InstantiatedColumnInfo}(obj) <- value + +\S4method{colcount_na_str}{VTableNodeInfo}(obj) <- value + \S4method{as.vector}{TableRow}(x, mode = "any") \S4method{as.vector}{ElementaryTable}(x, mode = "any") @@ -1174,6 +1240,9 @@ functions. See \code{\link[formatters:list_formats]{formatters::list_valid_forma \item{add.labrows}{(\code{flag})\cr whether to include label rows. Defaults to \code{FALSE}.} +\item{path}{(\code{character})\cr a vector path for a position within the structure of a \code{TableTree}. Each element +represents a subsequent choice amongst the children of the previous choice.} + \item{mode}{(\code{string})\cr passed on to \code{\link[=as.vector]{as.vector()}}.} \item{rowpath}{(\code{character} or \code{NULL})\cr path within row structure. \code{NULL} indicates the footnote should @@ -1187,9 +1256,6 @@ recalculated. Defaults to \code{TRUE}.} \item{y}{(\code{ANY})\cr second element to be row-bound via \code{rbind2}.} -\item{path}{(\code{character})\cr a vector path for a position within the structure of a \code{TableTree}. Each element -represents a subsequent choice amongst the children of the previous choice.} - \item{i}{(\code{numeric(1)})\cr index.} \item{j}{(\code{numeric(1)})\cr index.} diff --git a/man/lyt_args.Rd b/man/lyt_args.Rd index 2b15de846..05a33c0f4 100644 --- a/man/lyt_args.Rd +++ b/man/lyt_args.Rd @@ -48,7 +48,9 @@ lyt_args( page_prefix, format_na_str, section_div, - na_str + na_str, + show_colcounts, + colcount_format ) } \arguments{ @@ -172,6 +174,13 @@ are all \code{NA}.} by this split instruction, or \code{NA_character_} (the default) for no section divider.} \item{na_str}{(\code{string})\cr string that should be displayed when the value of \code{x} is missing. Defaults to \code{"NA"}.} + +\item{show_colcounts}{(\code{logical(1)})\cr should column counts be displayed at the level +facets created by this split. Defaults to \code{FALSE}.} + +\item{colcount_format}{(\code{character(1)})\cr if \code{show_colcounts} is \code{TRUE}, the +format which should be used to display column counts for facets generated by +this split. Defaults to \code{"(N=xx)"}.} } \value{ No return value. diff --git a/man/make_col_df.Rd b/man/make_col_df.Rd index 30a587d09..c94eff404 100644 --- a/man/make_col_df.Rd +++ b/man/make_col_df.Rd @@ -4,7 +4,13 @@ \alias{make_col_df} \title{Column layout summary} \usage{ -make_col_df(tt, colwidths = NULL, visible_only = TRUE) +make_col_df( + tt, + colwidths = NULL, + visible_only = TRUE, + na_str = "", + ccount_format = colcount_format(tt) \%||\% "(N=xx)" +) } \arguments{ \item{tt}{(\code{ANY})\cr object representing the table-like object to be summarized.} @@ -13,6 +19,11 @@ make_col_df(tt, colwidths = NULL, visible_only = TRUE) \item{visible_only}{(\code{flag})\cr should only visible aspects of the table structure be reflected in this summary. Defaults to \code{TRUE}. May not be supported by all methods.} + +\item{na_str}{(\code{character(1)})\cr The string to display when a column count is NA. Users should not need to set this.} + +\item{ccount_format}{(\code{FormatSpec})\cr The format to be used by default for +column counts if one is not specified for an individual column count.} } \description{ Used for pagination. Generate a structural summary of the columns of an \code{rtables} table and return it as a diff --git a/man/make_split_result.Rd b/man/make_split_result.Rd index 408e8f134..5e5ce8671 100644 --- a/man/make_split_result.Rd +++ b/man/make_split_result.Rd @@ -49,14 +49,6 @@ post-processing within a custom split function. These functions performs various housekeeping tasks to ensure that the split result list is as the rtables internals expect it, most of which are not relevant to end users. } -\note{ -Column splitting will not work correctly if a split function -calls \code{make_split_result} without specifying subset expressions; -row splitting will work as normal. This is due to the fact that -subsetting expressions are used during column splitting to -represent the data associated with facets, while actual data -subsets are used during row splitting. -} \examples{ splres <- make_split_result( values = c("hi", "lo"), diff --git a/man/manual_cols.Rd b/man/manual_cols.Rd index 487a20ffa..0d63954d3 100644 --- a/man/manual_cols.Rd +++ b/man/manual_cols.Rd @@ -4,13 +4,15 @@ \alias{manual_cols} \title{Manual column declaration} \usage{ -manual_cols(..., .lst = list(...)) +manual_cols(..., .lst = list(...), ccount_format = NULL) } \arguments{ \item{...}{one or more vectors of levels to appear in the column space. If more than one set of levels is given, the values of the second are nested within each value of the first, and so on.} \item{.lst}{(\code{list})\cr a list of sets of levels, by default populated via \code{list(...)}.} + +\item{ccount_format}{(\code{FormatSpec})\cr the format to use when counts are displayed.} } \value{ An \code{InstantiatedColumnInfo} object, suitable for declaring the column structure for a manually constructed diff --git a/man/matrix_form-VTableTree-method.Rd b/man/matrix_form-VTableTree-method.Rd index 76831bb77..39a9e6a66 100644 --- a/man/matrix_form-VTableTree-method.Rd +++ b/man/matrix_form-VTableTree-method.Rd @@ -24,11 +24,13 @@ newlines into multiple 'physical' rows (as they will appear when rendered into A \item{indent_size}{(\code{numeric(1)})\cr number of spaces to use per indent level. Defaults to 2.} -\item{fontspec}{(\code{font_spec} or \code{NULL})\cr Font specification that should be -assumed during wrapping, as returned by \code{\link[formatters:font_spec]{formatters::font_spec()}}.} +\item{fontspec}{(\code{font_spec})\cr The font that should be used by default when +rendering this \code{MatrixPrintForm} object, or NULL (the default).} -\item{col_gap}{(\code{numeric(1)})\cr The column gap to assume between columns, in -number of spaces assuming \code{fontspec} (this reduces to number of characters for monospace fonts).} +\item{col_gap}{(\code{numeric(1)})]\cr The number of spaces (in the font specified +by \code{fontspec}) that should be placed between columns when the table +is rendered directly to text (e.g., by \code{toString} or \code{export_as_txt}). Defaults +to \code{3}.} } \value{ A list with the following elements: diff --git a/man/qtable_layout.Rd b/man/qtable_layout.Rd index 0aee0220a..218d69e80 100644 --- a/man/qtable_layout.Rd +++ b/man/qtable_layout.Rd @@ -70,8 +70,12 @@ printed on a separate line. Ignored for subtables.} \item{prov_footer}{(\code{character})\cr a vector of strings to use as provenance-related global footer materials (\code{\link[=prov_footer]{prov_footer()}}), where every element is printed on a separate line.} -\item{show_colcounts}{(\code{flag})\cr whether column counts should be displayed in the resulting table when this -layout is applied to data.} +\item{show_colcounts}{(\code{logical(1)})\cr Indicates whether the lowest level of +applied to data. \code{NA}, the default, indicates that the \code{show_colcounts} +argument(s) passed to the relevant calls to \verb{split_cols_by*} +functions. Non-missing values will override the behavior specified in +column splitting layout instructions which create the lowest level, or +leaf, columns.} \item{drop_levels}{(\code{flag})\cr whether unobserved factor levels should be dropped during facetting. Defaults to \code{TRUE}.} diff --git a/man/rm_all_colcounts.Rd b/man/rm_all_colcounts.Rd new file mode 100644 index 000000000..463b76593 --- /dev/null +++ b/man/rm_all_colcounts.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/colby_constructors.R +\name{rm_all_colcounts} +\alias{rm_all_colcounts} +\alias{rm_all_colcounts,VTableTree-method} +\alias{rm_all_colcounts,InstantiatedColumnInfo-method} +\alias{rm_all_colcounts,LayoutColTree-method} +\alias{rm_all_colcounts,LayoutColLeaf-method} +\title{Set all column counts at all levels of nesting to NA} +\usage{ +rm_all_colcounts(obj) + +\S4method{rm_all_colcounts}{VTableTree}(obj) + +\S4method{rm_all_colcounts}{InstantiatedColumnInfo}(obj) + +\S4method{rm_all_colcounts}{LayoutColTree}(obj) + +\S4method{rm_all_colcounts}{LayoutColLeaf}(obj) +} +\arguments{ +\item{obj}{(\code{ANY})\cr the object for the accessor to access or modify.} +} +\value{ +\code{obj} with all column counts reset to missing +} +\description{ +Set all column counts at all levels of nesting to NA +} +\examples{ +lyt <- basic_table() \%>\% + split_cols_by("ARM") \%>\% + split_cols_by("SEX") \%>\% + analyze("AGE") +tbl <- build_table(lyt, ex_adsl) + +# before +col_counts(tbl) +tbl <- rm_all_colcounts(tbl) +col_counts(tbl) +} diff --git a/man/score_funs.Rd b/man/score_funs.Rd index 534328cd9..9ce673c09 100644 --- a/man/score_funs.Rd +++ b/man/score_funs.Rd @@ -22,5 +22,6 @@ Score functions for sorting \code{TableTrees} } \seealso{ For examples and details, please read the documentation for \code{\link[=sort_at_path]{sort_at_path()}} and the -\href{https://insightsengineering.github.io/rtables/main/articles/sorting_pruning.html}{Sorting and Pruning} vignette. +\href{https://insightsengineering.github.io/rtables/latest-tag/articles/sorting_pruning.html}{Sorting and Pruning} +vignette. } diff --git a/man/sort_at_path.Rd b/man/sort_at_path.Rd index 7d2c44aad..d3190657c 100644 --- a/man/sort_at_path.Rd +++ b/man/sort_at_path.Rd @@ -60,7 +60,8 @@ with the \code{visible_only} argument set to \code{FALSE}. It can also be inferr \code{\link[=table_structure]{table_structure()}}. Note that sorting needs a deeper understanding of table structure in \code{rtables}. Please consider reading the related -vignette (\href{https://insightsengineering.github.io/rtables/main/articles/sorting_pruning.html}{Sorting and Pruning}) +vignette +(\href{https://insightsengineering.github.io/rtables/latest-tag/articles/sorting_pruning.html}{Sorting and Pruning}) and explore table structure with useful functions like \code{\link[=table_structure]{table_structure()}} and \code{\link[=row_paths_summary]{row_paths_summary()}}. It is also very important to understand the difference between "content" rows and "data" rows. The first one analyzes and describes the split variable generally and is generated with \code{\link[=summarize_row_groups]{summarize_row_groups()}}, while the second one is diff --git a/man/split_cols_by.Rd b/man/split_cols_by.Rd index 6c59c0c7c..98bcffc89 100644 --- a/man/split_cols_by.Rd +++ b/man/split_cols_by.Rd @@ -14,7 +14,9 @@ split_cols_by( nested = TRUE, child_labels = c("default", "visible", "hidden"), extra_args = list(), - ref_group = NULL + ref_group = NULL, + show_colcounts = FALSE, + colcount_format = NULL ) } \arguments{ @@ -46,6 +48,13 @@ corresponds to the children of this split. Named elements in the child-specific not match a formal argument of the tabulation function.} \item{ref_group}{(\code{string} or \code{NULL})\cr level of \code{var} that should be considered \code{ref_group}/reference.} + +\item{show_colcounts}{(\code{logical(1)})\cr should column counts be displayed at the level +facets created by this split. Defaults to \code{FALSE}.} + +\item{colcount_format}{(\code{character(1)})\cr if \code{show_colcounts} is \code{TRUE}, the +format which should be used to display column counts for facets generated by +this split. Defaults to \code{"(N=xx)"}.} } \value{ A \code{PreDataTableLayouts} object suitable for passing to further layouting functions, and to \code{\link[=build_table]{build_table()}}. diff --git a/man/split_cols_by_multivar.Rd b/man/split_cols_by_multivar.Rd index eb5722766..e1c108319 100644 --- a/man/split_cols_by_multivar.Rd +++ b/man/split_cols_by_multivar.Rd @@ -11,7 +11,9 @@ split_cols_by_multivar( varlabels = vars, varnames = NULL, nested = TRUE, - extra_args = list() + extra_args = list(), + show_colcounts = FALSE, + colcount_format = NULL ) } \arguments{ @@ -34,6 +36,13 @@ underneath analyses, which is not allowed.} \item{extra_args}{(\code{list})\cr extra arguments to be passed to the tabulation function. Element position in the list corresponds to the children of this split. Named elements in the child-specific lists are ignored if they do not match a formal argument of the tabulation function.} + +\item{show_colcounts}{(\code{logical(1)})\cr should column counts be displayed at the level +facets created by this split. Defaults to \code{FALSE}.} + +\item{colcount_format}{(\code{character(1)})\cr if \code{show_colcounts} is \code{TRUE}, the +format which should be used to display column counts for facets generated by +this split. Defaults to \code{"(N=xx)"}.} } \value{ A \code{PreDataTableLayouts} object suitable for passing to further layouting functions, and to \code{\link[=build_table]{build_table()}}. diff --git a/man/varcuts.Rd b/man/varcuts.Rd index 5c15380d8..e85079448 100644 --- a/man/varcuts.Rd +++ b/man/varcuts.Rd @@ -16,7 +16,9 @@ split_cols_by_cuts( cutlabels = NULL, split_label = var, nested = TRUE, - cumulative = FALSE + cumulative = FALSE, + show_colcounts = FALSE, + colcount_format = NULL ) split_rows_by_cuts( @@ -41,7 +43,9 @@ split_cols_by_cutfun( split_label = var, nested = TRUE, extra_args = list(), - cumulative = FALSE + cumulative = FALSE, + show_colcounts = FALSE, + colcount_format = NULL ) split_cols_by_quartiles( @@ -50,7 +54,9 @@ split_cols_by_quartiles( split_label = var, nested = TRUE, extra_args = list(), - cumulative = FALSE + cumulative = FALSE, + show_colcounts = FALSE, + colcount_format = NULL ) split_rows_by_quartiles( @@ -103,6 +109,13 @@ underneath analyses, which is not allowed.} \item{cumulative}{(\code{flag})\cr whether the cuts should be treated as cumulative. Defaults to \code{FALSE}.} +\item{show_colcounts}{(\code{logical(1)})\cr should column counts be displayed at the level +facets created by this split. Defaults to \code{FALSE}.} + +\item{colcount_format}{(\code{character(1)})\cr if \code{show_colcounts} is \code{TRUE}, the +format which should be used to display column counts for facets generated by +this split. Defaults to \code{"(N=xx)"}.} + \item{format}{(\code{string}, \code{function}, or \code{list})\cr format associated with this split. Formats can be declared via 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.} diff --git a/tests/testthat/test-binding.R b/tests/testthat/test-binding.R index 67fe271f2..12b30cea6 100644 --- a/tests/testthat/test-binding.R +++ b/tests/testthat/test-binding.R @@ -27,6 +27,15 @@ test_that("cbind_rtables works with 3 tables", { newtab <- cbind_rtables(tab1, tab2, tab3) expect_equal(ncol(newtab), 3) expect_equal(c(1, 2, 3), unlist(cell_values(newtab))) + ## all paths reachable, unique and work + ## this was not previously the case which broke higher-level ns display machinery + cpaths <- col_paths(newtab) + for (i in seq_along(cpaths)) { + expect_equal( + newtab[, i], + newtab[, cpaths[[i]]] + ) + } }) @@ -171,6 +180,33 @@ test_that("insert_rrow works", { expect_silent(lifecycle::expect_deprecated(insert_rrow(tbl, rrow("Total xx"), at = 1))) }) +test_that("count visibility syncing works when cbinding", { + lyt1 <- basic_table(show_colcounts = TRUE) %>% + split_cols_by("ARM") %>% + split_cols_by("STRATA1") %>% + analyze("AGE") + + tab1 <- build_table(lyt1, ex_adsl) + + lyt2 <- basic_table() %>% + split_cols_by("ARM", show_colcounts = TRUE) %>% + split_cols_by("STRATA1") %>% + analyze("AGE") + + tab2 <- build_table(lyt2, ex_adsl) + + bigtab <- cbind_rtables(tab1, tab2) + bigmpf <- matrix_form(bigtab) + bigstrs <- mf_strings(bigmpf) + expect_true(all(grepl("N=", bigstrs[mf_nlheader(bigmpf), -1]))) + + bigtab2 <- cbind_rtables(tab1, tab2, sync_count_vis = FALSE) + bigmpf2 <- matrix_form(bigtab2) + bigstrs2 <- mf_strings(bigmpf2) + expect_equal(sum(grepl("N=", bigstrs2[mf_nlheader(bigmpf2), -1])), ncol(tab1)) +}) + + ## regression test for #340 ## ensure split functions that are fully equivalent but ## have different actual enclosing environments don't diff --git a/tests/testthat/test-lyt-tabulation.R b/tests/testthat/test-lyt-tabulation.R index 6616d00fd..578638e99 100644 --- a/tests/testthat/test-lyt-tabulation.R +++ b/tests/testthat/test-lyt-tabulation.R @@ -667,6 +667,16 @@ test_that("Colcounts work correctly", { 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") %>% + analyze("AGE") + + tbl5 <- build_table(lyt5, ex_adsl, col_counts = 1:9) + mpf5 <- matrix_form(tbl5) + expect_identical(mf_strings(mpf5)[3, 2], "(N=1)") }) first_cont_rowvals <- function(tt) { diff --git a/tests/testthat/test-printing.R b/tests/testthat/test-printing.R index 15de7d526..7c6398b34 100644 --- a/tests/testthat/test-printing.R +++ b/tests/testthat/test-printing.R @@ -340,6 +340,7 @@ test_that("Various Printing things work", { table_structure(tab, detail = "subtable") ## treestruct(tab) table_structure(tab, detail = "row") ## treestruct(tab) + coltree_structure(tab) ## this is not intended to be a valid layout, it just ## tries to hit every type of split for the print machinery @@ -785,3 +786,145 @@ test_that("horizontal separator is propagated from table to print and export", { export_txt_tbl <- strsplit(export_as_txt(tbl), "\n")[[1]] expect_identical(tostring_tbl, export_txt_tbl) }) + +## higher-level showing ncols works: + +test_that("showing higher-level ncols works", { + mydat <- subset(ex_adsl, SEX %in% c("M", "F")) + mydat$SEX2 <- factor( + ifelse( + mydat$SEX == "M", + "males", + "super long sentence that involves females" + ) + ) + + lyt <- basic_table() %>% + split_cols_by("ARM", show_colcounts = TRUE) %>% + split_cols_by("SEX2", show_colcounts = TRUE) %>% + split_cols_by("STRATA1") %>% + analyze("AGE") + + tbl <- build_table(lyt, mydat) + expect_equal(colcount_na_str(tbl), "") + colcount_na_str(tbl) <- "wut" + expect_equal(colcount_na_str(tbl), "wut") + colcount_na_str(tbl) <- "" + cwds <- rep(8, ncol(tbl) + 1) + expect_equal(nlines(col_info(tbl), colwidths = cwds, fontspec = NULL), 7) + mpf <- matrix_form(tbl, TRUE) + ## this is to get around complaints about ::: in the precommit rules + dcfnw <- get("do_cell_fnotes_wrap", asNamespace("formatters")) + mpf <- dcfnw(mpf, cwds, NULL, FALSE, fontspec = NULL) + strs <- mf_strings(mpf) + ## wrapping some cells and not others still works + expect_equal(strs[3:4, 2], c("", "males")) + + expect_equal(strs[2, 2], "(N=130)") + ## N= cells all across rows 2 (for ARM) and 5 (for SEX2), except rowlabels + expect_true(all(grepl("(N=", strs[c(2, 5), -1], fixed = TRUE))) + ## No N= cells elsewhere + expect_true(all(!grepl("(N=", strs[-c(2, 5), -1], fixed = TRUE))) + + broken_tbl <- tbl + expect_true(colcount_visible(broken_tbl, c("ARM", "A: Drug X", "SEX2", "males"))) + colcount_visible(broken_tbl, c("ARM", "A: Drug X", "SEX2", "males")) <- FALSE + expect_error(print(broken_tbl), "different colcount visibility among sibling facets") + + ## does the old accessor still work ok + + lyt2 <- basic_table() %>% + split_cols_by("ARM", show_colcounts = TRUE) %>% + split_cols_by("SEX2", show_colcounts = TRUE) %>% + split_cols_by("STRATA1", show_colcounts = TRUE) %>% + analyze("AGE") + + tbl2 <- build_table(lyt2, mydat) + nc <- ncol(tbl2) + new_ccs <- seq_len(nc) + + col_counts(tbl2) <- new_ccs + + mpf2 <- matrix_form(tbl2, TRUE) + expect_equal( + mf_strings(mpf2)[mf_nlheader(mpf2), -1, drop = TRUE], + sprintf("(N=%d)", new_ccs) + ) + ## NA counts (to display blank) work correctly for higher level facets + + tbl3 <- tbl + facet_colcount(tbl3, c("ARM", "C: Combination")) <- NA_integer_ + mpf3 <- matrix_form(tbl3, TRUE) + ## starting at "column" 2 because topleft/row labels + expect_equal( + mf_strings(mpf3)[2, 2:13], + mf_strings(mpf)[2, 2:13] + ) + expect_equal( + mf_strings(mpf3)[2, 14:19], + rep("", 6) + ) + + tbl4 <- tbl2 + col_counts(tbl4)[rep(c(FALSE, TRUE), times = c(14, 4))] <- NA_integer_ + + adsl <- ex_adsl + + adsl$active_trt <- factor(ifelse(grepl("Placebo", adsl$ARM), " ", "Active Treatment Group")) + adsl$rr_header <- "Risk Difference % CI" + + combodf <- tribble( + ~valname, ~label, ~levelcombo, ~exargs, + "A_C", "Arms A+C", c("A: Drug X", "C: Combination"), list() + ) + + lyt5 <- basic_table(show_colcounts = TRUE) %>% + split_cols_by("active_trt", split_fun = trim_levels_in_group("ARM")) %>% + split_cols_by("ARM", split_fun = add_combo_levels(combodf)) %>% + split_cols_by("rr_header", nested = FALSE) %>% + split_cols_by("ARM", split_fun = keep_split_levels(c("A: Drug X", "C: Combination"))) %>% + analyze("AGE") + + tbl5 <- build_table(lyt5, adsl) + expect_silent(toString(tbl5)) + col_counts(tbl5)[c(FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, TRUE)] <- NA_integer_ + mpf5 <- matrix_form(tbl5, TRUE) + expect_equal( + mf_strings(mpf5)[3, c(3, 7, 8)], # cols 2, 6 and 7, remember row labels! + c("", "", "") + ) + + ## turning counts for a facet's children off is different than setting + ## the visible counts to NA, note alignment here, no spaces under risk diff + ## arms + facet_colcounts_visible(tbl5, c("rr_header", "Risk Difference % CI", "ARM")) <- FALSE + mpf5b <- matrix_form(tbl5, TRUE) + expect_equal( + mf_strings(mpf5b)[3, 7:8], + c("A: Drug X", "C: Combination") + ) + lyt6 <- basic_table(show_colcounts = TRUE, colcount_format = "N=xx") %>% + split_cols_by("active_trt", split_fun = trim_levels_in_group("ARM")) %>% + split_cols_by("ARM", split_fun = add_combo_levels(combodf), show_colcounts = TRUE, colcount_format = "(N=xx)") %>% + split_cols_by("rr_header", nested = FALSE) %>% + split_cols_by("ARM", split_fun = keep_split_levels(c("A: Drug X", "C: Combination"))) %>% + analyze("AGE") + + tbl6 <- build_table(lyt6, adsl) + + lyt7 <- basic_table(show_colcounts = TRUE, colcount_format = "N=xx") %>% + split_cols_by("active_trt", split_fun = trim_levels_in_group("ARM")) %>% + split_cols_by("ARM", split_fun = add_combo_levels(combodf), show_colcounts = TRUE, colcount_format = "(N=xx)") %>% + split_cols_by("STRATA1") %>% + split_cols_by("rr_header", nested = FALSE) %>% + split_cols_by("ARM", split_fun = keep_split_levels(c("A: Drug X", "C: Combination"))) %>% + analyze("AGE") + + tbl7 <- build_table(lyt7, adsl) + expect_silent(toString(tbl7)) + + mpf7 <- matrix_form(tbl7) + strs7 <- mf_strings(mpf7) + expect_equal(length(grep("^[(]N=", strs7)), 15) ## cause of spanning, 5 visible counts, each span 3 + expect_equal(length(grep("^N=", strs7)), ncol(tbl7)) +}) diff --git a/tests/testthat/test-regressions.R b/tests/testthat/test-regressions.R index 6d14a18b8..647f11931 100644 --- a/tests/testthat/test-regressions.R +++ b/tests/testthat/test-regressions.R @@ -631,3 +631,25 @@ test_that("export_as_txt works when there are newlines in column labels (natural expect_silent(tmp <- export_as_txt(tbl, lpp = 20)) }) + +## overridden colcounts via build_table are used correctly +## during tabulation + +test_that("overridden colcounts via build_table are used during tabulation correctly", { + afun <- function(x, .N_col) { + .N_col + } + + lyt <- basic_table() %>% + split_cols_by("ARM") %>% + split_cols_by("STRATA1") %>% + analyze("AGE", afun = afun) + + tbl <- build_table(lyt, ex_adsl, col_counts = 1:9) + mpf <- matrix_form(tbl) + strs <- mf_strings(mpf) + expect_identical( + strs[3, -1], + paste0("(N=", strs[4, -1], ")") + ) +}) diff --git a/vignettes/clinical_trials.Rmd b/vignettes/clinical_trials.Rmd index 67189e9b7..7c2d29388 100644 --- a/vignettes/clinical_trials.Rmd +++ b/vignettes/clinical_trials.Rmd @@ -561,7 +561,7 @@ adae_adsl_tbl Alternatively, if the desired column counts are already calculated, they can be specified directly via the `col_counts` argument to `build_table()`, though specifying an `alt_counts_df` is the preferred -mechanism. +mechanism (the number of rows will be used, but no duplicate checking!!!). We next calculate this information per system organ class: @@ -652,7 +652,7 @@ trim_rows(adae_soc_tbl4) ``` Pruning is a larger topic with a [separate `rtables` package -vignette](https://insightsengineering.github.io/rtables/main/articles/sorting_pruning.html). +vignette](https://insightsengineering.github.io/rtables/latest-tag/articles/sorting_pruning.html). ### Adverse Events By ID and By Grade diff --git a/vignettes/col_counts.Rmd b/vignettes/col_counts.Rmd new file mode 100644 index 000000000..0d68b426c --- /dev/null +++ b/vignettes/col_counts.Rmd @@ -0,0 +1,209 @@ +--- +title: "Column Counts and Formats" +author: "Davide Garolini" +date: "`r Sys.Date()`" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Column Counts and Formats} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + chunk_output_type: console +--- + +```{r, echo=FALSE} +knitr::opts_chunk$set(comment = "#") +``` + +# The Old Way + +Many tables call for column counts to be displayed in the header +material of a table (i.e., interspersed with the column labels). + +Historically, `rtables` supported this only for so-called leaf +or individual columns. + +## Setting column counts to visible at Layout time + +Display of column counts (off by default) was primarily achieved via +passing `show_colcounts = TRUE` to `basic_table` , e.g. + +```{r} +library(dplyr) +library(rtables) +lyt <- basic_table(show_colcounts = TRUE) %>% + split_cols_by("ARM") %>% + split_cols_by("SEX", split_fun = keep_split_levels(c("F", "M"))) %>% + analyze("AGE") + +tbl <- build_table(lyt, ex_adsl) +tbl +``` + +The format of the counts could also be controlled by the `colcount_format` +argument to `basic_table`. + +We had no way of displaying (or, in fact, even easily calculating) +the `ARM` facet counts. + +## Modifying counts on an existing table + +(Leaf-)column counts could be altered after the fact via the `col_counts<-` getter: + +```{r} +col_counts(tbl) <- c(17, 18, 19, 17, 18, 19) +tbl +``` +**NB** doing this has never updated percentages that appear within the table +as they are calculated at table-creation time, so this can lead to misleading +results when not used with care. + +## Hiding counts +We did not provide a user-visible way to toggle column count display +after table creation, though we did support showing a blank space for +particular counts by setting them to `NA`: + +```{r} +col_counts(tbl) <- c(17, 18, NA, 17, 18, 19) +tbl +``` + +These mechanisms will all continue to work for the forseeable future, though new code is advised use the new API discussed below. + +# Higher Level Column Counts + +Starting in `rtables` version `6.8.0`, the concept of column counts is +modeled and handled with much more granularity than previously. Each +facet in column space now has a column count (whether or not it is +displayed), which will appear directly under the corresponding column +label (spanning the same number of rows) when set to be visible. + + +## Setting Column Counts to Visible at Layout Time + +The primary way for users to create tables which displays these "high-level" +column counts is to create a layout that specifies they should be visible. + +We do this with the new `show_colcounts` argument now accepted by all +`split_cols_by*` layout functions. + + +```{r} +lyt2 <- basic_table() %>% + split_cols_by("ARM") %>% + split_cols_by("SEX", + split_fun = keep_split_levels(c("F", "M")), + show_colcounts = TRUE + ) %>% + analyze("AGE") + +tbl2 <- build_table(lyt2, ex_adsl) +tbl2 +``` + + +```{r} +lyt3 <- basic_table() %>% + split_cols_by("ARM", show_colcounts = TRUE) %>% + split_cols_by("SEX", split_fun = keep_split_levels(c("F", "M"))) %>% + analyze("AGE") + +tbl3 <- build_table(lyt3, ex_adsl) +tbl3 +``` + +As before, these column counts are calculated at table creation time, using +`alt_counts_df` if it is provided (or simply `df` otherwise). + +Column formats are set at layout time via the `colcount_format` argument +*of the specific `split_cols_by` call*. + + +## Manipulating Column Counts In An Existing Table + +Manipulation of column counts (beyond the old setters provided for +backwards compatibility) is path based. In other words, when we set a +column count (e.g., to NA so it displays as a blank) or set the +visibilty of a set of column counts, we do so by indicating them via +column paths. The ability to alter column count formats on an existing +table is currently not offered by any exported functions. + +Column paths can be obtained via `col_paths` for the leaf columns, or +via `make_col_df(tbl, visible_only = FALSE)$path` for all addressable +facets. + +### Setting individual column counts + +The `facet_colcount` getter and setter queries and sets the column count for a facet in column space (note it needs not be a leaf facet). E.g., + +```{r} +facet_colcount(tbl3, c("ARM", "C: Combination")) +``` + + +```{r} +facet_colcount(tbl3, c("ARM", "C: Combination")) <- 75 +tbl3 +``` + +For convenience (primarily because it was needed internally), +we also provide `rm_all_colcounts` which sets *all* column counts +for a particular table to `NA` at all levels of nesting. We do not +expect this to be particularly useful to end-users. + +### Setting Col Count Visibility + +Typically we do not set column count visibility individually. *This +is due to a constraint where direct leaf siblings (e.g. F and M under +one of the arms in our layout) must have the same visibility for their +column counts in order for the rendering machinery to work. + +Instead, we can reset the column count visibility of groups of siblings +via the `facet_colcounts_visible` (note the 's') setter. This function accepts a path +which ends in the name associated with a splitting instruction in the layout (e.g., `c("ARM")`, +`c("ARM", "B: Placebo", "SEX")`, etc) and *resets the visibility of all direct children of that +path*. + +```{r} +facet_colcounts_visible(tbl3, c("ARM", "A: Drug X", "SEX")) <- TRUE +tbl3 +``` + +**NOTE** as we can see here, the visibility of column counts can have an +"unbalanced design", provided the direct-siblings agreeing constraint is met. This +leads to things not lining up directly as one might expect (it does not generate +any blank spaces the way setting a visible column count to `NA` does). + +Currently paths with `"*"` in them do not work within +`facet_colcounts_visible`, but that capability is likely to be added +in future releases. + +`colcount_visible` getters and setters do also exist which retrieve and set +individual column counts' visiblities, but these are largely an internal detail +and in virtually all cases end users should avoid calling them directly. + +```{r, error=TRUE} +## BEWARE +tbl4 <- tbl3 +colcount_visible(tbl4, c("ARM", "A: Drug X", "SEX", "F")) <- FALSE +tbl4 +``` + +Note currently this restriction is currently only enforced for leaf +columns due to technical implementation details but how a table +renders should be considered undefined behavior when it contains +a group of sibling column facets arising from the same +layout instruction whose column count visiblities disagree. That may +become an error in future versions without warning. + +### Advanced Settings + +By using `make_col_df()` we can see the full path to any column count. One example application is to add a `NA` value that would print to the default value is `""`, that will show nothing. To change (for now uniformly only) the output string in case of missing values in the column counts you can use `colcount_na_str`: + +```{r} +coldf <- make_col_df(tbl3) +facet_colcount(tbl3, coldf$path[[1]][c(1, 2)]) <- NA_integer_ +print(tbl3) # Keeps the missing space +colcount_na_str(tbl3) <- "NaN" +tbl3 # Shows NaN +``` diff --git a/vignettes/dev-guide/dg_split_machinery.Rmd b/vignettes/dev-guide/dg_split_machinery.Rmd index b6f984587..9b7ffb103 100644 --- a/vignettes/dev-guide/dg_split_machinery.Rmd +++ b/vignettes/dev-guide/dg_split_machinery.Rmd @@ -13,7 +13,7 @@ knitr::opts_chunk$set(echo = TRUE) ## Disclaimer -This article is intended for use by developers only and will contain low-level explanations of the topics covered. For user-friendly vignettes, please see the [Articles](https://insightsengineering.github.io/rtables/main/articles/index.html) page on the `rtables` website. +This article is intended for use by developers only and will contain low-level explanations of the topics covered. For user-friendly vignettes, please see the [Articles](https://insightsengineering.github.io/rtables/latest-tag/articles/index.html) page on the `rtables` website. Any code or prose which appears in the version of this article on the `main` branch of the repository may reflect a specific state of things that can be more or less recent. This guide describes very important pieces of the split machinery that are unlikely to change. Regardless, we invite the reader to keep in mind that the current repository code may have drifted from the following material in this document, and it is always the best practice to read the code directly on `main`. @@ -23,13 +23,13 @@ Being that this a working document that may be subjected to both deprecation and ## Introduction -The scope of this article is understanding how `rtables` creates facets by splitting the incoming data into hierarchical groups that go from the root node to singular `rcell`s. The latter level, also called the leaf-level, contains the final partition that is subjected to analysis functions. More details from the user perspective can be found in the [Split Functions vignette](https://insightsengineering.github.io/rtables/main/articles/split_functions.html) and in function documentation like `?split_rows_by` and `?split_funcs`. +The scope of this article is understanding how `rtables` creates facets by splitting the incoming data into hierarchical groups that go from the root node to singular `rcell`s. The latter level, also called the leaf-level, contains the final partition that is subjected to analysis functions. More details from the user perspective can be found in the [Split Functions vignette](https://insightsengineering.github.io/rtables/latest-tag/articles/split_functions.html) and in function documentation like `?split_rows_by` and `?split_funcs`. The following article will describe how the split machinery works in the row domain. Further information on how the split machinery works in the column domain will be covered in a separate article. ## Process and Methods -Beforehand, we encourage the reader to familiarize themselves with the [Debugging in {rtables} article](https://insightsengineering.github.io/rtables/main/articles/dev-guide/dg_debug_rtables.html) from the `rtables` Developers Guide. This document is generally valid for R programming, but has been tailored to study and understand complex packages that rely heavily on S3 and S4 object programming like `rtables`. +Beforehand, we encourage the reader to familiarize themselves with the [Debugging in {rtables} article](https://insightsengineering.github.io/rtables/latest-tag/articles/dev-guide/dg_debug_rtables.html) from the `rtables` Developers Guide. This document is generally valid for R programming, but has been tailored to study and understand complex packages that rely heavily on S3 and S4 object programming like `rtables`. Here, we explore and study the split machinery with a growing amount of complexity, following relevant functions and methods throughout their execution. By going from basic to complex and by discussing important and special cases, we hope to be able to give you a good understanding of how the split machinery works. @@ -128,7 +128,7 @@ We will see where and how input parameters are used. The most important paramete We will start by looking at the first function called from `do_split`. This will give us a good overview of how the split itself is defined. This function is, of course, the check function (`check_validsplit`) that is used to verify if the split is valid for the data. In the following we will describe the split-class hierarchy step-by-step, but we invite the reader to explore this further on their own as well. -Let's first search the package for `check_validsplit`. You will find that it is defined as a generic in `R/split_funs.R`, where it is applied to the following "split" classes: `VarLevelSplit`, `MultiVarSplit`, `VAnalyzeSplit`, `CompoundSplit`, and `Split`. Another way to find this information, which is more useful for more spread out and complicated objects, is by using `showMethods(check_validsplit)`. The virtual class `VAnalyzeSplit` (by convention virtual classes start with "V") defines the main parent of the analysis split which we discuss in detail in the related vignette `vignette()` (xxx). From this, we can see that the `analyze()` calls actually mimic split objects as they create different results under a specific final split (or node). Now, notice that `check_validsplit` is also called in another location, the main `R/tt_dotabulation.R` source file. This is again something related to making "analyze" rows as it mainly checks for `VAnalyzeSplit`. See the [Tabulation article](https://insightsengineering.github.io/rtables/main/articles/dev-guide/dg_tabulation.html) for more details. We will discuss the other classes as they appear in our examples. See more about class hierarchy in the [Table Hierarchy article](https://insightsengineering.github.io/rtables/main/articles/dev-guide/dg_table_hierarchy.html). +Let's first search the package for `check_validsplit`. You will find that it is defined as a generic in `R/split_funs.R`, where it is applied to the following "split" classes: `VarLevelSplit`, `MultiVarSplit`, `VAnalyzeSplit`, `CompoundSplit`, and `Split`. Another way to find this information, which is more useful for more spread out and complicated objects, is by using `showMethods(check_validsplit)`. The virtual class `VAnalyzeSplit` (by convention virtual classes start with "V") defines the main parent of the analysis split which we discuss in detail in the related vignette `vignette()` (xxx). From this, we can see that the `analyze()` calls actually mimic split objects as they create different results under a specific final split (or node). Now, notice that `check_validsplit` is also called in another location, the main `R/tt_dotabulation.R` source file. This is again something related to making "analyze" rows as it mainly checks for `VAnalyzeSplit`. See the [Tabulation article](https://insightsengineering.github.io/rtables/latest-tag/articles/dev-guide/dg_tabulation.html) for more details. We will discuss the other classes as they appear in our examples. See more about class hierarchy in the [Table Hierarchy article](https://insightsengineering.github.io/rtables/latest-tag/articles/dev-guide/dg_table_hierarchy.html). For the moment, we see with `class(spl)` (from the main `do_split` function) that we are dealing with an `AllSplit` object. By calling `showMethods(check_validsplit)` we produce the following: @@ -192,7 +192,7 @@ AllSplit <- function(split_label = "", } ``` -We can also print this information by calling `getClass("AllSplit")` for the general slot definition, or by calling `getClass(spl)`. Note that the first call will give also a lot of information about the class hierarchy. For more information regarding class hierarchy, please refer to the relevant article [here](https://insightsengineering.github.io/rtables/main/articles/dev-guide/dg_talbe_hierarchy.html). We will discuss the majority of the slots by the end of this document. Now, let's see if we can find some of the values described in the constructor within our object. To do so, we will show the more compact representation given by `str`. When there are multiple and hierarchical slots that contain objects themselves, calling `str` will be much less or not at all informative if the maximum level of nesting is not set (e.g. `max.level = 2`). +We can also print this information by calling `getClass("AllSplit")` for the general slot definition, or by calling `getClass(spl)`. Note that the first call will give also a lot of information about the class hierarchy. For more information regarding class hierarchy, please refer to the relevant article [here](https://insightsengineering.github.io/rtables/latest-tag/articles/dev-guide/dg_talbe_hierarchy.html). We will discuss the majority of the slots by the end of this document. Now, let's see if we can find some of the values described in the constructor within our object. To do so, we will show the more compact representation given by `str`. When there are multiple and hierarchical slots that contain objects themselves, calling `str` will be much less or not at all informative if the maximum level of nesting is not set (e.g. `max.level = 2`). ```c # rtables 0.6.2 @@ -601,11 +601,11 @@ function(df, } ``` -There are many pre-made split functions included in `rtables`. A list of these functions can be found in the [Split Functions vignette](https://insightsengineering.github.io/rtables/main/articles/split_functions.html), or via `?split_funcs`. We leave it to the developer to look into how some of these split functions work, in particular `trim_levels_to_map` may be of interest. +There are many pre-made split functions included in `rtables`. A list of these functions can be found in the [Split Functions vignette](https://insightsengineering.github.io/rtables/latest-tag/articles/split_functions.html), or via `?split_funcs`. We leave it to the developer to look into how some of these split functions work, in particular `trim_levels_to_map` may be of interest. ### Creating Custom Split Functions -Now we will create a custom split function. Firstly, we will see how the system manages error messages. For a general understanding of how custom split functions are created, please read the [Custom Split Functions section](https://insightsengineering.github.io/rtables/main/articles/advanced_usage.html#custom-split-functions) of the Advanced Usage vignette or see `?custom_split_funs`. In the following code we use `browser()` to enter our custom split functions. We invite the reader to activate `options(error = recover)` to investigate cases where we encounter an error. Note that you can revert to default behavior by restarting your `R` session, by caching the default option value, or by using `callr` to retrieve the default as follows: `default_opts <- callr::r(function(){options()}); options(error = default_opts$error)`. +Now we will create a custom split function. Firstly, we will see how the system manages error messages. For a general understanding of how custom split functions are created, please read the [Custom Split Functions section](https://insightsengineering.github.io/rtables/latest-tag/articles/advanced_usage.html#custom-split-functions) of the Advanced Usage vignette or see `?custom_split_funs`. In the following code we use `browser()` to enter our custom split functions. We invite the reader to activate `options(error = recover)` to investigate cases where we encounter an error. Note that you can revert to default behavior by restarting your `R` session, by caching the default option value, or by using `callr` to retrieve the default as follows: `default_opts <- callr::r(function(){options()}); options(error = default_opts$error)`. ```{r} # rtables 0.6.2 @@ -693,7 +693,7 @@ It is also possible to provide a list of functions, as it can be seen in the exa #### `.spl_context` - Adding Context to Our Splits -The best way to understand what split context does, and how to use it, is to read the [Leveraging `.spl_context` section](https://insightsengineering.github.io/rtables/main/articles/advanced_usage.html#leveraging--spl_context) of the Advanced Usage vignette, and to use `browser()` within a split function to see how it is structured. As `.spl_context` is needed for rewriting core functions, we propose a wrapper of `do_base_split` here, which is a handy redirection to the standard `do_split` without the split function part (i.e. it is a wrapper of `.apply_split_inner`, the real core splitting machinery). Out of curiosity, we set `trim = TRUE` here. This trimming only works when there is a mixed table (some values are 0s and some have content), for which it will trim 0s. This is rarely the case, and we encourage using the replacement functions `trim_levels_to_group` and `trim_levels_to_map` for trimming. Nowadays, it should even be impossible to set it differently from `trim = FALSE`. +The best way to understand what split context does, and how to use it, is to read the [Leveraging `.spl_context` section](https://insightsengineering.github.io/rtables/latest-tag/articles/advanced_usage.html#leveraging--spl_context) of the Advanced Usage vignette, and to use `browser()` within a split function to see how it is structured. As `.spl_context` is needed for rewriting core functions, we propose a wrapper of `do_base_split` here, which is a handy redirection to the standard `do_split` without the split function part (i.e. it is a wrapper of `.apply_split_inner`, the real core splitting machinery). Out of curiosity, we set `trim = TRUE` here. This trimming only works when there is a mixed table (some values are 0s and some have content), for which it will trim 0s. This is rarely the case, and we encourage using the replacement functions `trim_levels_to_group` and `trim_levels_to_map` for trimming. Nowadays, it should even be impossible to set it differently from `trim = FALSE`. (write an issue informative error for not list xxx). ```{r, eval=FALSE} @@ -750,7 +750,7 @@ Here we can see what the split column variable is (`split`, first column) at thi ### Extra Arguments: `extra_args` -This functionality is well-known and used in the setting of analysis functions (a somewhat complicated example of this can be found in the [Example Complex Analysis Function vignette](https://insightsengineering.github.io/rtables/main/articles/example_analysis_coxreg.html#constructing-the-table)), but we will show here how this can also apply to splits. +This functionality is well-known and used in the setting of analysis functions (a somewhat complicated example of this can be found in the [Example Complex Analysis Function vignette](https://insightsengineering.github.io/rtables/latest-tag/articles/example_analysis_coxreg.html#constructing-the-table)), but we will show here how this can also apply to splits. ```{r, eval=FALSE} # rtables 0.6.2 @@ -905,7 +905,7 @@ tbl For both row split cases (`*_cuts` and `*_cutfun`), we have empty levels that are not dropped. This is to be expected and can be avoided by using a dedicated split function. Intentionally looking at the future split is possible in order to determine if an element is present in it. At the moment it is not possible to add `spl_fun` to dedicated split functions like `split_rows_by_cuts`. -Note that in the previous table we only used `summarize_row_groups`, with no `analyze` calls. This rendered the table nicely, but it is not the standard method to use as `summarize_row_groups` is intended *only* to decorate row groups, i.e. rows with labels. Internally, these rows are called content rows and that is why analysis functions in `summarize_row_groups` are called `cfun` instead of `afun`. Indeed, the tabulation machinery also presents these two differently as is described in the [Tabulation with Row Structure section](https://insightsengineering.github.io/rtables/main/articles/tabulation_concepts.html#tabulation-with-row-structure) of the Tabulation vignette. +Note that in the previous table we only used `summarize_row_groups`, with no `analyze` calls. This rendered the table nicely, but it is not the standard method to use as `summarize_row_groups` is intended *only* to decorate row groups, i.e. rows with labels. Internally, these rows are called content rows and that is why analysis functions in `summarize_row_groups` are called `cfun` instead of `afun`. Indeed, the tabulation machinery also presents these two differently as is described in the [Tabulation with Row Structure section](https://insightsengineering.github.io/rtables/latest-tag/articles/tabulation_concepts.html#tabulation-with-row-structure) of the Tabulation vignette. We can try to construct the split function for cuts manually with `make_split_fun`: diff --git a/vignettes/dev-guide/dg_table_hierarchy.Rmd b/vignettes/dev-guide/dg_table_hierarchy.Rmd index 0232f3861..8b0d342c2 100644 --- a/vignettes/dev-guide/dg_table_hierarchy.Rmd +++ b/vignettes/dev-guide/dg_table_hierarchy.Rmd @@ -13,7 +13,7 @@ knitr::opts_chunk$set(echo = TRUE) ## Disclaimer -This article is intended for use by developers only and will contain low-level explanations of the topics covered. For user-friendly vignettes, please see the [Articles](https://insightsengineering.github.io/rtables/main/articles/index.html) page on the `rtables` website. +This article is intended for use by developers only and will contain low-level explanations of the topics covered. For user-friendly vignettes, please see the [Articles](https://insightsengineering.github.io/rtables/latest-tag/articles/index.html) page on the `rtables` website. Any code or prose which appears in the version of this article on the `main` branch of the repository may reflect a specific state of things that can be more or less recent. This guide describes very important aspects of table hierarchy that are unlikely to change. Regardless, we invite the reader to keep in mind that the current repository code may have drifted from the following material in this document, and it is always the best practice to read the code directly on `main`. diff --git a/vignettes/dev-guide/dg_tabulation.Rmd b/vignettes/dev-guide/dg_tabulation.Rmd index ebc08283f..ead790cfa 100644 --- a/vignettes/dev-guide/dg_tabulation.Rmd +++ b/vignettes/dev-guide/dg_tabulation.Rmd @@ -13,7 +13,7 @@ knitr::opts_chunk$set(echo = TRUE) ## Disclaimer -This article is intended for use by developers only and will contain low-level explanations of the topics covered. For user-friendly vignettes, please see the [Articles](https://insightsengineering.github.io/rtables/main/articles/index.html) page on the `rtables` website. +This article is intended for use by developers only and will contain low-level explanations of the topics covered. For user-friendly vignettes, please see the [Articles](https://insightsengineering.github.io/rtables/latest-tag/articles/index.html) page on the `rtables` website. Any code or prose which appears in the version of this article on the `main` branch of the repository may reflect a specific state of things that can be more or less recent. This guide describes very important aspects of the tabulation process that are unlikely to change. Regardless, we invite the reader to keep in mind that the current repository code may have drifted from the following material in this document, and it is always the best practice to read the code directly on `main`. @@ -23,7 +23,7 @@ Being that this a working document that may be subjected to both deprecation and ## Introduction -Tabulation in `rtables` is a process that takes a pre-defined layout and applies it to data. The layout object, with all of its splits and `analyze`s, can be applied to different data to produce valid tables. This process happens principally within the `tt_dotabulation.R` file and the user-facing function `build_table` that resides in it. We will occasionally use functions and methods that are present in other files, like `colby_construction.R` or `make_subset_expr.R`. We assume the reader is already familiar with the documentation for `build_table`. We suggest reading the [Split Machinery article](https://insightsengineering.github.io/rtables/main/articles/dev-guide/dg_split_machinery.html) prior to this one, as it is instrumental in understanding how the layout object, which is essentially built out of splits, is tabulated when data is supplied. +Tabulation in `rtables` is a process that takes a pre-defined layout and applies it to data. The layout object, with all of its splits and `analyze`s, can be applied to different data to produce valid tables. This process happens principally within the `tt_dotabulation.R` file and the user-facing function `build_table` that resides in it. We will occasionally use functions and methods that are present in other files, like `colby_construction.R` or `make_subset_expr.R`. We assume the reader is already familiar with the documentation for `build_table`. We suggest reading the [Split Machinery article](https://insightsengineering.github.io/rtables/latest-tag/articles/dev-guide/dg_split_machinery.html) prior to this one, as it is instrumental in understanding how the layout object, which is essentially built out of splits, is tabulated when data is supplied. ## Tabulation @@ -65,7 +65,7 @@ lyt@.Data # might not preserve the names # it works only when it is another clas # We suggest doing extensive testing about these behaviors in order to do choose the appropriate one ``` -Along with the various checks and defensive programming, we find `PreDataAxisLayout` which is a virtual class that both row and column layouts inherit from. Virtual classes are handy for group classes that need to share things like labels or functions that need to be applicable to their relative classes. See more information about the `rtables` class hierarchy in the dedicated article [here](https://insightsengineering.github.io/rtables/main/articles/dev-guide/dg_table_hierarchy.html). +Along with the various checks and defensive programming, we find `PreDataAxisLayout` which is a virtual class that both row and column layouts inherit from. Virtual classes are handy for group classes that need to share things like labels or functions that need to be applicable to their relative classes. See more information about the `rtables` class hierarchy in the dedicated article [here](https://insightsengineering.github.io/rtables/latest-tag/articles/dev-guide/dg_table_hierarchy.html). Now, we continue with `build_table`. After the checks, we notice `TreePos()` which is a constructor for an object that retains a representation of the tree position along with split values and labels. This is mainly used by `create_colinfo`, which we enter now with `debugonce(create_colinfo)`. This function creates the object that represents the column splits and everything else that may be related to the columns. In particular, the column counts are calculated in this function. The parameter inputs are as follows: diff --git a/vignettes/exploratory_analysis.Rmd b/vignettes/exploratory_analysis.Rmd index b4f792b92..b9ba0e2ae 100644 --- a/vignettes/exploratory_analysis.Rmd +++ b/vignettes/exploratory_analysis.Rmd @@ -270,5 +270,5 @@ Here is what we have learned in this vignette: As the intended use of `qtable()` is for exploratory data analysis, there is limited functionality for building very complex tables. For details on how to get started with the core `rtables` layout -functionality see the [`introduction`](https://insightsengineering.github.io/rtables/main/articles/introduction.html) +functionality see the [`introduction`](https://insightsengineering.github.io/rtables/latest-tag/articles/introduction.html) vignette. diff --git a/vignettes/introduction.Rmd b/vignettes/introduction.Rmd index 0c0651922..5b03945a3 100644 --- a/vignettes/introduction.Rmd +++ b/vignettes/introduction.Rmd @@ -108,7 +108,7 @@ to tabulation with the `rtables` layout framework, you can use this convenience wrapper to create many types of two-way frequency tables. The purpose of `qtable` is to enable quick exploratory data analysis. See the -[`exploratory_analysis`](https://insightsengineering.github.io/rtables/main/articles/exploratory_analysis.html) vignette for more details. +[`exploratory_analysis`](https://insightsengineering.github.io/rtables/latest-tag/articles/exploratory_analysis.html) vignette for more details. Here is the code to recreate the table above: ```{r} @@ -221,6 +221,9 @@ The first column represents the data in `df` where `df$arm == "A" & df$gender == "Female"` and the second column the data in `df` where `df$arm == "A" & df$gender == "Male"`, and so on. +More information on column structure can be found in the +`col_counts` vignette. + ## Adding Row Structure So far, we have created layouts with analysis and column splitting @@ -383,6 +386,6 @@ In this vignette you have learned: The other vignettes in the `rtables` package will provide more detailed information about the `rtables` package. We recommend that you continue with the -[`tabulation_dplyr`](https://insightsengineering.github.io/rtables/main/articles/tabulation_dplyr.html) +[`tabulation_dplyr`](https://insightsengineering.github.io/rtables/latest-tag/articles/tabulation_dplyr.html) vignette which compares the information derived by the table in this vignette using `dplyr`. diff --git a/vignettes/introspecting_tables.Rmd b/vignettes/introspecting_tables.Rmd index d924142d3..40c4e614b 100644 --- a/vignettes/introspecting_tables.Rmd +++ b/vignettes/introspecting_tables.Rmd @@ -27,9 +27,9 @@ library(dplyr) First, let's set up a simple table. ```{r} -lyt <- basic_table(show_colcounts = TRUE) %>% - split_cols_by("ARMCD") %>% - split_cols_by("STRATA2") %>% +lyt <- basic_table() %>% + split_cols_by("ARMCD", show_colcounts = TRUE, colcount_format = "N=xx") %>% + split_cols_by("STRATA2", show_colcounts = TRUE) %>% split_rows_by("STRATA1") %>% add_overall_col("All") %>% summarize_row_groups() %>% @@ -65,9 +65,17 @@ how we might normally use the `str()` function to interrogate compound nested lists. ```{r} -table_structure(tbl, detail = "row") +table_structure(tbl, detail = "row") # or "subtable" ``` +Similarly, for columns we can see how the tree is structured with the following call: + +```{r} +coltree_structure(tbl) +``` + +Further information about the column structure can be found in the vignette on `col_counts`. + The `make_row_df()` and `make_col_df()` functions each create a `data.frame` with a variety of information about the table's structure. Most useful for introspection purposes are the `label`, `name`, `abs_rownumber`, `path` and `node_class` columns (the remainder of the information in the returned `data.frame` is used for pagination) diff --git a/vignettes/subsetting_tables.Rmd b/vignettes/subsetting_tables.Rmd index 78f194e65..d79e44af3 100644 --- a/vignettes/subsetting_tables.Rmd +++ b/vignettes/subsetting_tables.Rmd @@ -72,7 +72,7 @@ The `[` and `[<-` accessor functions operate largely the same as their rows. Note in general the result of such an ordering is unlikely to be structurally valid. To change the order of values, please read [sorting and - pruning](https://insightsengineering.github.io/rtables/main/articles/sorting_pruning.html) + pruning](https://insightsengineering.github.io/rtables/latest-tag/articles/sorting_pruning.html) vignette or relevant function (`sort_at_path()`). - `character` indices are treated as paths, not vectors of names in both `[` and `[<-` @@ -157,7 +157,7 @@ tbl[1:3, 3, keep_topleft = TRUE] If the referenced entry is present in the subsetting, also the referential footnote will appear. Please consider reading relevant vignette about [referential -footnotes](https://insightsengineering.github.io/rtables/main/articles/title_footer.html#referential-footnotes). In +footnotes](https://insightsengineering.github.io/rtables/latest-tag/articles/title_footer.html#referential-footnotes). In case of subsetting, the referential footnotes are by default indexed again, as if the produced table is a new one. diff --git a/vignettes/tabulation_dplyr.Rmd b/vignettes/tabulation_dplyr.Rmd index 6f6ab44b9..29ab0f871 100644 --- a/vignettes/tabulation_dplyr.Rmd +++ b/vignettes/tabulation_dplyr.Rmd @@ -29,7 +29,7 @@ In this vignette, we would like to discuss the similarities and differences betw Much of the `rtables` framework focuses on tabulation/summarizing of data and then the visualization of the table. In this vignette, we focus on summarizing data using `dplyr` and contrast it to `rtables`. We won't pay attention to the table visualization/markup and just derive the cell content. -Using `dplyr` to summarize data and `gt` to visualize the table is a good way if the tabulation is of a certain nature or complexity. However, there are tables such as the table created in the [`introduction`](https://insightsengineering.github.io/rtables/main/articles/introduction.html) vignette that take some effort to create with `dplyr`. Part of the effort is due to fact that when using `dplyr` the table data is stored in `data.frame`s or `tibble`s which is not the most natural way to represent a table as we will show in this vignette. +Using `dplyr` to summarize data and `gt` to visualize the table is a good way if the tabulation is of a certain nature or complexity. However, there are tables such as the table created in the [`introduction`](https://insightsengineering.github.io/rtables/latest-tag/articles/introduction.html) vignette that take some effort to create with `dplyr`. Part of the effort is due to fact that when using `dplyr` the table data is stored in `data.frame`s or `tibble`s which is not the most natural way to represent a table as we will show in this vignette. If you know a more elegant way of deriving the table content with `dplyr` please let us know and we will update the vignette. @@ -39,7 +39,7 @@ library(rtables) library(dplyr) ``` -Here is the table and data used in the [`introduction`](https://insightsengineering.github.io/rtables/main/articles/introduction.html) vignette: +Here is the table and data used in the [`introduction`](https://insightsengineering.github.io/rtables/latest-tag/articles/introduction.html) vignette: ```{r} n <- 400 @@ -72,7 +72,7 @@ tbl ## Getting Started -We will start by deriving the first data cell on row 3 (note, row 1 and 2 have content cells, see the [`introduction`](https://insightsengineering.github.io/rtables/main/articles/introduction.html) vignette). Cell 3,1 contains the mean age for left handed & female Canadians in "Arm A": +We will start by deriving the first data cell on row 3 (note, row 1 and 2 have content cells, see the [`introduction`](https://insightsengineering.github.io/rtables/latest-tag/articles/introduction.html) vignette). Cell 3,1 contains the mean age for left handed & female Canadians in "Arm A": ```{r} @@ -232,4 +232,4 @@ In this vignette learned that: * if tables have group summaries then repeating of information is required * `rtables` streamlines the construction of complex tables -We recommend that you continue reading the [`clinical_trials`](https://insightsengineering.github.io/rtables/main/articles/clinical_trials.html) vignette where we create a number of more advanced tables using layouts. +We recommend that you continue reading the [`clinical_trials`](https://insightsengineering.github.io/rtables/latest-tag/articles/clinical_trials.html) vignette where we create a number of more advanced tables using layouts.