---
title: "Advanced rtables - Calling Existing afuns Within Custom afuns"
subtitle: Contributed by Johnson & Johnson Innovative Medicine
date: "2025-10-22"
author:
- Gabriel Becker
- Dan Hofstaedter
output:
    rmarkdown::html_document:
        theme: "spacelab"
        highlight: "kate"
        toc: true
        toc_float: true
        code_folding: show
vignette: >
  %\VignetteIndexEntry{Advanced rtables - Calling Existing afuns Within Custom afuns}
  %\VignetteEncoding{UTF-8}
  %\VignetteEngine{knitr::rmarkdown}
editor_options:
  markdown:
      wrap: 72
  chunk_output_type: console
---

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

```{r, echo=FALSE}
knitr::opts_chunk$set(comment = "#")
```

# Analysis Function Return Values - `RowsVerticalSection`s

Modern analysis functions return cell values via `in_rows`, which
constructs a `RowsVerticalSection` object. While the exact internal
implementation is not important, a `RowsVerticalSection` object
carries around cell values along with a number of *row*-level
formatting and rendering instructions; note that only the "first" (or
left-most) rows vertical section that includes cell values for a given
row will dictate row-level naming and rendering behavior. In
particular, `RowsVerticalSection` objects carry the following
instructions for rendering the resulting rows:


|name| accessor function|description|
|names |`value_names`| Names of the resulting rows|
|labels|`value_labels` | Labels of the resulting rows|
|indent mods| `indent_mod`, `indent_mod<-` | Indent modifiers for resulting rows|
|formats |`obj_format`, `obj_format<-` | **row level** formats|
|NA strings| `obj_na_str`, `obj_na_str<-`| **row level** NA strings|
|footnotes|`row_footnotes`, `row_footnotes<-` | **row level** footnotes|


Note arguments to `in_rows` which don't correspond to one of the
above, e.g., `.aligns`, `.cell_footnotes` and `.stat_names` represent
*cell* level information which is carried around by the cell objects
rather than the `RowsVerticalSection` object. The cells objects can be
extracted via `row_cells`.

## Combining `RowsVerticalSection` Objects

As of version `0.16.16`, `rtables` provides a `c` method for directly
combining `RowsVerticalSection` objects; prior to that this was fairly
straightforward to achieve, requiring developers to combine the values
of the objects as well as each of the above attributes and typically
passing these to the `RowsVerticalSection` constructor directly. For
those using earlier versions of `rtables` we provide example
`RowsVerticalSection` combination code in Appendix A.

```{r}
library(rtables)
rvs1 <- in_rows(what = 17.123, .formats = c(what = "xx.x"))
rvs1
```

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

```{r}
c(rvs1, rvs2)
```

# Combining Existing Analysis Functions

We assume here that all our analysis functions return their computed
cell values via calls to `in_rows`; this should be true of any
function written (or generated via a factor) specifically to be an
analysis function.

There are (at least) three ways to combine existing analysis functions: 
 1. conditionally call one or the other depending on, typically, where
    in the column structure we are,
 2. call both functions and return a `RowsVerticalSection`
    representing all rows generated by either function, or
 3. call one analysis function and then, conditional on row position,
    call another and combine its results to the first.

Either of (2) or (3) can also be combined with (1).  


## Different Analysis Functions For Different Columns

Our first form of combining existing analysis functions is to simply
selectively call one or the other depending on column position. We can
build a risk difference harness using this method:


```{r}
library(rtables)
placeholder_rd_afun <- function(df, .var, .spl_context, ref_path) {
  val <- tail(.spl_context$cur_col_split_val[[1]], 1)
  levs <- levels(df[[.var]])
  len <- length(levs)

  lst <- setNames(rep(val, len), levs)
  in_rows(.list = lst, .formats = setNames(rep("xx", len), levs))
}

comb_afun <- function(df, .var, .spl_context, ref_path) {
  if (grepl("difference", .spl_context$cur_col_id[[1]], ignore.case = TRUE)) {
    ret <- placeholder_rd_afun(df, .var, .spl_context, ref_path)
  } else {
    ret <- simple_analysis(df[[.var]])
  }
  ret
}

adsl <- ex_adsl
adae <- ex_adae

adsl$trt_span <- ifelse(adsl$ARM == "B: Placebo", " ", "Active Treatment")
adae$trt_span <- ifelse(adae$ARM == "B: Placebo", " ", "Active Treatment")
adsl$rr_header <- "Risk Differences"
adae$rr_header <- "Risk Differences"
adsl$rr_label <- paste(adsl$ARM, "vs B: Placebo")
adae$rr_label <- paste(adae$ARM, "vs B: Placebo")

trtmap <- data.frame(
  rr_header = c("Active Treatment", "Active Treatment", " "),
  ARM = c("A: Drug X", "C: Combination", "B: Placebo")
)

lyt <- basic_table() |>
  split_cols_by("trt_span", split_fun = trim_levels_in_group("ARM")) |>
  split_cols_by("ARM") |>
  split_cols_by("rr_header", nested = FALSE) |>
  split_cols_by("rr_label", split_fun = remove_split_levels("B: Placebo vs B: Placebo")) |>
  analyze("AEBODSYS", afun = comb_afun, extra_args = list(ref_path = c("ARM", "B: Placebo")))

build_table(lyt, adae, adsl)
```

Note: while we constructed the spanning variables, risk difference
labels, treatment map and column structure layout instructions
manually to avoid circular dependencies, we refer users to
`grouped_cols_w_diffs` in the `junco` package which encapsulates
creating this particular column structure.

## Stacking Analysis Functions

We can also 'stack' two existing analysis functions by creating new
function which calls each of them and combines the resulting
`RowsVerticalSection` objects. Note that while we will create two toy
example analysis functions to stack here, this approach only really
makes sense when at least one analysis function is pre-existing, such
as those provided by `tern` and `junco`.

```{r}
afun_1 <- function(df, .var) {
  dat_vec <- df[[.var]]
  in_rows("Total Events" = sum(!is.na(dat_vec)))
}

afun_2 <- function(df, .var, .N_col, id) {
  non_na <- !is.na(df[[.var]])
  count <- length(unique(df[[id]]))
  in_rows("Unique Patients" = count * c(1, 1 / .N_col), .formats = c("Unique Patients" = "xx (xx.x%)"))
}

stacked_afun <- function(df, .var, .N_col, id) {
  events_rvs <- afun_1(df, .var)
  pats_rvs <- afun_2(df, .var, .N_col, id)
  c(events_rvs, pats_rvs)
}
```

```{r}
lyt <- basic_table() |>
  split_cols_by("ARM") |>
  split_rows_by("AEBODSYS", split_fun = trim_levels_in_group("AEDECOD")) |>
  split_rows_by("AEDECOD") |>
  analyze("STUDYID", afun = stacked_afun, extra_args = list(id = "USUBJID"))

build_table(lyt, ex_adae, ex_adsl)
```

Note, some care is required, for example

- If any of the stacked afuns accept `df` as their first argument, the
  combining function must do so as well
  - the data vector can be constructed to pass to any that accept `x`,
    if necessary
- The combining function must accept the union of additional arguments
  (both `rtables` populated and extra) accepted by the functions being
  stacked.

## Conditional Stacking

In some cases we want to to add additional analysis rows for only some
values or within only some row facets (recall, all column facets must
have the same number of rows across each row facet, independently).

For example, a simplified version of a disposition table can display
counts for each final study status (`EOSSTT`), and then provide detailed
counts for each reason for discontinuation (`DCSREAS`) under only the
`"DISCONTINUED"` value.

```{r}
afun_count_lbl <- function(df, .var, lbl) {
  in_rows(sum(!is.na(df[[.var]])), .names = lbl)
}
basic_two_tier <- function(df, .var, .spl_context, detail_var, detail_level) {
  values <- lapply(
    levels(df[[.var]]),
    function(lvl) {
      dat <- df[df[[.var]] == lvl, ]
      rvs_out <- afun_count_lbl(dat, .var, lvl)
      if (lvl %in% detail_level) {
        det_rvs <- simple_analysis(dat[[detail_var]])
        indent_mod(det_rvs) <- 1
        rvs_out <- c(rvs_out, det_rvs)
      }
      rvs_out
    }
  )
  ret <- do.call(c, values)
  ret
}
```

Here we use a simple counting function separately for each level in
`.var` (`EOSSTT` in this case), and then - only for the `DISCONTINUED`
level, stack the result of `simple_analysis` for our detail variable
(`DCSREAS` for our table).

```{r}
lyt <- basic_table() |>
  split_cols_by("ARM") |>
  analyze("EOSSTT", afun = basic_two_tier, extra_args = list(detail_var = "DCSREAS", detail_level = "DISCONTINUED"))

build_table(lyt, ex_adsl)
```

Note that for production usage, `junco` provides `a_two_tier` for this
purpose which is preferred to creating our own combination afun from
scratch in most cases.

We leave it as an exercise to use the methods in the
[Split Context](./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.

```{r, eval = FALSE}
c.RowsVerticalSection <- function(...) {
  lst <- list(...)
  if (!all(vapply(lst, function(x) inherits(x, "RowsVerticalSection"), TRUE))) {
    stop("Cannot use c() to combine RowsVerticalSection objects with objects of other classes")
  }

  out <- NextMethod(generic = "c")
  out <- RowsVerticalSection(
    out,
    names = comb_attr_w_dflt(lst, "row_names"),
    labels = comb_attr_w_dflt(lst, "row_labels"),
    indent_mods = comb_attr_w_dflt(lst, "indent_mods", 0L),
    formats = comb_attr_w_dflt(lst, "row_formats", "xx"),
    footnotes = comb_attr_w_dflt(lst, "row_footnotes"),
    format_na_strs = comb_attr_w_dflt(lst, "row_na_strs", NA_character_)
  )
  out
}

comb_attr_w_dflt <- function(lst, attrname, dflt = NULL) {
  unlist(
    lapply(lst, function(x) {
      attr(x, attrname, exact = TRUE) %||% rep(dflt, length(x))
    }),
    recursive = FALSE,
    use.names = FALSE
  )
}
```