---
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 overall/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 re-leveling) 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 re-leveling, 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)
```
### Pre-sorting Or Pre-pruning 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 re-leveling *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)
```