Demographics Summary

Summary of Demographic and Baseline Characteristics

Setup

See Prerequisites for installation instructions.

library(arframe)
library(pharmaverseadam)
library(dplyr, warn.conflicts = FALSE)
library(tidyr)
library(cards)

adsl_saf <- pharmaverseadam::adsl |>
  blank_to_na() |>
  filter(SAFFL == "Y", TRT01A != "Screen Failure") |>
  mutate(
    AGEGR1 = factor(AGEGR1, levels = c("18-64", ">64")),
    SEX    = factor(SEX, levels = c("F", "M")),
    RACE   = factor(RACE, levels = c(
      "WHITE", "BLACK OR AFRICAN AMERICAN", "ASIAN",
      "AMERICAN INDIAN OR ALASKA NATIVE"
    )),
    ETHNIC = factor(ETHNIC, levels = c(
      "HISPANIC OR LATINO", "NOT HISPANIC OR LATINO", "NOT REPORTED"
    ))
  )

arm_n <- adsl_saf |> count(TRT01A) |> pull(n, name = TRT01A)
arm_levels <- names(arm_n)
n_vec <- c(arm_n, Total = sum(arm_n))

Data Preparation

# ── Continuous helper ──
cont_summary <- function(data, var, var_label) {
  by_arm <- data |>
    group_by(TRT01A) |>
    summarise(
      n          = as.character(n()),
      `Mean (SD)` = sprintf("%.1f (%.2f)", mean(.data[[var]]), sd(.data[[var]])),
      Median     = sprintf("%.1f", median(.data[[var]])),
      `Q1, Q3`   = sprintf("%.1f, %.1f",
                           quantile(.data[[var]], 0.25),
                           quantile(.data[[var]], 0.75)),
      `Min, Max` = sprintf("%.0f, %.0f", min(.data[[var]]), max(.data[[var]])),
      .groups = "drop"
    ) |>
    pivot_longer(-TRT01A, names_to = "stat_label", values_to = "value") |>
    pivot_wider(names_from = TRT01A, values_from = value) |>
    mutate(variable = var_label, .before = 1)

  total <- data |>
    summarise(
      n          = as.character(n()),
      `Mean (SD)` = sprintf("%.1f (%.2f)", mean(.data[[var]]), sd(.data[[var]])),
      Median     = sprintf("%.1f", median(.data[[var]])),
      `Q1, Q3`   = sprintf("%.1f, %.1f",
                           quantile(.data[[var]], 0.25),
                           quantile(.data[[var]], 0.75)),
      `Min, Max` = sprintf("%.0f, %.0f", min(.data[[var]]), max(.data[[var]]))
    ) |>
    pivot_longer(everything(), names_to = "stat_label", values_to = "Total")

  left_join(by_arm, total, by = "stat_label")
}

# ── Categorical helper (uses .drop = FALSE to include 0-count factor levels) ──
cat_summary <- function(data, var, var_label) {
  N_arm <- data |> count(TRT01A, name = "N")

  by_arm <- data |>
    count(TRT01A, .data[[var]], .drop = FALSE) |>
    left_join(N_arm, by = "TRT01A") |>
    mutate(pct = sprintf("%d (%.1f)", n, n / N * 100)) |>
    select(TRT01A, stat_label = all_of(var), pct) |>
    pivot_wider(names_from = TRT01A, values_from = pct)

  N_total <- nrow(data)
  total <- data |>
    count(.data[[var]], .drop = FALSE) |>
    mutate(Total = sprintf("%d (%.1f)", n, n / N_total * 100)) |>
    select(stat_label = all_of(var), Total)

  left_join(by_arm, total, by = "stat_label") |>
    mutate(variable = var_label, .before = 1)
}

# ── Build summary ──
demog_wide <- bind_rows(
  cont_summary(adsl_saf, "AGE", "Age (years)"),
  cat_summary(adsl_saf, "AGEGR1", "Age Group, n (%)"),
  cat_summary(adsl_saf, "SEX", "Sex, n (%)"),
  cat_summary(adsl_saf, "RACE", "Race, n (%)"),
  cat_summary(adsl_saf, "ETHNIC", "Ethnicity, n (%)")
)
demog_ard <- ard_stack(
  data = adsl_saf,
  .by = "TRT01A",
  ard_continuous(variables = "AGE"),
  ard_categorical(variables = c("AGEGR1", "SEX", "RACE", "ETHNIC")),
  .overall = TRUE
)

demog_cards <- fr_wide_ard(
  demog_ard,
  statistic = list(
    continuous = c(
      "n"         = "{N}",
      "Mean (SD)" = "{mean} ({sd})",
      "Median"    = "{median}",
      "Q1, Q3"    = "{p25}, {p75}",
      "Min, Max"  = "{min}, {max}"
    ),
    categorical = "{n} ({p}%)"
  ),
  decimals = c(mean = 1, sd = 2, median = 1, p25 = 1, p75 = 1, p = 1),
  label = c(
    AGE    = "Age (years)",
    AGEGR1 = "Age Group, n (%)",
    SEX    = "Sex, n (%)",
    RACE   = "Race, n (%)",
    ETHNIC = "Ethnicity, n (%)"
  )
)

arframe Pipeline

The rendered table below uses the dplyr data prep (demog_wide). The cards tab produces an equivalent demog_cards — swap it in to use the cards path instead.

demog_wide |>
  fr_table() |>
  fr_titles(
    "Table 14.1.5",
    "Summary of Demographic and Baseline Characteristics",
    "Safety Population"
  ) |>
  fr_cols(
    variable   = fr_col(visible = FALSE),
    stat_label = fr_col("", width = 2.5),
    !!!setNames(
      lapply(arm_levels, function(a) fr_col(a, align = "decimal")),
      arm_levels
    ),
    Total = fr_col("Total", align = "decimal"),
    .n = n_vec
  ) |>
  fr_header(bold = TRUE, align = "center") |>
  fr_rows(
    group_by    = list(cols = "variable", label = "stat_label"),
    blank_after = "variable",
    group_style = list(bold = TRUE)
  ) |>
  fr_footnotes(
    "Percentages based on N per treatment group.",
    "CDISCPILOT01 Safety Population."
  )

Rendered Table

Table 14.1.5
Summary of Demographic and Baseline Characteristics
Safety Population
Placebo
(N=86)		Xanomeline High Dose
(N=72)		Xanomeline Low Dose
(N=96)		Total
(N=254)
Age (years)
n86 72 96 254
Mean (SD)75.2 (8.59)73.8 (7.94)76.0 (8.11) 75.1 (8.25)
Median76.0 75.5 78.0 77.0
Q1, Q369.2, 81.8 70.5, 79.0 71.0, 82.0 70.0, 81.0
Min, Max52 , 89 56 , 88 51 , 88 51 , 89
Age Group, n (%)
18-6414 (16.3) 11 (15.3) 8 ( 8.3) 33 (13.0)
>6472 (83.7) 61 (84.7) 88 (91.7) 221 (87.0)
Sex, n (%)
F53 (61.6) 35 (48.6) 55 (57.3) 143 (56.3)
M33 (38.4) 37 (51.4) 41 (42.7) 111 (43.7)
Race, n (%)
WHITE78 (90.7) 62 (86.1) 90 (93.8) 230 (90.6)
BLACK OR AFRICAN AMERICAN 8 ( 9.3) 9 (12.5) 6 ( 6.2) 23 ( 9.1)
ASIAN 0 ( 0.0) 0 ( 0.0) 0 ( 0.0) 0 ( 0.0)
AMERICAN INDIAN OR ALASKA NATIVE 0 ( 0.0) 1 ( 1.4) 0 ( 0.0) 1 ( 0.4)
Ethnicity, n (%)
HISPANIC OR LATINO 3 ( 3.5) 3 ( 4.2) 6 ( 6.2) 12 ( 4.7)
NOT HISPANIC OR LATINO83 (96.5) 69 (95.8) 90 (93.8) 242 (95.3)
NOT REPORTED 0 ( 0.0) 0 ( 0.0) 0 ( 0.0) 0 ( 0.0)
Percentages based on N per treatment group.
CDISCPILOT01 Safety Population.
/opt/quarto/share/rmd/rmd.R 01APR2026 09:52:46