Advanced rtables - Calling Existing afuns Within Custom afuns
Contributed by Johnson & Johnson Innovative Medicine
Gabriel Becker
Dan Hofstaedter
2025-10-22
Source:vignettes/guided_advanced_afuns_rowsverticalsection.Rmd
guided_advanced_afuns_rowsverticalsection.RmdAnalysis Function Return Values -
RowsVerticalSections
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.
library(rtables)
# Loading required package: formatters
#
# Attaching package: 'formatters'
# The following object is masked from 'package:base':
#
# %||%
#
# Attaching package: 'rtables'
# The following object is masked from 'package:utils':
#
# str
rvs1 <- in_rows(what = 17.123, .formats = c(what = "xx.x"))
rvs1
# RowsVerticalSection (in_rows) object print method:
# ----------------------------
# row_name formatted_cell indent_mod row_label
# 1 what 17.1 0 what
rvs2 <- in_rows(
ok = "hi",
nah = "bye",
.indent_mods = c(ok = 1, nah = -1), .row_footnotes = list(nah = "I guess not ...")
)
rvs2
# RowsVerticalSection (in_rows) object print method:
# ----------------------------
# row_name formatted_cell indent_mod row_label
# 1 ok hi 1 ok
# 2 nah bye -1 nah
c(rvs1, rvs2)
# RowsVerticalSection (in_rows) object print method:
# ----------------------------
# row_name formatted_cell indent_mod row_label
# 1 what 17.1 0 what
# 2 ok hi 1 ok
# 3 nah bye -1 nahCombining 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:
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)
# Active Treatment Risk Differences
# A: Drug X C: Combination B: Placebo A: Drug X vs B: Placebo C: Combination vs B: Placebo
# —————————————————————————————————————————————————————————————————————————————————————————————————————————
# cl A.1 132 160 130 A: Drug X vs B: Placebo C: Combination vs B: Placebo
# cl B.1 56 62 60 A: Drug X vs B: Placebo C: Combination vs B: Placebo
# cl B.2 129 143 138 A: Drug X vs B: Placebo C: Combination vs B: Placebo
# cl C.1 55 64 63 A: Drug X vs B: Placebo C: Combination vs B: Placebo
# cl C.2 48 65 53 A: Drug X vs B: Placebo C: Combination vs B: Placebo
# cl D.1 127 135 106 A: Drug X vs B: Placebo C: Combination vs B: Placebo
# cl D.2 62 74 72 A: Drug X vs B: Placebo C: Combination vs B: PlaceboNote: 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.
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)
}
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)
# A: Drug X B: Placebo C: Combination
# ——————————————————————————————————————————————————————————————
# cl A.1
# dcd A.1.1.1.1
# Total Events 64 62 88
# Unique Patients 50 (37.3%) 45 (33.6%) 63 (47.7%)
# dcd A.1.1.1.2
# Total Events 68 68 72
# Unique Patients 48 (35.8%) 48 (35.8%) 50 (37.9%)
# cl B.1
# dcd B.1.1.1.1
# Total Events 56 60 62
# Unique Patients 47 (35.1%) 49 (36.6%) 43 (32.6%)
# cl B.2
# dcd B.2.1.2.1
# Total Events 65 62 66
# Unique Patients 49 (36.6%) 44 (32.8%) 52 (39.4%)
# dcd B.2.2.3.1
# Total Events 64 76 77
# Unique Patients 48 (35.8%) 54 (40.3%) 51 (38.6%)
# cl C.1
# dcd C.1.1.1.3
# Total Events 55 63 64
# Unique Patients 43 (32.1%) 46 (34.3%) 43 (32.6%)
# cl C.2
# dcd C.2.1.2.1
# Total Events 48 53 65
# Unique Patients 35 (26.1%) 48 (35.8%) 55 (41.7%)
# cl D.1
# dcd D.1.1.1.1
# Total Events 61 51 71
# Unique Patients 50 (37.3%) 42 (31.3%) 51 (38.6%)
# dcd D.1.1.4.2
# Total Events 66 55 64
# Unique Patients 48 (35.8%) 42 (31.3%) 50 (37.9%)
# cl D.2
# dcd D.2.1.5.3
# Total Events 62 72 74
# Unique Patients 47 (35.1%) 58 (43.3%) 57 (43.2%)Note, some care is required, for example
- If any of the stacked afuns accept
dfas 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 data vector can be constructed to pass to any that accept
- The combining function must accept the union of additional arguments
(both
rtablespopulated 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.
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).
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)
# A: Drug X B: Placebo C: Combination
# —————————————————————————————————————————————————————————————————————————
# COMPLETED 69 69 72
# DISCONTINUED 38 43 39
# ADVERSE EVENT 6 6 7
# LACK OF EFFICACY 11 10 6
# PHYSICIAN DECISION 3 8 6
# PROTOCOL VIOLATION 6 9 6
# WITHDRAWAL BY PARENT/GUARDIAN 8 2 4
# WITHDRAWAL BY SUBJECT 4 8 10
# ONGOING 27 22 21Note 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
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.
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
)
}