RowsVerticalSectionsModern 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.
RowsVerticalSection ObjectsAs 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)
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 whatrvs2 <- 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 nahc(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 nahWe 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).
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.
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
df as their first argument, the combining function must do so as well
x, if necessaryrtables populated and extra) accepted by the functions being stacked.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 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.
c.RowsVerticalSectionThe 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
)
}