diff --git a/NAMESPACE b/NAMESPACE index b207dee29..9bcd01a96 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,7 +10,10 @@ 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("fnotes_at_path<-") export("header_section_div<-") export("horizontal_sep<-") @@ -74,6 +77,8 @@ 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(compare_rtables) @@ -91,6 +96,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 +144,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 +215,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 +249,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 +279,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 6e8ccdf3b..e297560bf 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,7 @@ * 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. + * Added Support for displaying column counts for higher-level facets in the column structure, PR from @gmbecker ### 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. diff --git a/R/00tabletrees.R b/R/00tabletrees.R index d80ad5421..56442403e 100644 --- a/R/00tabletrees.R +++ b/R/00tabletrees.R @@ -139,7 +139,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 = "character" ) ) @@ -185,7 +187,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 = "(N=xx)") { child_labels <- match.arg(child_labels) if (is.null(labels_var)) { labels_var <- var @@ -211,7 +215,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 ) } @@ -229,6 +235,8 @@ AllSplit <- function(split_label = "", cindent_mod = 0L, cvar = "", cextra_args = list(), + show_colcounts = FALSE, + colcount_format = "(N=xx)", ...) { if (is.null(split_name)) { if (nzchar(split_label)) { @@ -254,7 +262,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 ) } @@ -277,7 +287,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)" ) } @@ -321,7 +333,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)" ) } @@ -394,7 +408,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 = "(N=xx)") { check_ok_label(split_label) ## no topleft allowed label_pos <- match.arg(label_pos, label_pos_values[-3]) @@ -427,7 +443,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 ) } @@ -480,7 +498,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 = "(N=xx)") { cls <- if (cumulative) "CumulativeCutSplit" else "VarStaticCutSplit" check_ok_label(split_label) @@ -517,7 +537,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 ) } @@ -564,7 +586,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 = "(N=xx)") { check_ok_label(split_label) label_pos <- match.arg(label_pos, label_pos_values) child_labels <- match.arg(child_labels) @@ -588,7 +612,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 ) } @@ -664,7 +690,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 } @@ -708,7 +736,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 } @@ -902,7 +932,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 = "(N=xx)") { check_ok_label(split_label) new("VarLevWBaselineSplit", payload = var, @@ -928,7 +960,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 ) } @@ -1057,11 +1091,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 = "character", + col_footnotes = "list", + column_count = "integer" ) ) @@ -1070,7 +1108,8 @@ setClass("LayoutColTree", representation( display_columncounts = "logical", columncount_format = "character", - col_footnotes = "list" + col_footnotes = "list", + column_count = "integer" ) ) @@ -1082,9 +1121,10 @@ LayoutColTree <- function(lev = 0L, spl = EmptyAllSplit, tpos = TreePos(), summary_function = NULL, - disp_colcounts = FALSE, + disp_ccounts = FALSE, colcount_format = "(N=xx)", - footnotes = list()) { ## , + footnotes = list(), + colcount) { ## , ## sub = expression(TRUE), ## svar = NA_character_, ## slab = NA_character_) { @@ -1105,23 +1145,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 = "(N=xx)") { 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 ) } @@ -1168,7 +1212,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_, diff --git a/R/argument_conventions.R b/R/argument_conventions.R index f004a0fa1..eef043da3 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 d7105a93d..e62df16b3 100644 --- a/R/colby_constructors.R +++ b/R/colby_constructors.R @@ -357,7 +357,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 = "(N=xx)") { ## , if (is.null(ref_group)) { spl <- VarLevelSplit( var = var, @@ -366,7 +368,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( @@ -375,7 +379,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) @@ -569,13 +575,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 = "(N=xx)") { 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) @@ -731,13 +742,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 = "(N=xx)") { 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") @@ -781,13 +796,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 = "(N=xx)") { 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) @@ -798,7 +817,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 = "(N=xx)") { split_cols_by_cutfun( lyt = lyt, var = var, @@ -814,7 +835,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]", @@ -1834,9 +1857,76 @@ manual_cols <- function(..., .lst = list(...)) { label = names(.lst) )) ctree <- splitvec_to_coltree(data.frame(), splvec = splvec, pos = TreePos()) - InstantiatedColumnInfo(treelyt = ctree) + 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. diff --git a/R/make_subset_expr.R b/R/make_subset_expr.R index 71bd2cc46..c3dc8be6f 100644 --- a/R/make_subset_expr.R +++ b/R/make_subset_expr.R @@ -206,7 +206,10 @@ create_colinfo <- function(lyt, df, rtpos = TreePos(), if (is.null(topleft)) { topleft <- top_left(lyt) } - ctree <- coltree(clayout, df = df, rtpos = rtpos) + ## 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) cexprs <- make_col_subsets(ctree, df) colextras <- col_extra_args(ctree) @@ -230,7 +233,7 @@ create_colinfo <- function(lyt, df, rtpos = TreePos(), } 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" } @@ -243,6 +246,9 @@ create_colinfo <- function(lyt, df, rtpos = TreePos(), 0 } else { vec <- try(eval(ex, envir = alt_counts_df), silent = TRUE) + ## likely unneeded now because it happens in splitvec_to_coltree + ## which is called during coltree construction above + ## TODO remove me if (is(vec, "try-error")) { stop(sprintf( paste( diff --git a/R/tree_accessors.R b/R/tree_accessors.R index 8b447db58..581c0545c 100644 --- a/R/tree_accessors.R +++ b/R/tree_accessors.R @@ -1960,14 +1960,14 @@ setMethod( #' @export setGeneric( "coltree", - function(obj, df = NULL, rtpos = TreePos()) standardGeneric("coltree") + function(obj, df = NULL, rtpos = TreePos(), alt_counts_df = df) 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) { if (!is.null(df)) { warning("Ignoring df argument and retrieving already-computed LayoutColTree") } @@ -1979,14 +1979,14 @@ setMethod( #' @export coltree setMethod( "coltree", "PreDataTableLayouts", - function(obj, df, rtpos) coltree(clayout(obj), df, rtpos) + function(obj, df, rtpos, alt_counts_df = df) coltree(clayout(obj), df, rtpos, alt_counts_df = alt_counts_df) ) #' @rdname col_accessors #' @export coltree setMethod( "coltree", "PreDataColLayout", - function(obj, df, rtpos) { + function(obj, df, rtpos, alt_counts_df = df) { obj <- set_def_child_ord(obj, df) kids <- lapply( obj, @@ -1994,7 +1994,8 @@ setMethod( splitvec_to_coltree( df = df, splvec = x, - pos = rtpos + pos = rtpos, + alt_counts_df = alt_counts_df ) } ) @@ -2005,7 +2006,8 @@ setMethod( lev = 0L, kids = kids, tpos = rtpos, - spl = RootSplit() + spl = RootSplit(), + colcount = NROW(alt_counts_df) ) } disp_ccounts(res) <- disp_ccounts(obj) @@ -2017,21 +2019,21 @@ setMethod( #' @export coltree setMethod( "coltree", "LayoutColTree", - function(obj, df, rtpos) obj + function(obj, df, rtpos, alt_counts_df) obj ) #' @rdname col_accessors #' @export coltree setMethod( "coltree", "VTableTree", - function(obj, df, rtpos) coltree(col_info(obj)) + function(obj, df, rtpos, alt_counts_df) 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) coltree(col_info(obj)) ) setGeneric("coltree<-", function(obj, value) standardGeneric("coltree<-")) @@ -2148,7 +2150,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 @@ -2167,7 +2179,25 @@ setGeneric("col_counts<-", function(obj, path = NULL, value) standardGeneric("co setMethod( "col_counts<-", "InstantiatedColumnInfo", function(obj, path = NULL, value) { - obj@counts[.path_to_pos(path, obj, cols = TRUE)] <- 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 } ) @@ -2255,6 +2285,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<-")) @@ -2296,6 +2344,15 @@ setMethod( } ) +#' @rdname int_methods +setMethod( + "disp_ccounts<-", "LayoutColLeaf", + function(obj, value) { + obj@display_columncounts <- value + obj + } +) + #' @rdname int_methods setMethod( "disp_ccounts<-", "PreDataTableLayouts", @@ -2307,6 +2364,305 @@ setMethod( } ) +match_path_by_pos <- function(kidlst, path) { + ret <- -1 + nmval_pairs <- lapply( + kidlst, + function(kd) { + pos <- tree_pos(kd) + c(obj_name(tail(pos_splits(pos), 1)[[1]]), + rawvalues(tail(pos_splvals(pos), 1))[[1]]) + } + ) + + matches <- vapply( + nmval_pairs, + function(pair) { + (pair[1] == path[1]) && (path[2] %in% c(pair[2], "*")) + }, + TRUE + ) + if (any(matches)) + ret <- which(matches) + ret + +} + +## 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, + !anyNA(path) + ) + if (any(grepl("@content", path, fixed = TRUE))) + stop("@content token is not valid for column paths.") + + + ## if(obj_name(obj) == path[1]) { + ## path <- path[-1] + ## } + + cur <- obj + curpath <- path + while (length(curpath) > 0) { + kids <- tree_children(cur) + kidmatch <- match_path_by_pos(kids, curpath) + curname <- curpath[1] + if (curname == "@content") + stop("@content is not a valid token for a column path") + else if (kidmatch > 0) + cur <- kids[[kidmatch]] + else + stop("Path appears invalid for this tree at step ", curname) + curpath <- curpath[-(1:2)] # name and value, both consumed due to structure + } + cur +} + +`coltree_at_path<-` <- function(obj, path, value) { + obj <- coltree(obj) ## noop if it already is + if (any(grepl("@content", path, fixed = TRUE))) + stop("@content token is not valid for column paths.") + ## we don't have intermediary structures in the coltree model + ## **after the first one** Yes this is bad and wrong but + + ## its how it is. + ## ie it goes straight from A: Drug X -> F + ## in the split_cols_by("ARM") %>% split_cols_by("SEX") case + ## but we want to use the do_recursive_replace machinery + ## that is already well tested + trimmed_path <- path[c(1, seq(2, length(path), by = 2))] + + do_recursive_replace(obj, trimmed_path, value = value) +} + + +#' Set visibility of column counts for a group of sibling facets +#' +#' @inheritParams gen_args +#' @param path character. 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 columncount +#' display behavior +`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. +#' +#' @export +#' @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 +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<-", "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")) @@ -2339,6 +2695,14 @@ 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 setGeneric( @@ -2390,6 +2754,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 35e42dab1..c187c5008 100644 --- a/R/tt_compatibility.R +++ b/R/tt_compatibility.R @@ -542,7 +542,7 @@ combine_cinfo <- function(..., new_total = NULL) { ctrees <- lapply(cinfs, coltree) - newctree <- LayoutColTree(kids = ctrees) + newctree <- LayoutColTree(kids = ctrees, colcount = NA_integer_) newcounts <- unlist(lapply(cinfs, col_counts)) if (is.null(new_total)) { new_total <- sum(newcounts) diff --git a/R/tt_dotabulation.R b/R/tt_dotabulation.R index 791b0a9ae..4a39de9b8 100644 --- a/R/tt_dotabulation.R +++ b/R/tt_dotabulation.R @@ -1240,7 +1240,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()." ) } @@ -1353,6 +1353,12 @@ build_table <- function(lyt, df, if (table_inset(lyt) > 0) { table_inset(tab) <- table_inset(lyt) } + if (!is.null(col_counts)) { + toreplace <- !is.na(col_counts) + newccs <- col_counts(tab) ## old actual counts + newccs[toreplace] <- col_counts[toreplace] + col_counts(tab) <- newccs + } tab } @@ -1551,7 +1557,8 @@ 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) { stopifnot( lvl <= length(splvec) + 1L, is(splvec, "SplitVector") @@ -1561,15 +1568,19 @@ 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]] LayoutColLeaf( lev = lvl - 1L, label = label, tpos = pos, - name = nm + name = nm, + colcount = NROW(alt_counts_df), + disp_ccounts = disp_ccounts(spl), + colcount_format = colcount_format(spl) ) } 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 +1596,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) { newprev <- context_df_row( @@ -1595,21 +1606,47 @@ splitvec_to_coltree <- function(df, splvec, pos = NULL, cinfo = NULL ) 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] ) }, dfpart = datparts, value = vals, partlab = labs, SIMPLIFY = FALSE ) + disp_cc <- FALSE + cc_format <- "(N=xx)" + if (lvl > 1) { + disp_cc <- disp_ccounts(splvec[[lvl - 1]]) + cc_format <- colcount_format(splvec[[lvl - 1]]) + } + 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_paginate.R b/R/tt_paginate.R index 4a6eaa37a..6ee2097f1 100644 --- a/R/tt_paginate.R +++ b/R/tt_paginate.R @@ -124,7 +124,9 @@ 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)) { if (is.null(pth)) { pth <- pos_to_path(tree_pos(col)) } @@ -139,7 +141,9 @@ 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 ) } diff --git a/R/tt_toString.R b/R/tt_toString.R index 269e2db46..22ad05a86 100644 --- a/R/tt_toString.R +++ b/R/tt_toString.R @@ -191,6 +191,7 @@ setMethod( expand_newlines = TRUE, indent_size = 2) { 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) @@ -313,6 +314,33 @@ 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))) @@ -427,7 +455,7 @@ get_formatted_fnotes <- function(tt) { remain <- seq_len(nrow(coldf)) chunks <- list() cur <- 1 - + na_str <- colcount_na_str(tt) ## each iteration of this loop identifies ## all rows corresponding to one top-level column ## label and its children, then processes those @@ -438,7 +466,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, ], na_str = na_str) + chunk_res <- unlist(chunk_res, recursive = FALSE) + chunks[[cur]] <- chunk_res remain <- remain[remain > endblock] cur <- cur + 1 } @@ -473,18 +503,19 @@ get_formatted_fnotes <- function(tt) { function(chk) { span <- sum(vapply(chk[[length(chk)]], cell_cspan, 1L)) needed <- padto - length(chk) - c( - replicate(rcell("", colspan = span), + unlist(c( + list(replicate(list(rcell("", colspan = span)), n = needed - ), + )), chk - ) + )) } ) chunks } -.do_header_chunk <- function(coldf) { +.do_header_chunk <- function(coldf, na_str) { + ## hard assumption that coldf is a section ## of a column dataframe summary that was ## created with visible_only=FALSE @@ -495,32 +526,51 @@ 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 + cellii <- rcell( + val, + colspan = rws$total_span[ri], + format = "(N=xx)", + format_na_str = na_str + ) + cellii + } + ) + ret <- c(ret, list(.pad_end(thisbit_ns, padto = nleafcols))) + } + ret } ) - toret } .tbl_header_mat <- function(tt) { + rows <- .do_tbl_h_piece2(tt) ## (clyt) cinfo <- col_info(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) { diff --git a/_pkgdown.yml b/_pkgdown.yml index 52ae63cef..838a3cdad 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -263,6 +263,7 @@ reference: - formatters::main_title - top_left - formatters::obj_name + - matches("colcount") - title: TableTree Framework Constructors and S4 Classes desc: S4 classes and constructors diff --git a/inst/WORDLIST b/inst/WORDLIST index 0274737d2..ece47f93b 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,87 +1,83 @@ -Bové -CRAN's +amongst +Arg 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 -Yung -amongst -charset combinatorial +CRAN's customizations -de decrementing dimensioned dplyr emph facetted facetting -flextable +FFFL formatter -funder -funs getter getters +Godwin +Heng ing initializer +integerish iteratively +Kelkhoff labelled +Layouting layouting +Lewandowski mandatorily +Maximo +Modelling multivariable +NSE orderable -params +Paszty pathing +Pharma +Phuse postfix +Postprocessing postprocessing +Pre pre priori programmatically +Qi quartiles reindexed repo repped responder +Resync reusability roadmap +RStudio +rtables +Saibah sortable spl -subsplits +Stoilova +STUDYID +Subtable subtable subtable's +Subtables subtables summarization tableone +TableTree +Tadeusz todo unaggregated unicode univariable +unnested unpruned +Unstratified unstratified useR xtable +Yung diff --git a/man/MultiVarSplit.Rd b/man/MultiVarSplit.Rd index 149ce8642..c7a66fa69 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 = "(N=xx)" ) } \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..be98d7815 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 = "(N=xx)" ) 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 = "(N=xx)" ) } \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/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..8a719daa9 100644 --- a/man/col_accessors.Rd +++ b/man/col_accessors.Rd @@ -62,19 +62,19 @@ col_info(obj) <- value \S4method{col_info}{TableTree}(obj) <- value -coltree(obj, df = NULL, rtpos = TreePos()) +coltree(obj, df = NULL, rtpos = TreePos(), alt_counts_df = df) -\S4method{coltree}{InstantiatedColumnInfo}(obj, df = NULL, rtpos = TreePos()) +\S4method{coltree}{InstantiatedColumnInfo}(obj, df = NULL, rtpos = TreePos(), alt_counts_df = df) -\S4method{coltree}{PreDataTableLayouts}(obj, df = NULL, rtpos = TreePos()) +\S4method{coltree}{PreDataTableLayouts}(obj, df = NULL, rtpos = TreePos(), alt_counts_df = df) -\S4method{coltree}{PreDataColLayout}(obj, df = NULL, rtpos = TreePos()) +\S4method{coltree}{PreDataColLayout}(obj, df = NULL, rtpos = TreePos(), alt_counts_df = df) -\S4method{coltree}{LayoutColTree}(obj, df = NULL, rtpos = TreePos()) +\S4method{coltree}{LayoutColTree}(obj, df = NULL, rtpos = TreePos(), alt_counts_df = df) -\S4method{coltree}{VTableTree}(obj, df = NULL, rtpos = TreePos()) +\S4method{coltree}{VTableTree}(obj, df = NULL, rtpos = TreePos(), alt_counts_df = df) -\S4method{coltree}{TableRow}(obj, df = NULL, rtpos = TreePos()) +\S4method{coltree}{TableRow}(obj, df = NULL, rtpos = TreePos(), alt_counts_df = df) col_exprs(obj, df = NULL) @@ -120,6 +120,9 @@ 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{path}{(\code{character} or \code{NULL})\cr \code{col_counts} accessor and setter only. Path (in column structure).} } diff --git a/man/colcount_visible.Rd b/man/colcount_visible.Rd new file mode 100644 index 000000000..678bb6861 --- /dev/null +++ b/man/colcount_visible.Rd @@ -0,0 +1,50 @@ +% 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<-,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}{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/cutsplits.Rd b/man/cutsplits.Rd index edf7de855..195c85f7d 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 = "(N=xx)" ) 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 = "(N=xx)" ) } \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..2f1bc97ce --- /dev/null +++ b/man/facet_colcount.Rd @@ -0,0 +1,86 @@ +% 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 +} diff --git a/man/facet_colcounts_visible-set.Rd b/man/facet_colcounts_visible-set.Rd new file mode 100644 index 000000000..c62417e3c --- /dev/null +++ b/man/facet_colcounts_visible-set.Rd @@ -0,0 +1,24 @@ +% 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}{character. 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 columncount +display behavior +} +\description{ +Set visibility of column counts for a group of sibling facets +} diff --git a/man/int_methods.Rd b/man/int_methods.Rd index a34c1a74b..6cae7de48 100644 --- a/man/int_methods.Rd +++ b/man/int_methods.Rd @@ -270,22 +270,34 @@ \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<-} \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} @@ -931,6 +943,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 @@ -941,8 +959,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) @@ -953,6 +975,8 @@ colcount_format(obj) \S4method{colcount_format}{PreDataTableLayouts}(obj) +\S4method{colcount_format}{Split}(obj) + colcount_format(obj) <- value \S4method{colcount_format}{InstantiatedColumnInfo}(obj) <- value @@ -963,6 +987,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") @@ -1165,6 +1201,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 @@ -1178,9 +1217,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..7657a0157 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/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/split_cols_by.Rd b/man/split_cols_by.Rd index 6c59c0c7c..d82b0bc20 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 = "(N=xx)" ) } \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..9a454689a 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 = "(N=xx)" ) } \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..8e88af9b5 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 = "(N=xx)" ) 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 = "(N=xx)" ) 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 = "(N=xx)" ) 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-printing.R b/tests/testthat/test-printing.R index 15de7d526..8a76771be 100644 --- a/tests/testthat/test-printing.R +++ b/tests/testthat/test-printing.R @@ -785,3 +785,69 @@ 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) + cwds <- rep(8, ncol(tbl) + 1) + expect_equal(nlines(col_info(tbl), colwidths = cwds), 7) + mpf <- matrix_form(tbl, TRUE) + mpf <- formatters:::do_cell_fnotes_wrap(mpf, cwds, NULL, FALSE) + 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 + 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)) +})