Death Summary

Summary of Deaths

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

adae <- pharmaverseadam::adae |>
  blank_to_na() |>
  filter(SAFFL == "Y")

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

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

# ── Identify deaths and TE status ──
adsl_deaths <- adsl_saf |>
  filter(DTHFL == "Y") |>
  mutate(DTHCAUS = if_else(is.na(DTHCAUS), "Unknown", DTHCAUS))

# Treatment-emergent deaths: subjects with AESDTH == "Y" in ADAE
te_death_ids <- adae |>
  filter(AESDTH == "Y", TRTEMFL == "Y") |>
  distinct(USUBJID) |>
  pull(USUBJID)

adsl_deaths <- adsl_deaths |>
  mutate(death_type = if_else(
    USUBJID %in% te_death_ids,
    "Treatment-emergent deaths",
    "Non-treatment-emergent deaths"
  ))

# ── Helper: summary row ──
death_row <- function(data, adsl_data, row_label, category, N_total) {
  by_arm <- data |>
    count(TRT01A) |>
    complete(TRT01A = arm_levels, fill = list(n = 0L)) |>
    left_join(
      adsl_data |> count(TRT01A, name = "N"),
      by = "TRT01A"
    ) |>
    mutate(pct = n_pct(n, N)) |>
    select(TRT01A, pct) |>
    pivot_wider(names_from = TRT01A, values_from = pct)

  total_n <- nrow(data)
  by_arm |>
    mutate(
      category   = category,
      stat_label = row_label,
      Total      = n_pct(total_n, N_total),
      .before    = 1
    )
}

# ── Total deaths ──
total_row <- death_row(adsl_deaths, adsl_saf, "Total deaths", "Total", N_total)

# ── Treatment-emergent deaths header + by cause ──
te_deaths <- adsl_deaths |> filter(death_type == "Treatment-emergent deaths")
te_header <- death_row(te_deaths, adsl_saf,
                       "Treatment-emergent deaths", "Treatment-emergent", N_total)

te_cause_rows <- if (nrow(te_deaths) > 0) {
  lapply(sort(unique(te_deaths$DTHCAUS)), function(cause) {
    death_row(
      te_deaths |> filter(DTHCAUS == cause),
      adsl_saf,
      paste0("  ", tools::toTitleCase(tolower(cause))),
      "Treatment-emergent",
      N_total
    )
  }) |> bind_rows()
} else {
  tibble()
}

# ── Non-treatment-emergent deaths header + by cause ──
nte_deaths <- adsl_deaths |> filter(death_type == "Non-treatment-emergent deaths")
nte_header <- death_row(nte_deaths, adsl_saf,
                        "Non-treatment-emergent deaths", "Non-treatment-emergent", N_total)

nte_cause_rows <- if (nrow(nte_deaths) > 0) {
  lapply(sort(unique(nte_deaths$DTHCAUS)), function(cause) {
    death_row(
      nte_deaths |> filter(DTHCAUS == cause),
      adsl_saf,
      paste0("  ", tools::toTitleCase(tolower(cause))),
      "Non-treatment-emergent",
      N_total
    )
  }) |> bind_rows()
} else {
  tibble()
}

# ── Combine ──
death_wide <- bind_rows(
  total_row,
  te_header, te_cause_rows,
  nte_header, nte_cause_rows
) |>
  mutate(across(
    all_of(c(arm_levels, "Total")),
    ~ replace_na(.x, "0 (0.0)")
  ))
# Build subject-level flags for cards
te_death_ids <- adae |>
  filter(AESDTH == "Y", TRTEMFL == "Y") |>
  distinct(USUBJID) |>
  pull(USUBJID)

death_subj <- adsl_saf |>
  select(USUBJID, TRT01A, DTHFL, DTHCAUS) |>
  mutate(
    is_death    = DTHFL == "Y" & !is.na(DTHFL),
    is_te_death = is_death & USUBJID %in% te_death_ids,
    is_nte_death = is_death & !USUBJID %in% te_death_ids
  )

death_ard <- ard_stack(
  data = death_subj,
  .by  = "TRT01A",
  ard_dichotomous(
    variables = c(is_death, is_te_death, is_nte_death),
    value = list(is_death = TRUE, is_te_death = TRUE, is_nte_death = TRUE)
  ),
  .overall = TRUE
)

death_cards <- fr_wide_ard(
  death_ard,
  statistic = list(dichotomous = "{n} ({p}%)"),
  decimals  = c(p = 1),
  label     = c(
    is_death     = "Total deaths",
    is_te_death  = "Treatment-emergent deaths",
    is_nte_death = "Non-treatment-emergent deaths"
  )
)

arframe Pipeline

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

death_wide |>
  fr_table() |>
  fr_titles(
    "Table 14.3.2",
    "Summary of Deaths",
    "Safety Population"
  ) |>
  fr_cols(
    category   = fr_col(visible = FALSE),
    stat_label = fr_col("Deaths", width = 3.0),
    !!!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(death_wide$stat_label %in%
      c("Total deaths", "Treatment-emergent deaths", "Non-treatment-emergent deaths")),
      bold = TRUE)
  ) |>
  fr_footnotes(
    "Treatment-emergent deaths: death reported as outcome of a treatment-emergent AE.",
    "Non-treatment-emergent deaths: deaths from ADSL not linked to a TE adverse event.",
    "Percentages based on N per treatment group.",
    "CDISCPILOT01 Safety Population."
  )

Rendered Table

Table 14.3.2
Summary of Deaths
Safety Population
DeathsTotal
(N=254)		Placebo
(N=86)		Xanomeline High Dose
(N=72)		Xanomeline Low Dose
(N=96)
Total
Total deaths3 (1.2)2 (2.3)0 1 (1.0)
Treatment-emergent
Treatment-emergent deaths3 (1.2)2 (2.3)0 1 (1.0)
Completed Suicide1 (0.4)1 (1.2)0 0
Myocardial Infarction1 (0.4)1 (1.2)0 0
Sudden Death1 (0.4)0 0 1 (1.0)
Non-treatment-emergent
Non-treatment-emergent deaths0 0 0 0
Treatment-emergent deaths: death reported as outcome of a treatment-emergent AE.
Non-treatment-emergent deaths: deaths from ADSL not linked to a TE adverse event.
Percentages based on N per treatment group.
CDISCPILOT01 Safety Population.
/opt/quarto/share/rmd/rmd.R 01APR2026 09:52:42