Disposition Summary

Subject Disposition — Treatment or Follow-up Summary

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

arm_levels <- c("Placebo", "Xanomeline Low Dose", "Xanomeline High Dose")
arm_n <- setNames(
  vapply(arm_levels, function(a) sum(adsl_saf$TRT01A == a), integer(1L)),
  arm_levels
)
N_total <- nrow(adsl_saf)
n_vec   <- c(arm_n, Total = N_total)

Data Preparation

dplyr

n_pct <- function(n, N) sprintf("%d (%.1f)", n, n / N * 100)

# ── Helper: count row per arm + Total ──
disp_row <- function(data, condition, row_label, category, N_total,
                     format = "n_pct") {
  condition <- rlang::enquo(condition)
  by_arm <- data |>
    group_by(TRT01A) |>
    summarise(n = sum(!!condition, na.rm = TRUE), N = n(), .groups = "drop")

  total_n <- sum(rlang::eval_tidy(condition, data = data), na.rm = TRUE)

  if (format == "n_pct") {
    by_arm <- by_arm |>
      mutate(val = n_pct(n, N)) |>
      select(TRT01A, val) |>
      pivot_wider(names_from = TRT01A, values_from = val)
    total_val <- n_pct(total_n, N_total)
  } else {
    by_arm <- by_arm |>
      mutate(val = as.character(n)) |>
      select(TRT01A, val) |>
      pivot_wider(names_from = TRT01A, values_from = val)
    total_val <- as.character(total_n)
  }

  by_arm |>
    mutate(category = category, stat_label = row_label,
           Total = total_val, .before = 1)
}

# ── Derive disposition reason from EOSSTT + DTHCAUS ──
# pharmaverseadam ADSL has EOSSTT but no DCSREAS.
# Derive reason from DTHFL, DTHCAUS, and EOSSTT.
adsl_disp <- adsl_saf |>
  mutate(
    disp_status = case_when(
      EOSSTT == "COMPLETED"    ~ "Completed",
      EOSSTT == "DISCONTINUED" ~ "Discontinued",
      is.na(EOSSTT)            ~ "Ongoing",
      TRUE                     ~ EOSSTT
    ),
    disc_reason = case_when(
      disp_status != "Discontinued" ~ NA_character_,
      DTHFL == "Y"                  ~ "Death",
      TRUE                          ~ "Other"
    )
  )

# ── Build rows ──
enrolled_row <- disp_row(adsl_disp, TRUE, "Enrolled", "Enrollment",
                         N_total, format = "n")

completed_row <- disp_row(adsl_disp, disp_status == "Completed",
                          "Completed", "Completion", N_total)

disc_header <- disp_row(adsl_disp, disp_status == "Discontinued",
                        "Discontinued", "Discontinuation", N_total)

# Discontinuation reasons
disc_reasons <- adsl_disp |>
  filter(disp_status == "Discontinued") |>
  pull(disc_reason) |>
  na.omit() |>
  unique() |>
  sort()

disc_reason_rows <- lapply(disc_reasons, function(reason) {
  disp_row(adsl_disp, disp_status == "Discontinued" & disc_reason == reason,
           paste0("  ", reason), "Discontinuation", N_total)
}) |> bind_rows()

ongoing_row <- disp_row(adsl_disp, disp_status == "Ongoing",
                        "Ongoing", "Ongoing", N_total)

disp_wide <- bind_rows(
  enrolled_row, completed_row,
  disc_header, disc_reason_rows,
  ongoing_row
) |>
  mutate(across(all_of(c(arm_levels, "Total")),
                ~ replace_na(.x, "0 (0.0)")))

cards

adsl_disp <- adsl_saf |>
  mutate(
    DISP_CAT = case_when(
      EOSSTT == "COMPLETED"    ~ "Completed",
      EOSSTT == "DISCONTINUED" ~ "Discontinued",
      is.na(EOSSTT)            ~ "Ongoing",
      TRUE                     ~ EOSSTT
    )
  )

disp_ard <- ard_stack(
  data   = adsl_disp,
  .by    = "TRT01A",
  ard_categorical(variables = "DISP_CAT"),
  .overall = TRUE
)

disp_cards <- fr_wide_ard(
  disp_ard,
  statistic = list(categorical = "{n} ({p}%)"),
  decimals  = c(p = 1),
  label     = c(DISP_CAT = "Disposition Status")
)

arframe Pipeline

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

disp_wide |>
  fr_table() |>
  fr_titles(
    "Table 14.1.3",
    "Subject Disposition",
    "Safety Population"
  ) |>
  fr_cols(
    category   = fr_col(visible = FALSE),
    stat_label = fr_col("", width = 2.8),
    !!!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 = "category", label = "stat_label"),
    blank_after = "category",
    group_style = list(bold = TRUE)
  ) |>
  fr_styles(
    fr_row_style(rows = which(disp_wide$stat_label %in%
      c("Enrolled", "Completed", "Discontinued")), bold = TRUE)
  ) |>
  fr_footnotes(
    "Percentages based on N per treatment group.",
    "Discontinued reasons derived from ADSL (DTHFL, EOSSTT).",
    "CDISCPILOT01 Safety Population."
  )

Rendered Table

Table 14.1.3

Subject Disposition

Safety Population

	Total (N=254)	Placebo (N=86)	Xanomeline High Dose (N=72)	Xanomeline Low Dose (N=96)
Enrollment
Enrolled	1	1	1	1
Completion
Completed	110 (43.3)	58 (67.4)	27 (37.5)	25 (26.0)
Discontinuation
Discontinued	144 (56.7)	28 (32.6)	45 (62.5)	71 (74.0)
Death	3 ( 1.2)	2 ( 2.3)	0	1 ( 1.0)
Other	141 (55.5)	26 (30.2)	45 (62.5)	70 (72.9)
Ongoing
Ongoing	0	0	0	0

Percentages based on N per treatment group.

Discontinued reasons derived from ADSL (DTHFL, EOSSTT).

CDISCPILOT01 Safety Population.

/opt/quarto/share/rmd/rmd.R 01APR2026 09:52:50