Advanced rtables - Calling Existing afuns Within Custom afuns"
In rtables: Reporting Tables

suggested_dependent_pkgs <- c("dplyr")
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  eval = all(vapply(
    suggested_dependent_pkgs,
    requireNamespace,
    logical(1),
    quietly = TRUE
  ))
)

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:

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)
rvs1 <- in_rows(what = 17.123, .formats = c(what = "xx.x"))
rvs1

rvs2 <- in_rows(
  ok = "hi",
  nah = "bye",
  .indent_mods = c(ok = 1, nah = -1), .row_footnotes = list(nah = "I guess not ...")
)
rvs2

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:

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.

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)

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.

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)

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 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.

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
  )
}