diff --git a/DESCRIPTION b/DESCRIPTION index ca7224b58..27980b727 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -105,3 +105,4 @@ Collate: 'tt_from_df.R' 'validate_table_struct.R' 'zzz_constants.R' +RoxygenNote: 7.3.3 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/R/00tabletrees.R b/R/00tabletrees.R index a3493ee5e..e0ce3965f 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(sapply(lst, function(x) inherits(x, "RowsVerticalSection")))) { + 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..ab9f01921 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -68,6 +68,7 @@ articles: - guided_intermediate_translating_shells - guided_intermediate_afun_reqs - guided_intermediate_split_reqs + - starts_with("guided_advanced") - title: Clinical Trials navbar: Clinical Trials @@ -323,3 +324,4 @@ reference: - length,CellValue-method - names,VTableNodeInfo-method - insert_rrow + - c.RowsVerticalSection diff --git a/inst/WORDLIST b/inst/WORDLIST index 632e83e43..909d33e07 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,66 +1,110 @@ Abinaya +acknowledgements AE AEs afun afuns +allcols amongst ARD ard ARDs +args +asvec +aut +avar biomarker BMEASIFL Bov Bov Carreras +cbind +CellValue charset Cheatsheet Chohan +clayout colcount +colinfo +coltree +colvars combinatorial +compat +constr +coxreg +cran CRAN's +cre +ctb customizations Davide de decrementing +degen +desc +Dev +dev df +dg +differnt dimensioned +disp divs dplyr elemtable emph +expr facetted facetting FFFL +fnd formatter forseeable +funciton funder +funs Garolini getter getters +github Godwin Heng Hoffmann +Hofstaedter +href +https ie indicies ing initializer +insightsengineering +io +kate Kelkhoff +knitr labelled Layouting layouting Lewandowski +lyt mandatorily Maximo modelled Modelling monospace Mordig +multivar multivariable +na +navbar +nesttemplate NSE ORCID orderable orthogonally +overrided oversimplifaction +params Paszty pathability pathable @@ -69,27 +113,41 @@ Pathing pathing Pharma Phuse +pkgdown postfix postprocessing Pre pre Qi +qtable +rcell reindexed repped +reqs responder Resync reusability +rheader +rmarkdown roadmap +RowsVerticalSection +rrow +rrowl RStudio +rtable +rtablel rtables Rua Saban Sabans Saibah +sep SKELETOMUSCULAR sortable +spacelab spl Stoilova +struct STUDYID subseting subsplits @@ -100,10 +158,15 @@ Subtables subtables summarization tableone +TableTree Tadeusz +toc todo +topleft +tostring traversable truetype +tt unaggregated unicode uniqify @@ -115,9 +178,15 @@ Unstratified unstratified useR ValueWrapper +VignetteEncoding +VignetteEngine +VignetteIndexEntry visibilities visibilty +VTableNodeInfo +VTableTree Waddell +wpcts xtable Yogasekaram Yung 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/guided_advanced.Rmd b/vignettes/guided_advanced.Rmd new file mode 100644 index 000000000..de0e3f051 --- /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..a9c6ec8aa --- /dev/null +++ b/vignettes/guided_advanced_afuns.Rmd @@ -0,0 +1,196 @@ +--- +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 = "#") +library(rtables) +``` + +# 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) + +![](./analysis_basics_b.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 overrided 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} +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..143d6aaea --- /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..0a4d46fc4 --- /dev/null +++ b/vignettes/guided_advanced_afuns_rowsverticalsection.Rmd @@ -0,0 +1,261 @@ +--- +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 + +Mordern 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 anaysis 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 eiter 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 anaysis 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 prefered 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 veresion 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(sapply(lst, function(x) inherits(x, "RowsVerticalSection")))) { + 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..1b00bda09 --- /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 +funs) 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 funciton 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..c7aed6eeb --- /dev/null +++ b/vignettes/guided_advanced_split_funs.Rmd @@ -0,0 +1,58 @@ +--- +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 + - [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 diff --git a/vignettes/guided_advanced_split_funs_bbbs.Rmd b/vignettes/guided_advanced_split_funs_bbbs.Rmd new file mode 100644 index 000000000..0cc57ed33 --- /dev/null +++ b/vignettes/guided_advanced_split_funs_bbbs.Rmd @@ -0,0 +1,43 @@ +--- +title: "Advanced rtables - Using and Combining Provided 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 - Using and Combining Provided 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 = "#") +``` + +# Coming Soon 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..660f331d6 --- /dev/null +++ b/vignettes/guided_advanced_split_funs_new_bbbs.Rmd @@ -0,0 +1,257 @@ +--- +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 overal/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 releveling) 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 releveling, 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) +``` +### Presorting Or Prepruning 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 releving *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..8f4d0451f --- /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