TLF generation

Lesson 6 — Clinical Programming with R

Lesson 6 of 12 Advanced ~110 min

Learning objectives

  • Describe the anatomy of a clinical table and the conventions that govern it
  • Build a demographics table with correct big-N denominators
  • Build an adverse event incidence table
  • Handle zero counts, missing categories and rounding correctly
  • Produce publication-quality figures with ggplot2
  • Structure TLF programs so they are reusable and reviewable

Anatomy of a clinical table

Table 14.1.1
Demographic and Baseline Characteristics
Safety Analysis Set

                                Placebo      Drug A       Drug B        Total
                                (N=86)       (N=84)       (N=84)       (N=254)
--------------------------------------------------------------------------------
Age (years)
    n                              86           84           84          254
    Mean (SD)                75.2 (8.59)  74.4 (7.89)  75.7 (8.29)  75.1 (8.25)
    Median                       76.0         76.0         77.5         76.0
    Min, Max                     52, 89       51, 88       56, 88       51, 89

Age group, n (%)
    < 65                      14 (16.3)    11 (13.1)     8 ( 9.5)    33 (13.0)
    65 - 80                   42 (48.8)    47 (56.0)    45 (53.6)   134 (52.8)
    > 80                      30 (34.9)    26 (31.0)    31 (36.9)    87 (34.3)

Sex, n (%)
    Female                    53 (61.6)    40 (47.6)    40 (47.6)   133 (52.4)
    Male                      33 (38.4)    44 (52.4)    44 (52.4)   121 (47.6)
--------------------------------------------------------------------------------
Note: Percentages are based on the number of subjects in the safety analysis set.

Program: t_14_1_1_demographics.R    Generated: 28JUL2026 14:32

Every element is load-bearing:

Element Rule
Table number Matches the SAP and the ICH E3 numbering
Title Exactly as specified in the SAP, word for word
Population Named in the subtitle, and it determines the denominator
Big N Population count per column, in the header, not the count of non-missing
Small n Count of non-missing observations, in the body
Percentages Denominator is big N unless the SAP says otherwise
Zero counts Shown as 0, never blank
Alignment Decimal-aligned numbers, left-aligned labels
Footnotes Explain the denominator and any non-obvious convention
Source Program name and timestamp, for traceability
ImportantBig N versus small n

This is the single most common finding in a TLF review.

  • Big N is the number of subjects in the population for that column. It goes in the header and it is the percentage denominator.
  • Small n is the number of subjects with a non-missing value for that parameter. It goes in the body.

If 254 subjects are in the safety set and 2 have a missing age, then N=254 and n=252 — and the percentages for age groups still divide by 254 unless the SAP explicitly says otherwise.

Building the summary data

Get the numbers right first, format second. Keep them as separate steps.

library(dplyr); library(tidyr)

# --- Big N per column -------------------------------------------------------
big_n <- adsl |>
  filter(SAFFL == "Y") |>
  summarise(N = n(), .by = TRT01A) |>
  bind_rows(tibble(TRT01A = "Total",
                   N = sum(adsl$SAFFL == "Y")))

big_n
#> # A tibble: 4 x 2
#>   TRT01A                   N
#>   <chr>                <int>
#> 1 Placebo                 86
#> 2 Xanomeline Low Dose     84
#> 3 Xanomeline High Dose    84
#> 4 Total                  254

Continuous variables

summarise_continuous <- function(data, var, by, label) {
  data |>
    summarise(
      n      = sum(!is.na({{ var }})),
      mean   = mean({{ var }}, na.rm = TRUE),
      sd     = sd({{ var }}, na.rm = TRUE),
      median = median({{ var }}, na.rm = TRUE),
      min    = min({{ var }}, na.rm = TRUE),
      max    = max({{ var }}, na.rm = TRUE),
      .by    = {{ by }}
    ) |>
    mutate(parameter = label)
}

age_stats <- adsl |>
  filter(SAFFL == "Y") |>
  summarise_continuous(AGE, TRT01A, "Age (years)")

Categorical variables

summarise_categorical <- function(data, var, by, big_n, label) {
  data |>
    count({{ by }}, {{ var }}, .drop = FALSE) |>
    left_join(big_n, by = rlang::as_name(rlang::ensym(by))) |>
    mutate(
      pct       = 100 * n / N,
      parameter = label
    )
}

sex_stats <- adsl |>
  filter(SAFFL == "Y") |>
  mutate(
    TRT01A = factor(TRT01A, levels = c("Placebo", "Xanomeline Low Dose",
                                       "Xanomeline High Dose")),
    SEX    = factor(SEX, levels = c("F", "M"), labels = c("Female", "Male"))
  ) |>
  summarise_categorical(SEX, TRT01A, big_n, "Sex")
Warning.drop = FALSE and factors 
adsl |> count(TRT01A, SEX)
#>   TRT01A   SEX      n
#> 1 Placebo  Female  53
#> 2 Placebo  Male    33
#> 3 Drug A   Female  40
# Drug A / Male missing entirely if no such subject exists

A category with zero subjects in one arm simply does not appear, and the table then has a gap where a 0 (0.0) should be. Making both variables factors with explicit levels and using .drop = FALSE guarantees the full grid.

This is not cosmetic. A blank cell in a safety table reads as “not evaluated”; 0 (0.0) reads as “evaluated, none occurred”. They mean different things.

Formatting

Formatting is a separate concern from computation. Keep it in its own functions so it can be tested and reused.

fmt_n_pct <- function(n, pct, digits = 1) {
  ifelse(is.na(n) | n == 0,
         "0",
         sprintf("%d (%.*f)", n, digits, pct))
}

fmt_mean_sd <- function(mean, sd, digits = 1) {
  ifelse(is.na(mean), "-",
         sprintf("%.*f (%.*f)", digits, mean, digits + 1, sd))
}

fmt_range <- function(min, max, digits = 0) {
  ifelse(is.na(min), "-",
         sprintf("%.*f, %.*f", digits, min, digits, max))
}

Rounding

R uses banker’s rounding (round half to even), SAS rounds half away from zero:

round(0.5)   #> 0     R:   half to even
round(1.5)   #> 2
round(2.5)   #> 2

# SAS ROUND(0.5) = 1, ROUND(2.5) = 3

For a QC comparison against a SAS-produced table, this produces differences in the last digit that look like errors and are not. Match SAS explicitly when required:

round_half_up <- function(x, digits = 0) {
  posneg <- sign(x)
  z <- abs(x) * 10^digits
  z <- z + 0.5 + sqrt(.Machine$double.eps)
  z <- trunc(z) / 10^digits
  z * posneg
}

round_half_up(0.5)   #> 1
round_half_up(2.5)   #> 3

Agree the convention with the statistician and state it in the programming conventions document. sprintf("%.1f", x) also rounds half to even on most platforms, so it is not an escape route.

gtsummary

For exploratory and internal tables, gtsummary is dramatically faster than building the summary by hand.

library(gtsummary)

adsl |>
  filter(SAFFL == "Y") |>
  select(TRT01A, AGE, AGEGR1, SEX, RACE, BMIBL) |>
  tbl_summary(
    by = TRT01A,
    statistic = list(
      all_continuous()  ~ c("{N_nonmiss}", "{mean} ({sd})", "{median}", "{min}, {max}"),
      all_categorical() ~ "{n} ({p}%)"
    ),
    digits = list(all_continuous() ~ 1),
    label = list(AGE ~ "Age (years)", AGEGR1 ~ "Age group",
                 SEX ~ "Sex", RACE ~ "Race", BMIBL ~ "BMI (kg/m²)"),
    missing = "ifany",
    missing_text = "Missing"
  ) |>
  add_overall(col_label = "**Total**  \nN = {N}") |>
  modify_header(label = "**Characteristic**") |>
  modify_caption("**Table 14.1.1 Demographic and Baseline Characteristics**") |>
  modify_footnote(all_stat_cols() ~ "n (%); Mean (SD); Median; Min, Max")

gtsummary produces gt, flextable, huxtable and kableExtra output, so it goes to HTML, Word or PDF easily. What it does not produce is submission-grade RTF with the exact pagination and footnote placement a regulatory package requires — for that, see r2rtf, Tplyr and related packages.

Use gtsummary for: internal reports, DSMB output, publications, exploratory work. Use r2rtf for: the submission.

An AE incidence table

library(dplyr); library(tidyr)

# Population denominators
big_n <- adsl |>
  filter(SAFFL == "Y") |>
  summarise(N = n(), .by = TRT01A)

# Subject-level incidence: use the AOCC flags derived in ADAE
ae_counts <- adae |>
  filter(SAFFL == "Y", TRTEMFL == "Y") |>
  # One row per subject per preferred term
  filter(AOCCPFL == "Y") |>
  count(TRT01A, AEBODSYS, AEDECOD, .drop = FALSE) |>
  left_join(big_n, by = "TRT01A") |>
  mutate(pct = 100 * n / N)

# "Any adverse event" row
any_ae <- adae |>
  filter(SAFFL == "Y", TRTEMFL == "Y", AOCCFL == "Y") |>
  count(TRT01A) |>
  left_join(big_n, by = "TRT01A") |>
  mutate(AEBODSYS = "", AEDECOD = "Any adverse event", pct = 100 * n / N)

# System organ class subtotals
soc_counts <- adae |>
  filter(SAFFL == "Y", TRTEMFL == "Y", AOCCSFL == "Y") |>
  count(TRT01A, AEBODSYS) |>
  left_join(big_n, by = "TRT01A") |>
  mutate(AEDECOD = NA_character_, pct = 100 * n / N)
ImportantSubject incidence, not event counts

An AE table reports the number of subjects with at least one event, not the number of events. A subject with three headaches counts once.

The AOCCFL/AOCCSFL/AOCCPFL flags derived in ADaM (lesson 4) do exactly this. Using them means the table program is a count(), and the incidence logic is defined once, in ADaM, where it can be tested.

The alternative — distinct(USUBJID, AEDECOD) in the table program — works but puts the logic in every table, which is how two tables end up disagreeing.

Assemble, ordering by descending total frequency:

term_order <- ae_counts |>
  summarise(total = sum(n), .by = c(AEBODSYS, AEDECOD)) |>
  arrange(AEBODSYS, desc(total))

table_body <- bind_rows(any_ae, soc_counts, ae_counts) |>
  mutate(cell = sprintf("%d (%.1f)", n, pct)) |>
  select(TRT01A, AEBODSYS, AEDECOD, cell) |>
  pivot_wider(names_from = TRT01A, values_from = cell, values_fill = "0") |>
  # Apply the ordering
  left_join(term_order, by = c("AEBODSYS", "AEDECOD")) |>
  arrange(AEBODSYS, is.na(AEDECOD) == FALSE, desc(total)) |>
  mutate(
    label = if_else(is.na(AEDECOD), AEBODSYS, paste0("    ", AEDECOD))
  ) |>
  select(label, everything(), -AEBODSYS, -AEDECOD, -total)

values_fill = "0" is what puts a 0 in the cell for a term that occurred in one arm and not another.

Figures

library(ggplot2)

# A house theme, defined once
theme_clinical <- function(base_size = 11) {
  theme_bw(base_size = base_size) +
    theme(
      panel.grid.minor   = element_blank(),
      panel.grid.major.x = element_blank(),
      panel.border       = element_rect(colour = "grey30", linewidth = 0.4),
      strip.background   = element_rect(fill = "grey92", colour = "grey30"),
      strip.text         = element_text(face = "bold", size = rel(0.9)),
      legend.position    = "bottom",
      legend.title       = element_blank(),
      plot.title         = element_text(face = "bold", size = rel(1.05)),
      plot.subtitle      = element_text(size = rel(0.92), colour = "grey30"),
      plot.caption       = element_text(size = rel(0.75), colour = "grey40",
                                        hjust = 0)
    )
}

trt_colours <- c("Placebo"              = "#7a8698",
                 "Xanomeline Low Dose"  = "#16355e",
                 "Xanomeline High Dose" = "#0a8f9e")

Mean profile over time

plot_data <- adlb |>
  filter(SAFFL == "Y", PARAMCD == "ALT", ANL01FL == "Y") |>
  summarise(
    n    = sum(!is.na(AVAL)),
    mean = mean(AVAL, na.rm = TRUE),
    se   = sd(AVAL, na.rm = TRUE) / sqrt(sum(!is.na(AVAL))),
    .by  = c(TRT01A, AVISITN, AVISIT)
  )

p <- ggplot(plot_data, aes(AVISITN, mean, colour = TRT01A, group = TRT01A)) +
  geom_line(linewidth = 0.7) +
  geom_point(size = 2) +
  geom_errorbar(aes(ymin = mean - 1.96 * se, ymax = mean + 1.96 * se),
                width = 0.6, linewidth = 0.4) +
  scale_colour_manual(values = trt_colours) +
  scale_x_continuous(breaks = unique(plot_data$AVISITN)) +
  labs(
    title    = "Figure 14.2.1",
    subtitle = "Mean Alanine Aminotransferase Over Time (Safety Analysis Set)",
    x = "Study week", y = "ALT (U/L), mean ± 95% CI",
    caption  = "Error bars show 95% confidence intervals for the mean.\nProgram: f_14_2_1_alt.R"
  ) +
  theme_clinical()

ggsave("output/figures/f_14_2_1_alt.png", p,
       width = 9, height = 6, dpi = 300)
ggsave("output/figures/f_14_2_1_alt.pdf", p,
       width = 9, height = 6, device = cairo_pdf)

Kaplan-Meier

library(survival); library(survminer)

fit <- survfit(Surv(AVAL, 1 - CNSR) ~ TRT01A,
               data = filter(adtte, PARAMCD == "OS"))

ggsurvplot(
  fit,
  data          = filter(adtte, PARAMCD == "OS"),
  risk.table    = TRUE,
  risk.table.height = 0.28,
  conf.int      = TRUE,
  pval          = TRUE,
  pval.method   = TRUE,
  palette       = unname(trt_colours),
  xlab          = "Time from first dose (days)",
  ylab          = "Survival probability",
  legend.title  = "",
  break.time.by = 60,
  censor.shape  = "|",
  ggtheme       = theme_clinical()
)

ggsurvplot() returns a list of plots, not a single ggplot, so saving it needs care:

km <- ggsurvplot(...)
ggsave("output/figures/f_14_2_2_km.png",
       plot = survminer:::.build_ggsurvplot(km), width = 9, height = 7, dpi = 300)

Forest plot

forest_data <- subgroup_results |>
  mutate(subgroup = factor(subgroup, levels = rev(unique(subgroup))))

ggplot(forest_data, aes(y = subgroup, x = estimate)) +
  geom_vline(xintercept = 1, linetype = "dashed", colour = "grey50") +
  geom_errorbarh(aes(xmin = conf.low, xmax = conf.high), height = 0.2) +
  geom_point(size = 2.4, shape = 15) +
  scale_x_log10(breaks = c(0.25, 0.5, 1, 2, 4)) +
  labs(x = "Hazard ratio (95% CI)", y = NULL,
       title = "Figure 14.2.3",
       subtitle = "Subgroup Analysis of Overall Survival") +
  theme_clinical() +
  theme(panel.grid.major.y = element_blank())

Program structure

Every TLF program should have the same shape:

#-------------------------------------------------------------------------------
# Program: t_14_1_1_demographics.R
# Purpose: Table 14.1.1 Demographic and Baseline Characteristics
# Input:   data/adam/adsl.rds
# Output:  output/tables/t_14_1_1_demographics.rtf
# SAP:     Section 7.1
#-------------------------------------------------------------------------------

library(dplyr); library(tidyr); library(r2rtf); library(here)
source(here("R", "table_helpers.R"))

# --- 1. Read and subset -----------------------------------------------------
adsl <- readRDS(here("data", "adam", "adsl.rds")) |> filter(SAFFL == "Y")

# --- 2. Compute -------------------------------------------------------------
big_n     <- compute_big_n(adsl, TRT01A)
age_stats <- summarise_continuous(adsl, AGE, TRT01A, "Age (years)")
sex_stats <- summarise_categorical(adsl, SEX, TRT01A, big_n, "Sex")

# --- 3. Assemble ------------------------------------------------------------
tbl <- bind_rows(format_continuous(age_stats), format_categorical(sex_stats))

# --- 4. Render --------------------------------------------------------------
tbl |>
  rtf_title("Table 14.1.1", "Demographic and Baseline Characteristics",
            "Safety Analysis Set") |>
  rtf_colheader(build_header(big_n), col_rel_width = c(4, 2, 2, 2, 2)) |>
  rtf_body(col_rel_width = c(4, 2, 2, 2, 2),
           text_justification = c("l", rep("c", 4))) |>
  rtf_footnote("Percentages are based on the number of subjects in the safety analysis set.") |>
  rtf_source(program_stamp()) |>
  rtf_encode() |>
  write_rtf(here("output", "tables", "t_14_1_1_demographics.rtf"))

# --- 5. Save the computed data for QC ---------------------------------------
saveRDS(tbl, here("output", "tables", "t_14_1_1_data.rds"))

Step 5 is worth doing on every table: saving the computed numbers separately means the QC programmer can compare numbers with diffdf rather than reading an RTF file.

Common mistakes

Mistake Consequence Fix
Small n used as the percentage denominator Percentages wrong Big N from the population
Blank cell instead of 0 Reads as “not evaluated” Factors + .drop = FALSE + values_fill
Counting events not subjects Incidence overstated Use AOCCPFL
Banker’s rounding vs SAS Spurious QC differences Agree and document the convention
Alphabetical treatment ordering Placebo in the middle Factor with explicit levels
Missing category omitted Denominator unclear missing = "ifany" and show it
Formatting mixed with computation Untestable Separate the two steps
No source footnote Cannot trace the output program_stamp()

Exercise 6.1 — Demographics table

Produce a demographics table with age (n, mean/SD, median, min/max), age group, sex and race, by treatment arm plus total, with correct big-N denominators and zero counts shown.

Show solution 
library(dplyr); library(tidyr); library(purrr)

# --- Setup ------------------------------------------------------------------
pop <- adsl |>
  filter(SAFFL == "Y") |>
  mutate(
    TRT01A  = factor(TRT01A, levels = c("Placebo", "Xanomeline Low Dose",
                                        "Xanomeline High Dose")),
    AGEGR1  = factor(AGEGR1, levels = c("<65", "65-80", ">80")),
    SEX     = factor(SEX, levels = c("F", "M"), labels = c("Female", "Male")),
    RACE    = factor(RACE)
  )

# Add a Total column by duplicating every record
pop_with_total <- bind_rows(pop, mutate(pop, TRT01A = "Total")) |>
  mutate(TRT01A = factor(TRT01A, levels = c(levels(pop$TRT01A), "Total")))

big_n <- pop_with_total |> summarise(N = n(), .by = TRT01A)

# --- Continuous block -------------------------------------------------------
cont_block <- pop_with_total |>
  summarise(
    n      = sum(!is.na(AGE)),
    mean   = mean(AGE, na.rm = TRUE),
    sd     = sd(AGE, na.rm = TRUE),
    median = median(AGE, na.rm = TRUE),
    min    = min(AGE, na.rm = TRUE),
    max    = max(AGE, na.rm = TRUE),
    .by = TRT01A
  ) |>
  transmute(
    TRT01A,
    `n`            = as.character(n),
    `Mean (SD)`    = sprintf("%.1f (%.2f)", mean, sd),
    `Median`       = sprintf("%.1f", median),
    `Min, Max`     = sprintf("%.0f, %.0f", min, max)
  ) |>
  pivot_longer(-TRT01A, names_to = "stat", values_to = "value") |>
  pivot_wider(names_from = TRT01A, values_from = value) |>
  mutate(label = paste0("    ", stat), .keep = "unused", .before = 1) |>
  add_row(label = "Age (years)", .before = 1)

# --- Categorical blocks -----------------------------------------------------
cat_block <- function(data, var, big_n, heading) {
  counts <- data |>
    count(TRT01A, {{ var }}, .drop = FALSE) |>
    left_join(big_n, by = "TRT01A") |>
    mutate(cell = if_else(n == 0, "0", sprintf("%d (%.1f)", n, 100 * n / N))) |>
    select(TRT01A, level = {{ var }}, cell) |>
    pivot_wider(names_from = TRT01A, values_from = cell, values_fill = "0") |>
    mutate(label = paste0("    ", as.character(level)), .keep = "unused",
           .before = 1)

  bind_rows(tibble(label = heading), counts)
}

age_grp <- cat_block(pop_with_total, AGEGR1, big_n, "Age group, n (%)")
sex     <- cat_block(pop_with_total, SEX,    big_n, "Sex, n (%)")
race    <- cat_block(pop_with_total, RACE,   big_n, "Race, n (%)")

# --- Assemble ---------------------------------------------------------------
final <- bind_rows(cont_block, age_grp, sex, race) |>
  mutate(across(everything(), ~ replace_na(.x, "")))

# --- Header with big N ------------------------------------------------------
header <- paste0(
  "Characteristic | ",
  paste(sprintf("%s\\line(N=%d)", big_n$TRT01A, big_n$N), collapse = " | ")
)

final
#> # A tibble: 16 x 5
#>    label            Placebo     `Xanomeline Low Dose` ... Total
#>    <chr>            <chr>       <chr>                     <chr>
#>  1 Age (years)      ""          ""                        ""
#>  2 "    n"          "86"        "84"                      "254"
#>  3 "    Mean (SD)"  "75.2 (8.59)" "75.7 (8.29)"           "75.1 (8.25)"
#>  4 "    Median"     "76.0"      "77.5"                    "76.0"
#>  5 "    Min, Max"   "52, 89"    "56, 88"                  "51, 89"
#>  6 "Age group, n (%)" ""        ""                        ""
#>  7 "    <65"        "14 (16.3)" "8 (9.5)"                 "33 (13.0)"

Three techniques worth extracting:

  • The Total column by row duplication. bind_rows(pop, mutate(pop, TRT01A = "Total")) means every subsequent summarise automatically produces a Total. Computing it separately and joining is more code and more places to get the denominator wrong.
  • .drop = FALSE with factors guarantees every level appears in every arm. Combined with values_fill = "0" in the pivot, no cell can be blank.
  • A generic cat_block() rather than three copies. Adding ethnicity to the table is one line.
For submission the final tibble goes to r2rtf — see the next lesson. Save it as RDS too, so QC can compare numbers rather than reading RTF.

Exercise 6.2 — AE incidence table

Produce an AE table with rows for “Any TEAE”, each system organ class, and each preferred term within class, showing subject incidence n (%) by arm. Restrict to preferred terms occurring in at least 5% of subjects in any arm, ordered by descending total frequency.

Show solution 
library(dplyr); library(tidyr)

# --- Denominators -----------------------------------------------------------
pop <- adsl |> filter(SAFFL == "Y")

big_n <- bind_rows(pop, mutate(pop, TRT01A = "Total")) |>
  summarise(N = n(), .by = TRT01A) |>
  mutate(TRT01A = factor(TRT01A,
    levels = c("Placebo", "Xanomeline Low Dose", "Xanomeline High Dose", "Total")))

# --- TEAE population, with a Total arm --------------------------------------
teae <- adae |>
  filter(SAFFL == "Y", TRTEMFL == "Y")

teae_tot <- bind_rows(teae, mutate(teae, TRT01A = "Total")) |>
  mutate(TRT01A = factor(TRT01A, levels = levels(big_n$TRT01A)))

# --- Counts at three levels, using the ADaM occurrence flags ----------------
count_level <- function(data, flag, ...) {
  data |>
    filter(.data[[flag]] == "Y") |>
    count(TRT01A, ..., .drop = FALSE) |>
    left_join(big_n, by = "TRT01A") |>
    mutate(pct = 100 * n / N)
}

any_ae <- count_level(teae_tot, "AOCCFL") |>
  mutate(AEBODSYS = "zzz_any", AEDECOD = NA_character_, level = 0L)

soc <- count_level(teae_tot, "AOCCSFL", AEBODSYS) |>
  mutate(AEDECOD = NA_character_, level = 1L)

pt <- count_level(teae_tot, "AOCCPFL", AEBODSYS, AEDECOD) |>
  mutate(level = 2L)

# --- 5% threshold in ANY treatment arm (excluding Total) --------------------
keep_pt <- pt |>
  filter(TRT01A != "Total") |>
  summarise(max_pct = max(pct, na.rm = TRUE), .by = c(AEBODSYS, AEDECOD)) |>
  filter(max_pct >= 5) |>
  select(AEBODSYS, AEDECOD)

pt <- semi_join(pt, keep_pt, by = c("AEBODSYS", "AEDECOD"))

# Recompute SOC subtotals restricted to the retained SOCs
soc <- semi_join(soc, distinct(keep_pt, AEBODSYS), by = "AEBODSYS")

# --- Ordering ---------------------------------------------------------------
soc_order <- pt |>
  filter(TRT01A == "Total") |>
  summarise(soc_total = sum(n), .by = AEBODSYS) |>
  arrange(desc(soc_total)) |>
  mutate(soc_rank = row_number())

pt_order <- pt |>
  filter(TRT01A == "Total") |>
  select(AEBODSYS, AEDECOD, pt_total = n)

# --- Assemble ---------------------------------------------------------------
table_ae <- bind_rows(any_ae, soc, pt) |>
  mutate(cell = if_else(n == 0, "0", sprintf("%d (%.1f)", n, pct))) |>
  select(AEBODSYS, AEDECOD, level, TRT01A, cell) |>
  pivot_wider(names_from = TRT01A, values_from = cell, values_fill = "0") |>
  left_join(soc_order, by = "AEBODSYS") |>
  left_join(pt_order,  by = c("AEBODSYS", "AEDECOD")) |>
  mutate(
    soc_rank = if_else(AEBODSYS == "zzz_any", -1L, soc_rank),
    pt_total = coalesce(pt_total, .Machine$integer.max)   # SOC rows sort first
  ) |>
  arrange(soc_rank, level, desc(pt_total)) |>
  mutate(
    label = case_when(
      level == 0L ~ "Subjects with any TEAE",
      level == 1L ~ AEBODSYS,
      level == 2L ~ paste0("    ", AEDECOD)
    )
  ) |>
  select(label, Placebo, `Xanomeline Low Dose`, `Xanomeline High Dose`, Total)

table_ae
#> # A tibble: 23 x 5
#>    label                              Placebo   `Xanomeline Low Dose` ... Total
#>    <chr>                              <chr>     <chr>                     <chr>
#>  1 Subjects with any TEAE             69 (80.2) 77 (91.7)                 226 (89.0)
#>  2 GENERAL DISORDERS AND ...          21 (24.4) 42 (50.0)                 105 (41.3)
#>  3 "    APPLICATION SITE ERYTHEMA"     3 ( 3.5) 24 (28.6)                  50 (19.7)
#>  4 "    APPLICATION SITE PRURITUS"     3 ( 3.5) 27 (32.1)                  54 (21.3)

The details that matter:

  • The 5% threshold is evaluated per arm, excluding Total. A term at 4% in every arm but 6% overall does not qualify — the convention is “≥5% in any treatment group”, and including Total in the maximum would change which terms appear.
  • SOC subtotals come from AOCCSFL, not from summing the preferred terms. A subject with two different terms in the same SOC counts once at SOC level and twice at PT level, so the subtotal is genuinely less than the sum. Summing the PT rows is a classic error that produces subtotals exceeding the population.
  • SOC rows sort before their preferred terms via level in the arrange(), and pt_total = .Machine$integer.max for SOC rows keeps them at the top of their block regardless of the descending sort.
  • Restricting SOCs to those with a retained PT avoids an SOC heading with no terms under it — which happens when every term in an SOC falls below 5%.
Whether the SOC subtotal should also be restricted to the retained terms is a SAP question. Here it is not: the SOC row reports all subjects with any event in that class, which is the standard reading, and the footnote should say so.

Recap

  • Big N is the population count and the percentage denominator; small n is non-missing
  • Zero must appear as 0, never blank — factors, .drop = FALSE, values_fill
  • AE tables count subjects, not events — use the ADaM AOCC* flags
  • SOC subtotals come from AOCCSFL, never from summing preferred terms
  • R rounds half to even, SAS rounds half up — agree and document the convention
  • Separate computation from formatting so both can be tested
  • gtsummary for internal and publication output; r2rtf for submission
  • Save the computed numbers as RDS so QC compares data, not RTF

Next: r2rtf, Tplyr and related packages.

Back to top