diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 7253d6713..149cf22ec 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -6,11 +6,11 @@ default_language_version: python: python3 repos: - repo: https://github.com/lorenzwalthert/precommit - rev: v0.4.3.9021 + rev: v0.4.3.9025 hooks: - id: roxygenize additional_dependencies: - - insightsengineering/formatters + - formatters - magrittr - methods - checkmate @@ -18,6 +18,7 @@ repos: - lifecycle - stats - stringi + - roxygen2 - id: use-tidy-description - id: spell-check exclude: > diff --git a/DESCRIPTION b/DESCRIPTION index ca7224b58..7be56a64f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -67,7 +67,6 @@ Config/Needs/verdepcheck: insightsengineering/formatters, davidgohel/officer, Merck/r2rtf, rstudio/rmarkdown, therneau/survival, r-lib/testthat, tidyverse/tibble, tidyverse/tidyr, r-lib/withr, r-lib/xml2 -Config/roxygen2/version: 8.0.0 Encoding: UTF-8 Language: en-US LazyData: true @@ -105,3 +104,4 @@ Collate: 'tt_from_df.R' 'validate_table_struct.R' 'zzz_constants.R' +Config/roxygen2/version: 8.0.0 diff --git a/NAMESPACE b/NAMESPACE index f92c9b074..a300067a1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +S3method(c,RowsVerticalSection) S3method(print,CellValue) S3method(print,RowsVerticalSection) export("cell_footnotes<-") diff --git a/NEWS.md b/NEWS.md index 405f05731..f8d2a1f9a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,26 @@ ## rtables 0.6.16.9001 ### New Features - * Added `restrict_facets` function factory for use with `make_split_fun` - * Exportd previously internal `make_subset_expr` for use when constructing custom splitting behavior + * Added `restrict_facets` function factory for use with `make_split_fun` @gmbecker + * Exported previously internal `make_subset_expr` for use when constructing custom splitting behavior + * Added accessor methods for RowsVerticalSection objects: `row_cells`, `obj_format`, `obj_format<-`, `obj_na_str`, `obj_na_str<-`, `cell_values` + * Added `c` method for directly combining `RowsVerticalSection` objects + * Added vignette: Guided Tour (Advanced) @gmbecker + * Added vignette: Guided Tour (Advanced) - Custom Analysis And Summary Functions @gmbecker + * Added vignette: Guided Tour (Advanced) - Analysis Functions - Split Context @gmbecker + * Added vignette: Guided Tour (Advanced) - Analysis Functions - Combining Existing `afun`s @gmbecker + * Added vignette: Guided Tour (Advanced) - Analysis Functions - (stub) Useful Building Blocks @gmbecker + * Added vignette: Guided Tour (Advanced) - Custom Split Functions @gmbecker + * Added vignette: Guided Tour (Advanced) - Custom Split Functions - (stub) `make_split_fun` @gmbecker + * Added vignette: Guided Tour (Advanced) - Custom Split Functions - Behavioral Building Block @gmbecker + * Added vignette: Guided Tour (Advanced) - Custom Split Functions - (stub) Worked Examples @gmbecker + * Added vignette: Guided Tour (Advanced) - (stub) `TableTree` Objects @gmbecker + * Added vignette: Guided Tour (Advanced) - (stub) `TableTree` Objects - (stub) Accessing Table Values @gmbecker + * Added vignette: Guided Tour (Advanced) - (stub) `TableTree` Objects - (stub) Custom Scoring Functions For Sorting @gmbecker + * Added vignette: Guided Tour (Advanced) - (stub) `TableTree` Objects - (stub) Custom Pruning Functions @gmbecker + +### Bug Fixes + * `obj_na_str<-` RowsVerticalSection method now correctly recycles length 1 values @gmbecker ## rtables 0.6.15 diff --git a/R/00tabletrees.R b/R/00tabletrees.R index a3493ee5e..1fea2b86e 100644 --- a/R/00tabletrees.R +++ b/R/00tabletrees.R @@ -2182,6 +2182,43 @@ print.RowsVerticalSection <- function(x, ...) { invisible(x) } +#' Combine RowsVerticalSection objects +#' Combine two or more RowsVerticalSection objects (as returned +#' by [in_rows()]) into a single object +#' +#' @param ... RowsVerticalSection objects +#' @returns A single RowsVerticalSection object containing all +#' row sections from the objects passed to `...` +#' @export +c.RowsVerticalSection <- function(...) { + lst <- list(...) + if (!all(vapply(lst, function(x) inherits(x, "RowsVerticalSection"), TRUE))) { + stop("Cannot use c() to combine RowsVerticalSection objects with objects of other classes") + } + + out <- NextMethod(generic = "c") + out <- RowsVerticalSection( + out, + names = comb_attr_w_dflt(lst, "row_names"), + labels = comb_attr_w_dflt(lst, "row_labels"), + indent_mods = comb_attr_w_dflt(lst, "indent_mods", 0L), + formats = comb_attr_w_dflt(lst, "row_formats", "xx"), + footnotes = comb_attr_w_dflt(lst, "row_footnotes"), + format_na_strs = comb_attr_w_dflt(lst, "row_na_strs", NA_character_) + ) + out +} + +comb_attr_w_dflt <- function(lst, attrname, dflt = NULL) { + unlist( + lapply(lst, function(x) { + attr(x, attrname, exact = TRUE) %||% rep(dflt, length(x)) + }), + recursive = FALSE, + use.names = FALSE + ) +} + #### Empty default objects to avoid repeated calls ## EmptyColInfo <- InstantiatedColumnInfo() ## EmptyElTable <- ElementaryTable() diff --git a/R/make_split_fun.R b/R/make_split_fun.R index bf7812fac..e2dea8b45 100644 --- a/R/make_split_fun.R +++ b/R/make_split_fun.R @@ -394,7 +394,7 @@ add_overall_facet <- function(name, label, extra = list()) { #' #' @param innervar (`character`)\cr the variable(s) to trim (remove unobserved levels) independently within each facet. #' -#' @return A function suitable for use in the `pre` (list) argument of `make_split_fun`. +#' @return A function suitable for use in the `post` (list) argument of `make_split_fun`. #' #' @seealso [make_split_fun()] #' diff --git a/R/tree_accessors.R b/R/tree_accessors.R index 70efe6f2a..04a815a2d 100644 --- a/R/tree_accessors.R +++ b/R/tree_accessors.R @@ -999,6 +999,10 @@ setGeneric("row_cells", function(obj) standardGeneric("row_cells")) #' @exportMethod row_cells setMethod("row_cells", "TableRow", function(obj) obj@leaf_value) +#' @rdname row_accessors +#' @exportMethod row_cells +setMethod("row_cells", "RowsVerticalSection", function(obj) as(obj, "list", strict = TRUE)) + #' @rdname row_accessors setGeneric("row_cells<-", function(obj, value) standardGeneric("row_cells<-")) @@ -1017,7 +1021,6 @@ setGeneric("row_values", function(obj) standardGeneric("row_values")) #' @exportMethod row_values setMethod("row_values", "TableRow", function(obj) rawvalues(obj@leaf_value)) - #' @rdname row_accessors #' @exportMethod row_values<- setGeneric("row_values<-", function(obj, value) standardGeneric("row_values<-")) @@ -1153,6 +1156,10 @@ setMethod("obj_format", "CellValue", function(obj) attr(obj, "format", exact = T #' @export setMethod("obj_format", "Split", function(obj) obj@split_format) +#' @rdname formatters_methods +#' @export +setMethod("obj_format", "RowsVerticalSection", function(obj) attr(obj, "row_formats", exact = TRUE)) + #' @rdname formatters_methods #' @export setMethod("obj_format<-", "VTableNodeInfo", function(obj, value) { @@ -1160,6 +1167,7 @@ setMethod("obj_format<-", "VTableNodeInfo", function(obj, value) { obj }) + #' @rdname formatters_methods #' @export setMethod("obj_format<-", "Split", function(obj, value) { @@ -1174,6 +1182,13 @@ setMethod("obj_format<-", "CellValue", function(obj, value) { obj }) +#' @rdname formatters_methods +#' @export +setMethod("obj_format<-", "RowsVerticalSection", function(obj, value) { + attr(obj, "row_formats") <- value + obj +}) + #' @rdname int_methods #' @export setMethod("obj_na_str<-", "CellValue", function(obj, value) { @@ -1181,6 +1196,13 @@ setMethod("obj_na_str<-", "CellValue", function(obj, value) { obj }) +#' @rdname int_methods +#' @export +setMethod("obj_na_str<-", "RowsVerticalSection", function(obj, value) { + attr(obj, "row_na_strs") <- value + obj +}) + #' @rdname int_methods #' @export setMethod("obj_na_str<-", "VTableNodeInfo", function(obj, value) { @@ -1199,6 +1221,10 @@ setMethod("obj_na_str<-", "Split", function(obj, value) { #' @export setMethod("obj_na_str", "VTableNodeInfo", function(obj) obj@na_str) +#' @rdname int_methods +#' @export +setMethod("obj_na_str", "RowsVerticalSection", function(obj) attr(obj, "row_na_strs", exact = TRUE)) + #' @rdname formatters_methods #' @export setMethod("obj_na_str", "Split", function(obj) obj@split_na_str) @@ -1678,7 +1704,7 @@ setMethod( "must have length 1 or the number of rows" ) } - attr(obj, "indent_mods") <- as.integer(value) + attr(obj, "indent_mods") <- rep(as.integer(value), length.out = length(obj)) obj ## obj@indent_mods <- value diff --git a/R/tt_pos_and_access.R b/R/tt_pos_and_access.R index f79a45eb3..7aeec7e7c 100644 --- a/R/tt_pos_and_access.R +++ b/R/tt_pos_and_access.R @@ -1584,6 +1584,14 @@ setMethod( } ) +#' @rdname int_methods +#' @keywords internal +#' @exportMethod cell_values +setMethod( + "cell_values", "RowsVerticalSection", + function(tt, rowpath, colpath = NULL, omit_labrows = TRUE) rawvalues(tt) +) + #' @rdname int_methods #' @keywords internal #' @exportMethod cell_values diff --git a/_pkgdown.yml b/_pkgdown.yml index 3191ece3d..640e872e7 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -68,6 +68,19 @@ articles: - guided_intermediate_translating_shells - guided_intermediate_afun_reqs - guided_intermediate_split_reqs + - guided_advanced + - guided_advanced_afuns + - guided_advanced_afuns_spl_context + - guided_advanced_afuns_rowsverticalsection + - guided_advanced_afuns_building_blocks + - guided_advanced_split_funs + - guided_advanced_split_funs_make_split_fun + - guided_advanced_split_funs_new_bbbs + - guided_advanced_split_funs_worked_ex + - guided_advanced_tt + - guided_advanced_tt_access + - guided_advanced_tt_score_funs + - guided_advanced_tt_prune_funs - title: Clinical Trials navbar: Clinical Trials @@ -323,3 +336,4 @@ reference: - length,CellValue-method - names,VTableNodeInfo-method - insert_rrow + - c.RowsVerticalSection diff --git a/inst/WORDLIST b/inst/WORDLIST index 632e83e43..38801e409 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -7,6 +7,7 @@ amongst ARD ard ARDs +BBBs biomarker BMEASIFL Bov @@ -80,6 +81,7 @@ responder Resync reusability roadmap +RowsVerticalSection RStudio rtables Rua diff --git a/man/c.RowsVerticalSection.Rd b/man/c.RowsVerticalSection.Rd new file mode 100644 index 000000000..ffe530003 --- /dev/null +++ b/man/c.RowsVerticalSection.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/00tabletrees.R +\name{c.RowsVerticalSection} +\alias{c.RowsVerticalSection} +\title{Combine RowsVerticalSection objects +Combine two or more RowsVerticalSection objects (as returned +by \code{\link[=in_rows]{in_rows()}}) into a single object} +\usage{ +\method{c}{RowsVerticalSection}(...) +} +\arguments{ +\item{...}{RowsVerticalSection objects} +} +\value{ +A single RowsVerticalSection object containing all +row sections from the objects passed to \code{...} +} +\description{ +Combine RowsVerticalSection objects +Combine two or more RowsVerticalSection objects (as returned +by \code{\link[=in_rows]{in_rows()}}) into a single object +} diff --git a/man/formatters_methods.Rd b/man/formatters_methods.Rd index e9829a39e..9477c4da9 100644 --- a/man/formatters_methods.Rd +++ b/man/formatters_methods.Rd @@ -17,9 +17,11 @@ \alias{obj_format,VTableNodeInfo-method} \alias{obj_format,CellValue-method} \alias{obj_format,Split-method} +\alias{obj_format,RowsVerticalSection-method} \alias{obj_format<-,VTableNodeInfo-method} \alias{obj_format<-,Split-method} \alias{obj_format<-,CellValue-method} +\alias{obj_format<-,RowsVerticalSection-method} \alias{obj_na_str,Split-method} \alias{main_title,VTitleFooter-method} \alias{main_title<-,VTitleFooter-method} @@ -86,12 +88,16 @@ \S4method{obj_format}{Split}(obj) +\S4method{obj_format}{RowsVerticalSection}(obj) + \S4method{obj_format}{VTableNodeInfo}(obj) <- value \S4method{obj_format}{Split}(obj) <- value \S4method{obj_format}{CellValue}(obj) <- value +\S4method{obj_format}{RowsVerticalSection}(obj) <- value + \S4method{obj_na_str}{Split}(obj) \S4method{main_title}{VTitleFooter}(obj) diff --git a/man/int_methods.Rd b/man/int_methods.Rd index 31bad1aec..0b13ebddf 100644 --- a/man/int_methods.Rd +++ b/man/int_methods.Rd @@ -181,9 +181,11 @@ \alias{spanned_values<-,TableRow-method} \alias{spanned_values<-,LabelRow-method} \alias{obj_na_str<-,CellValue-method} +\alias{obj_na_str<-,RowsVerticalSection-method} \alias{obj_na_str<-,VTableNodeInfo-method} \alias{obj_na_str<-,Split-method} \alias{obj_na_str,VTableNodeInfo-method} +\alias{obj_na_str,RowsVerticalSection-method} \alias{set_format_recursive} \alias{set_format_recursive,TableRow-method} \alias{set_format_recursive,LabelRow-method} @@ -382,6 +384,7 @@ \alias{[,VTableTree,missing,numeric-method} \alias{[,VTableTree,numeric,numeric-method} \alias{cell_values,VTableTree-method} +\alias{cell_values,RowsVerticalSection-method} \alias{cell_values,TableRow-method} \alias{cell_values,LabelRow-method} \alias{value_at,TableRow-method} @@ -792,12 +795,16 @@ spanned_values(obj) <- value \S4method{obj_na_str}{CellValue}(obj) <- value +\S4method{obj_na_str}{RowsVerticalSection}(obj) <- value + \S4method{obj_na_str}{VTableNodeInfo}(obj) <- value \S4method{obj_na_str}{Split}(obj) <- value \S4method{obj_na_str}{VTableNodeInfo}(obj) +\S4method{obj_na_str}{RowsVerticalSection}(obj) + set_format_recursive(obj, format, na_str, override = FALSE) \S4method{set_format_recursive}{TableRow}(obj, format, na_str, override = FALSE) @@ -1194,6 +1201,8 @@ obj_stat_names(obj) <- value \S4method{cell_values}{VTableTree}(tt, rowpath = NULL, colpath = NULL, omit_labrows = TRUE) +\S4method{cell_values}{RowsVerticalSection}(tt, rowpath = NULL, colpath = NULL, omit_labrows = TRUE) + \S4method{cell_values}{TableRow}(tt, rowpath = NULL, colpath = NULL, omit_labrows = TRUE) \S4method{cell_values}{LabelRow}(tt, rowpath = NULL, colpath = NULL, omit_labrows = TRUE) diff --git a/man/row_accessors.Rd b/man/row_accessors.Rd index 479c192d3..08eef9db0 100644 --- a/man/row_accessors.Rd +++ b/man/row_accessors.Rd @@ -6,6 +6,7 @@ \alias{obj_avar,ElementaryTable-method} \alias{row_cells} \alias{row_cells,TableRow-method} +\alias{row_cells,RowsVerticalSection-method} \alias{row_cells<-} \alias{row_cells<-,TableRow-method} \alias{row_values} @@ -25,6 +26,8 @@ row_cells(obj) \S4method{row_cells}{TableRow}(obj) +\S4method{row_cells}{RowsVerticalSection}(obj) + row_cells(obj) <- value \S4method{row_cells}{TableRow}(obj) <- value diff --git a/man/trim_levels_in_facets.Rd b/man/trim_levels_in_facets.Rd index 89e6fd342..ba53da7ed 100644 --- a/man/trim_levels_in_facets.Rd +++ b/man/trim_levels_in_facets.Rd @@ -10,7 +10,7 @@ trim_levels_in_facets(innervar) \item{innervar}{(\code{character})\cr the variable(s) to trim (remove unobserved levels) independently within each facet.} } \value{ -A function suitable for use in the \code{pre} (list) argument of \code{make_split_fun}. +A function suitable for use in the \code{post} (list) argument of \code{make_split_fun}. } \description{ Trim levels of another variable from each facet (post-processing split step) diff --git a/vignettes/analysis_basics_a.png b/vignettes/analysis_basics_a.png new file mode 100644 index 000000000..fe225a376 Binary files /dev/null and b/vignettes/analysis_basics_a.png differ diff --git a/vignettes/guided_advanced.Rmd b/vignettes/guided_advanced.Rmd new file mode 100644 index 000000000..86b1423a8 --- /dev/null +++ b/vignettes/guided_advanced.Rmd @@ -0,0 +1,108 @@ +--- +title: "A Guided Tour of rtables - Advanced" +subtitle: Contributed by Johnson & Johnson Innovative Medicine +date: "2025-12-27" +author: +- Gabriel Becker +- Dan Hofstaedter +output: + rmarkdown::html_document: + theme: "spacelab" + highlight: "kate" + toc: true + toc_float: true +vignette: > + %\VignetteIndexEntry{A Guided Tour of rtables - Advanced} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + markdown: + wrap: 72 + chunk_output_type: console +--- + +```{r, include = FALSE} +suggested_dependent_pkgs <- c("dplyr") +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval = all(vapply( + suggested_dependent_pkgs, + requireNamespace, + logical(1), + quietly = TRUE + )) +) +``` + +```{r, echo=FALSE} +knitr::opts_chunk$set(comment = "#") +``` + + +# Scope and Audience + + +We saw in the previous [intermediate](./guided_intermediate.html) +portion of this tour that a well engineered library of analysis, group +summary, and split functions can combine to support a massive array of +different individual tables. Whether we are tasked with maintaining +and extending those libraries or simply with creating custom tables +outside of that supported space, we sometimes need to write new custom +functions. By the end of this portion of the tour we will have the +tools necessary to do that. While gaining those tools, we will also +become more familiar with the structure of `TableTree` objects (how +`rtables` models tables) and how to interact with them once they are +created. + +Upon learning the material in this portion of the training, users will +be able to fully exploit the flexibility and power of the `rtables` +layout and table engines to create virtually any desired table in +cases when their existing function library falls short. + + +# Chapters + +- [Custom Analysis and Group Summary + Functions](./guided_advanced_afuns.html) Core concepts for creating + custom analysis and group summary functions + - [Structure-Conditional Behavior In `afun`s With `.spl_context`](./guided_advanced_afuns_spl_context.html) + Creating `afun`/`cfun` behavior conditional on location within the + table structure using `.spl_context` and other optional arguments. + - [Calling Existing `afun`s Within Custom `afun`s](./guided_advanced_afuns_rowsverticalsection.html) Details + about what `in_rows` returns and how we can use that to wrap or + combine existing `afun`s or `cfun`s + - [Useful Behavioral Building Blocks For Complex Custom + `afun`s](./guided_advanced_afuns_building_blocks.html) Examples of + prototypical behaviors which can be reused and combined when + writing custom `afun`s +- [Custom Split Functions](./guided_advanced_split_funs.html) Core + concepts for creating custom split functions + - [Using `make_split_fun` Effectively](./guided_advanced_split_funs_make_split_fun.html) `make_split_fun` and + recognizing when to specify `pre`, `core`, and `post` behavior + customizations + - [Using And Combining Provided Behavior Building + Blocks](./guided_advanced_split_funs_bbbs.html) The split function + behavior building blocks provided by `rtables` and how to use and + combine them + - [Writing Reusable Behavior Building + Blocks](./guided_advanced_split_funs_new_bbbs.html) Writing new + custom split function behaviors so that they are reusable + - [Some Complex Worked + Examples](./guided_advanced_split_funs_worked_ex.html) Combining + these topics to create complex custom split functions +- [Understanding and Interacting With `TableTree` + Objects](./guided_advanced_tt.html) Understanding how `rtables` + models tables and how to interact with them after creation + - [Table Structure and Pathing](./pathing.html) Table structure and + describing locations within a table via pathing (existing + vignette) + - [Accessing Values Within A + Table](./guided_advanced_tt_access.html) Retrieving values + from a table + - [Writing Custom Scoring Functions For + Sorting](./guided_advanced_tt_score_funs.html) Writing custom + scoring functions for use with `sort_at_path` + - [Writing Custom Pruning + Functions](./guided_advanced_tt_prune_funs.html) Writing custom + pruning functions for use with `prune_table` diff --git a/vignettes/guided_advanced_afuns.Rmd b/vignettes/guided_advanced_afuns.Rmd new file mode 100644 index 000000000..df2dbc2d7 --- /dev/null +++ b/vignettes/guided_advanced_afuns.Rmd @@ -0,0 +1,195 @@ +--- +title: "Advanced rtables - Custom Analysis and Group Summary Functions" +subtitle: Contributed by Johnson & Johnson Innovative Medicine +date: "2025-10-22" +author: +- Gabriel Becker +- Dan Hofstaedter +output: + rmarkdown::html_document: + theme: "spacelab" + highlight: "kate" + toc: true + toc_float: true + code_folding: show +vignette: > + %\VignetteIndexEntry{Advanced rtables - Custom Analysis and Group Summary Functions} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + markdown: + wrap: 72 + chunk_output_type: console +--- + +```{r, include = FALSE} +suggested_dependent_pkgs <- c("dplyr") +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval = all(vapply( + suggested_dependent_pkgs, + requireNamespace, + logical(1), + quietly = TRUE + )) +) +``` + +```{r, echo=FALSE} +knitr::opts_chunk$set(comment = "#") +``` + +# Analysis and Group Summary Function Review + +During table creation, `rtables` calculates the contents for rows in +normal and marginal summary rows by calling analysis an group summary +functions, respectively, on the relevant facet data. Thus, while the +`split_row_by*` and `split_cols_by*` functions allow us to declare the +*structure* of our desired table, the `analyze` and +`summarize_row_groups` functions, via arguments `afun` and `cfun`, +respectively, allow us to declare the contents to appear in each +structural facet of our desired table. + +![](./analysis_basics_a.png) + +Key points to recall about `a/cfun`s: + +- First argument must be `x` or `df` + - `x` will be passed a *facet data vector* for the variable (column) being analyzed/summarized + - `df` will be passed the full *facet data frame* containing all columns of the data subset for the facet +- Can accept optional *special* arguments which will be populated by `rtables` during tabulation + - Values of these arguments cannot currently be overridden by the user +- Can accept additional (non-*special*) arguments as desired + - These can be passed via the `extra_args` argument to `analyze`/`summarize_row_groups` +- Should return the result of calling `in_rows` (a `RowsVerticalSection` object) +- Only difference between `afun`s and `cfun`s is that the latter must accept `labelstr` as the second argument + - `labelstr` will be automatically populated with the label for the + facet being summarized for a `cfun` and not passed to functions + used as an `afun` + + +# General Analysis/Summary Function Structure + +Due to the last key point listed above, we can template a function +that can be used as both an analysis and summary function: + +```{r} +library(rtables) + +template_acfun <- function(x, + labelstr = NULL, + ## , + ## , + ...) { + if (is.null(labelstr)) { + ## 'calculate' label(s) for afun-usage case + lbl <- "cool label, bro" + } else { + ## calculate label(s) from labelstr for cfun-usage case + lbl <- labelstr + } + + ## whatever calculations we want + out <- rcell(sample(c("what?", "huh?", "eh?"), 1), format = "xx") + + ## return our value(s) via in_rows + in_rows(.list = list(ok = out), .labels = c(ok = lbl)) +} +``` + +We can then use this function in either capacity: + +```{r} +lyt <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("STRATA1", split_fun = keep_split_levels(c("A", "B"))) |> + summarize_row_groups("STRATA1", cfun = template_acfun) |> + split_rows_by("SEX", split_fun = keep_split_levels(c("F", "M"))) |> + summarize_row_groups("SEX", cfun = template_acfun) |> + analyze("AGE", afun = template_acfun) + +build_table(lyt, ex_adsl) +``` + +In light of the above, we will - without loss of generality - discuss +analysis functions exclusively for the remainder of this guide with +the exception of any situation where the difference is specifically +relevant. + +# Arguments To Analysis Functions + +Beyond `.spl_context`, which is covered in detail on its own in the next section of this guide, the special arguments (again: those that `rtables` will populate itself during tabulation) can be categorized into three rough, somewhat overlapping groups: + +- Marginal Counts +- Facet Data +- Reference Group Information + +## `afun` Special Arguments: Marginal Counts + +Among special `afun` arguments supported by `rtables`, those which +supply marginal counts are the most straightforward. That said, some +care is warranted to ensure we understand the values our function will +receive, particularly in the cases of `.N_row` and `.N_total`, as we +will see. + +#### Marginal Column and Row Counts (`.N_col` and `.N_row`) + +`.N_col` will receive the column count - as understood by the +`rtables` machinery - for the individual column our analysis function +is currently being applied within. `.N_row` meanwhile, will receive a +row count of the facet data for the (full) row facet our function is +being applied to. + +When an `alt_counts_df` is provided in the call to `build_table` +`.N_col` will receive a count calculated based on that data frame, the +same as the column counts which can be optionally displayed when +rendering our tables. + +Unlike `.N_col`, however, `.N_row` will ***always receive a count +based on the primary data (`df`) passed to `build_table`***. Thus in +the common case of `df` being e.g., an `ADAE` dataset representing +individual events while `alt_counts_df` is the corresponding `ADSL` +dataset corresponding to subjects/patients, `.N_row` will receive a +count of *events*, while `.N_col` will receive a count of +*subjects*. This is due to the fact that `alt_counts_df` is required +to contain the variables necessary for all column splitting in our +layout, it *is not* required to contain all variables necessary for +the row splitting. + + +#### Other Marginal Count Special Argument + +`.all_col_counts` will receive the full vector of individual column +counts regardless of which column our `afun` is operating within. Like +`.N_col`, these counts will be based on `alt_counts_df` when it is +specified within the call to `build_table`. + +***It is not advised to use `N_total`.*** Its current implementation +effectively returns the sum of all column counts; while this will be +correct for tables with simple column structure, it does not take into +account partially or fully overlapping columns and will be incorrect +when those are present in the table structure. In the next chapter of +this guide we will use the split context (`.spl_context`) to derive a +robust equivalent to `.N_total` as a way of illustrating some of the +information the split context provides. + + + + + + + +# Further Topics On Creating Custom Analysis Functions + + - [Structure-Conditional Behavior In `afun`s With + `.spl_context`](./guided_advanced_afuns_spl_context.html) Creating + `afun`/`cfun` behavior conditional on location within the table + structure using `.spl_context` and other optional arguments. + - [Calling Existing `afun`s Within Custom `afun`s](./guided_advanced_afuns_rowsverticalsection.html) Details + about what `in_rows` returns and how we can use that to wrap or + combine existing `afun`s or `cfun`s + - [Useful Behavioral Building Blocks For Complex Custom + `afun`s](./guided_advanced_afuns_building_blocks.html) Examples of + prototypical behaviors which can be reused and combined when + writing custom `afun`s diff --git a/vignettes/guided_advanced_afuns_building_blocks.Rmd b/vignettes/guided_advanced_afuns_building_blocks.Rmd new file mode 100644 index 000000000..5c58be0e5 --- /dev/null +++ b/vignettes/guided_advanced_afuns_building_blocks.Rmd @@ -0,0 +1,43 @@ +--- +title: "Advanced rtables - Useful Behavioral Building Blocks For Complex Custom afuns" +subtitle: Contributed by Johnson & Johnson Innovative Medicine +date: "2025-10-22" +author: +- Gabriel Becker +- Dan Hofstaedter +output: + rmarkdown::html_document: + theme: "spacelab" + highlight: "kate" + toc: true + toc_float: true + code_folding: show +vignette: > + %\VignetteIndexEntry{Advanced rtables - Useful Behavioral Building Blocks For Complex Custom afuns} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + markdown: + wrap: 72 + chunk_output_type: console +--- + +```{r, include = FALSE} +suggested_dependent_pkgs <- c("dplyr") +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval = all(vapply( + suggested_dependent_pkgs, + requireNamespace, + logical(1), + quietly = TRUE + )) +) +``` + +```{r, echo=FALSE} +knitr::opts_chunk$set(comment = "#") +``` + +# Coming Soon diff --git a/vignettes/guided_advanced_afuns_rowsverticalsection.Rmd b/vignettes/guided_advanced_afuns_rowsverticalsection.Rmd new file mode 100644 index 000000000..ac63ff60e --- /dev/null +++ b/vignettes/guided_advanced_afuns_rowsverticalsection.Rmd @@ -0,0 +1,318 @@ +--- +title: "Advanced rtables - Calling Existing afuns Within Custom afuns" +subtitle: Contributed by Johnson & Johnson Innovative Medicine +date: "2025-10-22" +author: +- Gabriel Becker +- Dan Hofstaedter +output: + rmarkdown::html_document: + theme: "spacelab" + highlight: "kate" + toc: true + toc_float: true + code_folding: show +vignette: > + %\VignetteIndexEntry{Advanced rtables - Calling Existing afuns Within Custom afuns} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + markdown: + wrap: 72 + chunk_output_type: console +--- + +```{r, include = FALSE} +suggested_dependent_pkgs <- c("dplyr") +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval = all(vapply( + suggested_dependent_pkgs, + requireNamespace, + logical(1), + quietly = TRUE + )) +) +``` + +```{r, echo=FALSE} +knitr::opts_chunk$set(comment = "#") +``` + +# Analysis Function Return Values - `RowsVerticalSection`s + +Modern analysis functions return cell values via `in_rows`, which +constructs a `RowsVerticalSection` object. While the exact internal +implementation is not important, a `RowsVerticalSection` object +carries around cell values along with a number of *row*-level +formatting and rendering instructions; note that only the "first" (or +left-most) rows vertical section that includes cell values for a given +row will dictate row-level naming and rendering behavior. In +particular, `RowsVerticalSection` objects carry the following +instructions for rendering the resulting rows: + + +|name| accessor function|description| +|names |`value_names`| Names of the resulting rows| +|labels|`value_labels` | Labels of the resulting rows| +|indent mods| `indent_mod`, `indent_mod<-` | Indent modifiers for resulting rows| +|formats |`obj_format`, `obj_format<-` | **row level** formats| +|NA strings| `obj_na_str`, `obj_na_str<-`| **row level** NA strings| +|footnotes|`row_footnotes`, `row_footnotes<-` | **row level** footnotes| + + +Note arguments to `in_rows` which don't correspond to one of the +above, e.g., `.aligns`, `.cell_footnotes` and `.stat_names` represent +*cell* level information which is carried around by the cell objects +rather than the `RowsVerticalSection` object. The cells objects can be +extracted via `row_cells`. + +## Combining `RowsVerticalSection` Objects + +As of version `0.16.16`, `rtables` provides a `c` method for directly +combining `RowsVerticalSection` objects; prior to that this was fairly +straightforward to achieve, requiring developers to combine the values +of the objects as well as each of the above attributes and typically +passing these to the `RowsVerticalSection` constructor directly. For +those using earlier versions of `rtables` we provide example +`RowsVerticalSection` combination code in Appendix A. + +```{r} +library(rtables) +rvs1 <- in_rows(what = 17.123, .formats = c(what = "xx.x")) +rvs1 +``` + +```{r} +rvs2 <- in_rows( + ok = "hi", + nah = "bye", + .indent_mods = c(ok = 1, nah = -1), .row_footnotes = list(nah = "I guess not ...") +) +rvs2 +``` + +```{r} +c(rvs1, rvs2) +``` + +# Combining Existing Analysis Functions + +We assume here that all our analysis functions return their computed +cell values via calls to `in_rows`; this should be true of any +function written (or generated via a factor) specifically to be an +analysis function. + +There are (at least) three ways to combine existing analysis functions: + 1. conditionally call one or the other depending on, typically, where + in the column structure we are, + 2. call both functions and return a `RowsVerticalSection` + representing all rows generated by either function, or + 3. call one analysis function and then, conditional on row position, + call another and combine its results to the first. + +Either of (2) or (3) can also be combined with (1). + + +## Different Analysis Functions For Different Columns + +Our first form of combining existing analysis functions is to simply +selectively call one or the other depending on column position. We can +build a risk difference harness using this method: + + +```{r} +library(rtables) +placeholder_rd_afun <- function(df, .var, .spl_context, ref_path) { + val <- tail(.spl_context$cur_col_split_val[[1]], 1) + levs <- levels(df[[.var]]) + len <- length(levs) + + lst <- setNames(rep(val, len), levs) + in_rows(.list = lst, .formats = setNames(rep("xx", len), levs)) +} + +comb_afun <- function(df, .var, .spl_context, ref_path) { + if (grepl("difference", .spl_context$cur_col_id[[1]], ignore.case = TRUE)) { + ret <- placeholder_rd_afun(df, .var, .spl_context, ref_path) + } else { + ret <- simple_analysis(df[[.var]]) + } + ret +} + +adsl <- ex_adsl +adae <- ex_adae + +adsl$trt_span <- ifelse(adsl$ARM == "B: Placebo", " ", "Active Treatment") +adae$trt_span <- ifelse(adae$ARM == "B: Placebo", " ", "Active Treatment") +adsl$rr_header <- "Risk Differences" +adae$rr_header <- "Risk Differences" +adsl$rr_label <- paste(adsl$ARM, "vs B: Placebo") +adae$rr_label <- paste(adae$ARM, "vs B: Placebo") + +trtmap <- data.frame( + rr_header = c("Active Treatment", "Active Treatment", " "), + ARM = c("A: Drug X", "C: Combination", "B: Placebo") +) + +lyt <- basic_table() |> + split_cols_by("trt_span", split_fun = trim_levels_in_group("ARM")) |> + split_cols_by("ARM") |> + split_cols_by("rr_header", nested = FALSE) |> + split_cols_by("rr_label", split_fun = remove_split_levels("B: Placebo vs B: Placebo")) |> + analyze("AEBODSYS", afun = comb_afun, extra_args = list(ref_path = c("ARM", "B: Placebo"))) + +build_table(lyt, adae, adsl) +``` + +Note: while we constructed the spanning variables, risk difference +labels, treatment map and column structure layout instructions +manually to avoid circular dependencies, we refer users to +`grouped_cols_w_diffs` in the `junco` package which encapsulates +creating this particular column structure. + +## Stacking Analysis Functions + +We can also 'stack' two existing analysis functions by creating new +function which calls each of them and combines the resulting +`RowsVerticalSection` objects. Note that while we will create two toy +example analysis functions to stack here, this approach only really +makes sense when at least one analysis function is pre-existing, such +as those provided by `tern` and `junco`. + +```{r} +afun_1 <- function(df, .var) { + dat_vec <- df[[.var]] + in_rows("Total Events" = sum(!is.na(dat_vec))) +} + +afun_2 <- function(df, .var, .N_col, id) { + non_na <- !is.na(df[[.var]]) + count <- length(unique(df[[id]])) + in_rows("Unique Patients" = count * c(1, 1 / .N_col), .formats = c("Unique Patients" = "xx (xx.x%)")) +} + +stacked_afun <- function(df, .var, .N_col, id) { + events_rvs <- afun_1(df, .var) + pats_rvs <- afun_2(df, .var, .N_col, id) + c(events_rvs, pats_rvs) +} +``` + +```{r} +lyt <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("AEBODSYS", split_fun = trim_levels_in_group("AEDECOD")) |> + split_rows_by("AEDECOD") |> + analyze("STUDYID", afun = stacked_afun, extra_args = list(id = "USUBJID")) + +build_table(lyt, ex_adae, ex_adsl) +``` + +Note, some care is required, for example + +- If any of the stacked afuns accept `df` as their first argument, the + combining function must do so as well + - the data vector can be constructed to pass to any that accept `x`, + if necessary +- The combining function must accept the union of additional arguments + (both `rtables` populated and extra) accepted by the functions being + stacked. + +## Conditional Stacking + +In some cases we want to to add additional analysis rows for only some +values or within only some row facets (recall, all column facets must +have the same number of rows across each row facet, independently). + +For example, a simplified version of a disposition table can display +counts for each final study status (`EOSSTT`), and then provide detailed +counts for each reason for discontinuation (`DCSREAS`) under only the +`"DISCONTINUED"` value. + +```{r} +afun_count_lbl <- function(df, .var, lbl) { + in_rows(sum(!is.na(df[[.var]])), .names = lbl) +} +basic_two_tier <- function(df, .var, .spl_context, detail_var, detail_level) { + values <- lapply( + levels(df[[.var]]), + function(lvl) { + dat <- df[df[[.var]] == lvl, ] + rvs_out <- afun_count_lbl(dat, .var, lvl) + if (lvl %in% detail_level) { + det_rvs <- simple_analysis(dat[[detail_var]]) + indent_mod(det_rvs) <- 1 + rvs_out <- c(rvs_out, det_rvs) + } + rvs_out + } + ) + ret <- do.call(c, values) + ret +} +``` + +Here we use a simple counting function separately for each level in +`.var` (`EOSSTT` in this case), and then - only for the `DISCONTINUED` +level, stack the result of `simple_analysis` for our detail variable +(`DCSREAS` for our table). + +```{r} +lyt <- basic_table() |> + split_cols_by("ARM") |> + analyze("EOSSTT", afun = basic_two_tier, extra_args = list(detail_var = "DCSREAS", detail_level = "DISCONTINUED")) + +build_table(lyt, ex_adsl) +``` + +Note that for production usage, `junco` provides `a_two_tier` for this +purpose which is preferred to creating our own combination afun from +scratch in most cases. + +We leave it as an exercise to use the methods in the +[./guided_advanced_afuns_spl_context.html](Split Context) portion of +this guide to reformulate this so that we split on `EOSSTT` and then +use an afun with behavior conditional on the current row facet. + + +# Appendix A - Code For `c.RowsVerticalSection` + +The following is a copy of a development version of +`c.RowsVerticalSection` at the time of writing this vignette; this +code is not guaranteed to be kept in sync with `rtables`' exported +version of `c.RowsVerticalSection` and should be used for illustrative +and back-porting purposes only. + +```{r, eval = FALSE} +c.RowsVerticalSection <- function(...) { + lst <- list(...) + if (!all(vapply(lst, function(x) inherits(x, "RowsVerticalSection"), TRUE))) { + stop("Cannot use c() to combine RowsVerticalSection objects with objects of other classes") + } + + out <- NextMethod(generic = "c") + out <- RowsVerticalSection( + out, + names = comb_attr_w_dflt(lst, "row_names"), + labels = comb_attr_w_dflt(lst, "row_labels"), + indent_mods = comb_attr_w_dflt(lst, "indent_mods", 0L), + formats = comb_attr_w_dflt(lst, "row_formats", "xx"), + footnotes = comb_attr_w_dflt(lst, "row_footnotes"), + format_na_strs = comb_attr_w_dflt(lst, "row_na_strs", NA_character_) + ) + out +} + +comb_attr_w_dflt <- function(lst, attrname, dflt = NULL) { + unlist( + lapply(lst, function(x) { + attr(x, attrname, exact = TRUE) %||% rep(dflt, length(x)) + }), + recursive = FALSE, + use.names = FALSE + ) +} +``` diff --git a/vignettes/guided_advanced_afuns_spl_context.Rmd b/vignettes/guided_advanced_afuns_spl_context.Rmd new file mode 100644 index 000000000..bd892b50b --- /dev/null +++ b/vignettes/guided_advanced_afuns_spl_context.Rmd @@ -0,0 +1,264 @@ +--- +title: "Advanced rtables - Structure-Conditional Behavior In `afun`s With `.spl_context`" +subtitle: Contributed by Johnson & Johnson Innovative Medicine +date: "2025-10-22" +author: +- Gabriel Becker +- Dan Hofstaedter +output: + rmarkdown::html_document: + theme: "spacelab" + highlight: "kate" + toc: true + toc_float: true + code_folding: show +vignette: > + %\VignetteIndexEntry{Advanced rtables - Structure-Conditional Behavior In afuns With .spl_context} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + markdown: + wrap: 72 + chunk_output_type: console +--- + +```{r, include = FALSE} +suggested_dependent_pkgs <- c("dplyr") +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval = all(vapply( + suggested_dependent_pkgs, + requireNamespace, + logical(1), + quietly = TRUE + )) +) +``` + +```{r, echo=FALSE} +knitr::opts_chunk$set(comment = "#") +library(rtables) +``` + +# Split Context + +The split context (i.e., the optional `.spl_context` argument to a/c +functions) provides analysis functions the ability to know what +substructure of the table it is calculating cell values for, the data +(sub)set corresponding to that substructure, and the steps - both in +terms of faceting structure and corresponding data subsetting - taken +by the tabulation engine to arrive where it is now. + +This allows us to program custom analysis functions which have +behavior *conditional on which row or column facet they are currently +calculating cell values for*, as we will see further down in this +document. + +The *split context* is a `data.frame` with one row per faceting step +in row space up to and including the one the analysis function is +being called within, and the following columns which vary across +context rows: + +- **`split`** (`character`) - name of the split represented by each + row of the split context +- **`value`** (`character`) - string representation of the value of + the split for each row of the context +- **`full_parent_df`** (`list` of `data.frame`s) - the full data + (across all columns) corresponding to each row faceting step +- **`all_cols_n`** (`integer`) - the observation count for each row + faceting step (across all columns) +- **``** (one `list` column per column in the table) - + logical vectors corresponding to the subset of `full_parent_df` for + the named column for each faceting step. Named by + `names(col_exprs(tab))`. + +In addition, the context contains the following columns which are +constant across context rows: + +- **`cur_col_id`** (`character`) - identifier for the current column +- **`cur_col_expr`** (`list` of `expresssion` objects) - symbolic + expression for subset corresponding to current column. +- **`cur_col_n`** (`integer`) - column count for the current column +- **`cur_col_split`** (`list` of `character`) - vector of split names from the + path which resolves to the current column. +- **`cur_col_split_value`** (`list` of `character`) - vector of split + values from the path which resolves to the current column. + +Interleaving `cur_col_split` and `cur_col_split_value` will recreate +the full unique column path for the current column. + + +# Designing Conditional Behavior in `afun`s + +Recall that table contents are (typically) calculated by repeated +calling the analysis or content function for a given row facet - once +per individual column within the table structure. + +## Conditional-On-Column Behavior in `afun`s + +If we want our table to have different *types* of content in +different cells of the same row, we need an `afun` that + +1. can determine where in column space it is calculating cells for, and +2. implements two or more behaviors which it selects between based on (1) + +**Note** it is *mandatory* that the calls to our analysis or content +function result in the same number of rows within each column. This +can involve padding the results with blank cells in some columns. + +### Determining Column-Space Position Within An `afun` + +We can use the `cur_col_*` elements of the split context - all of +which are constant across rows - to determine where in the column +structure we are creating cells for, as we saw in the [Translating +Shells](./guided_intermediate_translating_Shells.html) portion of the +intermediate guided tour. In that function we used `cur_col_id` to indicate column, but using `cur_col_split` and/or `cur_col_split_value` is more robust, as follows: + +```{r} +in_risk_diff <- function(spl_context) { + any(grepl("Risk Differences", spl_context$cur_col_split_value[1])) +} +``` + +We can use the first element of the `cur_col_id` column of the split +context because as noted above, the column information columns are +constant across rows in the context. + +The `cur_col_id` value in the split context is currently computed by +pasting the split values of the column path to the current column. + +### General Template For Column Aware `afun` + +Assuming two desired behaviors depending on column position (e.g., +primary or risk difference column), a general template for a +conditional-on-column `afun` is: + + +```{r, eval = FALSE} +col_condition <- function(spl_context) { + ## return TRUE or FALSE +} + +col_cond_afun_template1 <- function(df, .var, ..., .spl_context) { + ## shared processing + + if (col_condition(.spl_context)) { + ## alternate behavior + + ## data processing + + ## value calculation + + ## determine cell formats, etc + } else { + ## primary behavior + + ## data processing + + ## value calculation + + ## determine cell formats, etc + } + + ## label calculation, etc if necessary + + in_rows(val_list, .labels = lbl_vector, .formats = format_vector) +} +``` + +Or, alternatively if we have two existing `afun`s that each fully +encapsulate the desired behavior for one of the conditions, + +```{r, eval = FALSE} +col_cond_afun_template2 <- function(df, .var, ..., .spl_context) { + if (col_condition(.spl_context)) { + alt_behavior_afun(df, .var, ..., .spl_context = .spl_context) + } else { + main_behavior_afun(df, .var, ..., .spl_context = .spl_context) + } +} +``` + +We note that both of the approaches above would be straightforward to +extend to more than two conditional behaviors by utilizing a condition +function which could return more than two values, and a `switch` call +or `if`/`ifelse`/`else` block. We leave this as an exercise for the +reader. + + +## Using Row Faceting Information Within `afun`s + +The split context is a data frame with a row for each preceding row +faceting (splitting) step; in particular, as described above, we have +access to the full data, split name, and split value for each of these +steps. + +Some illustrative examples of code extracting information from the +split context are: + +| code | context row | faceting step | what it extracts | +|+------------------------------------------------------+|+--------------+|+------------------+|+------------------------------------------------+| +| `.split_context$full_parent_df[[1]]` | first | root (no faceting) | full data (that was passed to `build_table` | +| `.split_context$split[NROW(.split_context)]` | last | current facet | name of the current split (typically a var name) | +| `.split_context$split_value[NROW(.split_context) - 1]` | second to last | parent facet | facet value of parent facet | + +We often want to retrieve reference group information for use in model +fitting or risk difference calculations. In practice this translates +to a different column facet's intersection with our current row facet +than the column we are currently operating within. + +Given a `ref_path`, which can be passed as an extra argument in the +`analyze` call if it's constant or set as an extra argument on each +split value by a custom split function if not (see `junco`'s +`grouped_cols_w_diffs` function for an example of this), we can +extract the relevant data. + +We will use the fact that the column subsetting vectors are included +in the split context by their "col ids", which currently are +constructed by pasting the split values (only) collapsed with ".": + +```{r} +basic_get_ref <- function(ref_path, spl_context) { + facet_dat <- spl_context$full_parent_df[[NROW(spl_context)]] + + ref_col_id <- paste(ref_path[seq(2, length(ref_path), by = 2)]) + + ref_subset_vec <- spl_context[[ref_col_id]][[NROW(spl_context)]] + + ref_dat <- facet_dat[ref_subset_vec, ] + + list(ref_group = ref_dat, in_ref_col = ref_col_id == spl_context$cur_col_id[[1]]) +} +``` + +We can see that this is working via a diagnostic table that shows us what is coming out of that function: + + + +```{r} +diag_afun <- function(df, .spl_context, ref_path) { + ref_info <- basic_get_ref(ref_path, .spl_context) + + in_rows( + data_dim = dim(df), + ref_dim = dim(ref_info$ref_group), + in_ref_col = ref_info$in_ref_col, + .formats = c( + data_dim = "xx, xx", + ref_dim = "xx, xx", + in_ref_col = "xx" + ) + ) +} + + +lyt <- basic_table() |> + split_cols_by("ARM") |> + split_rows_by("STRATA1") |> + split_rows_by("SEX", split_fun = keep_split_levels(c("F", "M"))) |> + analyze("AGE", diag_afun, extra_args = list(ref_path = c("ARM", "B: Placebo"))) + + +build_table(lyt, ex_adsl) +``` diff --git a/vignettes/guided_advanced_split_funs.Rmd b/vignettes/guided_advanced_split_funs.Rmd new file mode 100644 index 000000000..f209626a9 --- /dev/null +++ b/vignettes/guided_advanced_split_funs.Rmd @@ -0,0 +1,55 @@ +--- +title: "Advanced rtables - Custom Split Functions" +subtitle: Contributed by Johnson & Johnson Innovative Medicine +date: "2025-10-22" +author: +- Gabriel Becker +- Dan Hofstaedter +output: + rmarkdown::html_document: + theme: "spacelab" + highlight: "kate" + toc: true + toc_float: true + code_folding: show +vignette: > + %\VignetteIndexEntry{Advanced rtables - Custom Split Functions} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + markdown: + wrap: 72 + chunk_output_type: console +--- + +```{r, include = FALSE} +suggested_dependent_pkgs <- c("dplyr") +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval = all(vapply( + suggested_dependent_pkgs, + requireNamespace, + logical(1), + quietly = TRUE + )) +) +``` + +```{r, echo=FALSE} +knitr::opts_chunk$set(comment = "#") +``` + +# Coming Soon + + - [`make_split_fun` and Its Effective + Use](./guided_advanced_split_funs_make_split_fun.html) `make_split_fun` and + recognizing when to specify `pre`, `core`, and `post` behavior + customizations + - [Combining And Creating Behavior Building + Blocks](./guided_advanced_split_funs_new_bbbs.html) The split function + behavior building blocks provided by `rtables`, how to use and + combine them, and how to create your own + - [Some Complex Worked + Examples](./guided_advanced_split_funs_worked_ex.html) Combining + these topics to create complex custom split functions diff --git a/vignettes/guided_advanced_split_funs_make_split_fun.Rmd b/vignettes/guided_advanced_split_funs_make_split_fun.Rmd new file mode 100644 index 000000000..58630a3c4 --- /dev/null +++ b/vignettes/guided_advanced_split_funs_make_split_fun.Rmd @@ -0,0 +1,43 @@ +--- +title: "Advanced rtables - Using `make_split_fun` Effectively" +subtitle: Contributed by Johnson & Johnson Innovative Medicine +date: "2025-10-22" +author: +- Gabriel Becker +- Dan Hofstaedter +output: + rmarkdown::html_document: + theme: "spacelab" + highlight: "kate" + toc: true + toc_float: true + code_folding: show +vignette: > + %\VignetteIndexEntry{Advanced rtables - Using make_split_fun Effectively} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + markdown: + wrap: 72 + chunk_output_type: console +--- + +```{r, include = FALSE} +suggested_dependent_pkgs <- c("dplyr") +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval = all(vapply( + suggested_dependent_pkgs, + requireNamespace, + logical(1), + quietly = TRUE + )) +) +``` + +```{r, echo=FALSE} +knitr::opts_chunk$set(comment = "#") +``` + +# Coming Soon diff --git a/vignettes/guided_advanced_split_funs_new_bbbs.Rmd b/vignettes/guided_advanced_split_funs_new_bbbs.Rmd new file mode 100644 index 000000000..bc60e10ea --- /dev/null +++ b/vignettes/guided_advanced_split_funs_new_bbbs.Rmd @@ -0,0 +1,292 @@ +--- +title: "Advanced rtables - Writing Reusable Behavior Building Blocks" +subtitle: Contributed by Johnson & Johnson Innovative Medicine +date: "2025-10-22" +author: +- Gabriel Becker +- Dan Hofstaedter +output: + rmarkdown::html_document: + theme: "spacelab" + highlight: "kate" + toc: true + toc_float: true + code_folding: show +vignette: > + %\VignetteIndexEntry{Advanced rtables - Writing Reusable Behavior Building Blocks} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + markdown: + wrap: 72 + chunk_output_type: console +--- + +```{r, include = FALSE} +suggested_dependent_pkgs <- c("dplyr") +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval = all(vapply( + suggested_dependent_pkgs, + requireNamespace, + logical(1), + quietly = TRUE + )) +) +``` + +```{r, echo=FALSE} +knitr::opts_chunk$set(comment = "#") +``` + +# Split Function Behavioral Building Blocks + +We call functions that can used as either pre- or post processing +functions in `make_split_fun` (via entry into the lists passed to +`pre` and `post`, respectively) *behavioral building blocks* +(BBBs). Behavioral building blocks are modular, typically atomic (as +in they only do one narrow thing to the data or split result) +functions which we can mix and match to construct complex custom +behaviors in our split function. + +There are two types of behavioral building blocks: + +- *pre*-processing - accept, modify, and return the incoming parent data, and +- *post*-processing - accept, modify, and return a split result object + representing facets generated by the core splitting machinery + +## Existing BBBs provided by `rtables` + +`rtables` provides a small number of behavioral building blocks that +are ready for use: + + +|behavior | function | fun factory |usage notes | BBB type| +|---------|----------|-------------|---------| +|drop specific facets | `restrict_facets`| yes | `op = "drop"`| post| +|keep only specific facets | `restrict_facets` | yes | `op = "keep"` | post| +|reorder facets | `restrict_facets` | yes |`op = keep`, `reorder = TRUE`, pass all existing facet names| post| +|add combination facet | `add_combo_facet` | yes |create single combo facet, can be called repeatedly | post | +| add overall/total facet | `add_overall_facet` | yes | | post| | +| Trim levels of another var in each facet | `trim_levels_in_facet` | yes | equivalent to `trim_levels_in_group` | post| +| exclude facets for unobserved variable levels | `drop_facet_levels` | no | | pre | + + +We refer to the help for each of these functions for examples of their +usage and will not recreate single examples here. + + +# Creating Post Processing BBBs + +Post processing behavioral building blocks are functions which accept: + +- `ret` - split result object returned by the core splitting machinery + *or* a previously applied post processing BBB +- `spl` - Split object +- `fulldf` - incoming full data which was split in this faceting step +- `.spl_context` - *optional* split context object + +and returns `ret` modified typically in one of four ways: + +1. using `add_to_split_result` on `ret` to add facets manually to it, +2. manually removing facets from it (or wrapping logic around a + `restrict_facets` call), +3. reordering the existing facets, or, rarely, +4. calling `make_split_result` to construct an entirely new split result. + +## Illustrative And/Or Useful Examples +Here we implement a number of simple behavioral building blocks that +both illustrate how to create our own and may be useful in some +circumstances. + +### Placing Specific Facets First And/Or Last + + +Here we want to specify certain facets (in practice, often combination +facets whose order can't be controlled via variable re-leveling) to +appear first and or last *amongst their direct siblings*. + +Recognizing that this is ultimately a reordering behavior, we can wrap +a call to `restrict_facets` with `reorder = TRUE` after calculating +the desired full ordering: + + +```{r} +library(rtables) + +put_facets_first_last <- function(first = NULL, last = NULL) { + if (is.null(first) && is.null(last)) { + stop("must speficify at least one facet to be placed first or last") + } + function(ret, spl, fulldf) { + fac_names <- names(ret$values) + all_speced <- c(first, last) + + if (!all(all_speced %in% fac_names)) { + stop("Facet(s) []", paste(setdiff(all_speced, fac_names), collapse = ", "), "] not found in incoming split result.") + } + tmpfun <- restrict_facets(c(first, setdiff(fac_names, all_speced), last), op = "keep", reorder = TRUE) + tmpfun(ret, spl, fulldf) + } +} +``` + + +While this could be achieved by variable re-leveling, we show that this +works by forcing the `U` and `UNDIFFERENTIATED` levels of `SEX` to be +first and last, respectively: + +```{r} +fl_splfun <- make_split_fun( + post = list( + put_facets_first_last(first = "U", last = "UNDIFFERENTIATED") + ) +) +``` + +We can then compare two similar (column) layouts to see the effect of our BBB + +```{r} +lyt_basic <- basic_table() |> + split_cols_by("SEX") + +build_table(lyt_basic, ex_adsl) +``` + +```{r} +lyt_fl <- basic_table() |> + split_cols_by("SEX", split_fun = fl_splfun) + +build_table(lyt_fl, ex_adsl) +``` +### Pre-sorting Or Pre-pruning Facets Based On Data Sparsity + +Here we want to either reorder our facets or remove some facets based +on how much data they represent. + +```{r} +presort_facets <- function(ret, spl, fulldf) { + fac_names <- names(ret$values) + fac_ns <- vapply(ret$datasplit, NROW, 1L) + ord <- order(fac_ns, decreasing = TRUE) + tmpfun <- restrict_facets(fac_names[ord], op = "keep", reorder = TRUE) + tmpfun(ret, spl, fulldf) +} +``` + +Here we can see that using this building block gives our desired behavior: + + +```{r} +presort_splfun <- make_split_fun(post = list(presort_facets)) + +lyt_presort <- basic_table(show_colcounts = TRUE) |> + split_cols_by("STRATA1", split_fun = presort_splfun) + +build_table(lyt_presort, ex_adsl) +``` + +And similarly here: +```{r} +drop_sparse_facets <- function(ncutoff = 5) { + function(ret, spl, fulldf) { + fac_names <- names(ret$values) + fac_ns <- vapply(ret$datasplit, NROW, 1L) + keep_inds <- which(fac_ns >= ncutoff) + tmpfun <- restrict_facets(fac_names[keep_inds], op = "keep", reorder = FALSE) + tmpfun(ret, spl, fulldf) + } +} + +lyt_preprune1 <- basic_table(show_colcounts = TRUE) |> + split_cols_by("SEX") + +build_table(lyt_preprune1, ex_adsl) + +preprune_splfun2 <- make_split_fun(post = list(drop_sparse_facets())) +lyt_preprune2 <- basic_table(show_colcounts = TRUE) |> + split_cols_by("SEX", split_fun = preprune_splfun2) + +build_table(lyt_preprune2, ex_adsl) + +preprune_splfun3 <- make_split_fun(post = list(drop_sparse_facets(10))) +lyt_preprune3 <- basic_table(show_colcounts = TRUE) |> + split_cols_by("SEX", split_fun = preprune_splfun3) + +build_table(lyt_preprune3, ex_adsl) +``` + +# Creating Preprocessing BBBs + +Custom pre-processing BBB requirements are rarer than post-processing +ones, as most things are simpler to do over a small set of facets +rather than a large set of incoming data. Furthermore, most things +that could be done via a pre-processing BBB can also be done via a +post-processing BBB. + +That said, for illustrative purposes, we can recreate part of +functionality of `trim_levels_to_map` in a preprocessing BBB (the +restriction of data based on inner variable values), like so: + + +```{r} +trim_facets_to_map <- function(map = NULL) { + function(df, spl, vals, labels, .spl_context) { + if (is.null(map)) { + return(df) + } # do nothing + cur_outer_val <- tail(.spl_context$value, 1) + inner_var <- names(map)[2] + inner_vec <- df[[inner_var]] + inner_keep <- map[map[[1]] == cur_outer_val, inner_var, drop = TRUE] + df_out <- df[inner_vec %in% inner_keep, ] + df_out[[inner_var]] <- factor(df_out[[inner_var]], levels = intersect(levels(inner_vec), inner_keep)) + df_out + } +} +``` + +We use `spl_variable` to retrieve the variable name for the split, +determine the levels of the inner variable to keep based on the map +and the current level of the split context, restrict the data to rows +where the inner variable is the desired value(s), and recreate the +inner variable factor to drop unwanted levels. + +Because we are doing this as factor re-leveling *before* the core +splitting machinery is invoked, we will use this as a pre-processing +BBB ***on the inner variable split***; for a post-processing BBB we +would do it on the split data of the outer variable split. + +Note: If our map does not include at least one entry for each factor +level defined by the incoming data, we need to restrict those at the +previous split; `trim_levels_to_map` combines this behavior. + + +```{r} +map <- data.frame( + ARM = c("A: Drug X", "B: Placebo"), + STRATA1 = c("B", "A") +) + +map_splfun <- make_split_fun(pre = list(trim_facets_to_map(map))) + +outer_splfun <- make_split_fun(post = list(restrict_facets("C: Combination", op = "exclude"))) + +lyt <- basic_table() |> + split_cols_by("ARM", split_fun = outer_splfun) |> + split_cols_by("STRATA1", split_fun = map_splfun) + +build_table(lyt, ex_adsl) +``` + +This matches the core behavior of `trim_levels_to_map`: + + +```{r} +lyt <- basic_table() |> + split_cols_by("ARM", split_fun = trim_levels_to_map(map)) |> + split_cols_by("STRATA1") + +build_table(lyt, ex_adsl) +``` diff --git a/vignettes/guided_advanced_split_funs_worked_ex.Rmd b/vignettes/guided_advanced_split_funs_worked_ex.Rmd new file mode 100644 index 000000000..a9ade6f81 --- /dev/null +++ b/vignettes/guided_advanced_split_funs_worked_ex.Rmd @@ -0,0 +1,43 @@ +--- +title: "Advanced rtables - Some Complex Split Function Worked Examples" +subtitle: Contributed by Johnson & Johnson Innovative Medicine +date: "2025-10-22" +author: +- Gabriel Becker +- Dan Hofstaedter +output: + rmarkdown::html_document: + theme: "spacelab" + highlight: "kate" + toc: true + toc_float: true + code_folding: show +vignette: > + %\VignetteIndexEntry{Advanced rtables - Some Complex Split Function Worked Examples} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + markdown: + wrap: 72 + chunk_output_type: console +--- + +```{r, include = FALSE} +suggested_dependent_pkgs <- c("dplyr") +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval = all(vapply( + suggested_dependent_pkgs, + requireNamespace, + logical(1), + quietly = TRUE + )) +) +``` + +```{r, echo=FALSE} +knitr::opts_chunk$set(comment = "#") +``` + +# Coming Soon diff --git a/vignettes/guided_advanced_tt.Rmd b/vignettes/guided_advanced_tt.Rmd new file mode 100644 index 000000000..47261841a --- /dev/null +++ b/vignettes/guided_advanced_tt.Rmd @@ -0,0 +1,56 @@ +--- +title: "Advanced rtables - Understanding and Interacting With `TableTree` Objects" +subtitle: Contributed by Johnson & Johnson Innovative Medicine +date: "2025-10-22" +author: +- Gabriel Becker +- Dan Hofstaedter +output: + rmarkdown::html_document: + theme: "spacelab" + highlight: "kate" + toc: true + toc_float: true + code_folding: show +vignette: > + %\VignetteIndexEntry{Advanced rtables - Understanding and Interacting With TableTree Objects} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + markdown: + wrap: 72 + chunk_output_type: console +--- + +```{r, include = FALSE} +suggested_dependent_pkgs <- c("dplyr") +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval = all(vapply( + suggested_dependent_pkgs, + requireNamespace, + logical(1), + quietly = TRUE + )) +) +``` + +```{r, echo=FALSE} +knitr::opts_chunk$set(comment = "#") +``` + +# Coming Soon + + - [Table Structure and Pathing](./pathing.html) Table structure and + describing locations within a table via pathing (existing + vignette) + - [Accessing Values Within A + Table](./guided_advanced_tt_access.html) Retrieving values + from a table + - [Writing Custom Scoring Functions For + Sorting](./guided_advanced_tt_score_funs.html) Writing custom + scoring functions for use with `sort_at_path` + - [Writing Custom Pruning + Functions](./guided_advanced_tt_prune_funs.html) Writing custom + pruning functions for use with `prune_table` diff --git a/vignettes/guided_advanced_tt_access.Rmd b/vignettes/guided_advanced_tt_access.Rmd new file mode 100644 index 000000000..042357ef1 --- /dev/null +++ b/vignettes/guided_advanced_tt_access.Rmd @@ -0,0 +1,43 @@ +--- +title: "Advanced rtables - Accessing Values Within a Table" +subtitle: Contributed by Johnson & Johnson Innovative Medicine +date: "2025-10-22" +author: +- Gabriel Becker +- Dan Hofstaedter +output: + rmarkdown::html_document: + theme: "spacelab" + highlight: "kate" + toc: true + toc_float: true + code_folding: show +vignette: > + %\VignetteIndexEntry{Advanced rtables - Accessing Values Within a Table} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + markdown: + wrap: 72 + chunk_output_type: console +--- + +```{r, include = FALSE} +suggested_dependent_pkgs <- c("dplyr") +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval = all(vapply( + suggested_dependent_pkgs, + requireNamespace, + logical(1), + quietly = TRUE + )) +) +``` + +```{r, echo=FALSE} +knitr::opts_chunk$set(comment = "#") +``` + +# Coming Soon diff --git a/vignettes/guided_advanced_tt_prune_funs.Rmd b/vignettes/guided_advanced_tt_prune_funs.Rmd new file mode 100644 index 000000000..f2a0eccb2 --- /dev/null +++ b/vignettes/guided_advanced_tt_prune_funs.Rmd @@ -0,0 +1,43 @@ +--- +title: "Advanced rtables - Writing Custom Pruning Functions" +subtitle: Contributed by Johnson & Johnson Innovative Medicine +date: "2025-10-22" +author: +- Gabriel Becker +- Dan Hofstaedter +output: + rmarkdown::html_document: + theme: "spacelab" + highlight: "kate" + toc: true + toc_float: true + code_folding: show +vignette: > + %\VignetteIndexEntry{Advanced rtables - Writing Custom Pruning Functions} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + markdown: + wrap: 72 + chunk_output_type: console +--- + +```{r, include = FALSE} +suggested_dependent_pkgs <- c("dplyr") +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval = all(vapply( + suggested_dependent_pkgs, + requireNamespace, + logical(1), + quietly = TRUE + )) +) +``` + +```{r, echo=FALSE} +knitr::opts_chunk$set(comment = "#") +``` + +# Coming Soon diff --git a/vignettes/guided_advanced_tt_score_funs.Rmd b/vignettes/guided_advanced_tt_score_funs.Rmd new file mode 100644 index 000000000..32f37337f --- /dev/null +++ b/vignettes/guided_advanced_tt_score_funs.Rmd @@ -0,0 +1,43 @@ +--- +title: "Advanced rtables - Writing Custom Scoring Functions For Sorting" +subtitle: Contributed by Johnson & Johnson Innovative Medicine +date: "2025-10-22" +author: +- Gabriel Becker +- Dan Hofstaedter +output: + rmarkdown::html_document: + theme: "spacelab" + highlight: "kate" + toc: true + toc_float: true + code_folding: show +vignette: > + %\VignetteIndexEntry{Advanced rtables - Writing Custom Scoring Functions For Sorting} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + markdown: + wrap: 72 + chunk_output_type: console +--- + +```{r, include = FALSE} +suggested_dependent_pkgs <- c("dplyr") +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval = all(vapply( + suggested_dependent_pkgs, + requireNamespace, + logical(1), + quietly = TRUE + )) +) +``` + +```{r, echo=FALSE} +knitr::opts_chunk$set(comment = "#") +``` + +# Coming Soon