Table 2: TEAE by SOC/PT

Add this at the top to ensure dependencies are installed during rendering.

Code

options(repos = c(CRAN = "https://cloud.r-project.org"))

Code

# setwd(dirname(rstudioapi::getActiveDocumentContext()$path))

Install + load packages (run once; safe to re-run)

Code

pacman::p_load(haven, dplyr, tidyr, purrr, glue, lubridate, stringr, EDCimport, pharmaRTF, data.table, gtsummary, gt, flextable, hms)

Prepare the data

Code

adsl <- read_xpt("adsl.xpt")

sbj <- bind_rows(
           adsl |>  mutate(trtn = trt01an, trt = trt01a),
           adsl |>  mutate(trtn = 99,     trt = "Overall")) |> 
           filter(saffl=="Y")


adae <- read_xpt("adae.xpt")

ae <- bind_rows(
           adae |>  mutate(trtn = trtan, trt = trta),
           adae |>  mutate(trtn = 99,     trt = "Overall")) |> 
           filter(saffl=="Y",trtemfl=="Y")

Get the columns headers with big N and Treatment Name

Code

bign <- sbj |>
  distinct(usubjid, trtn, trt) |>
  count(trtn, trt, name = "N")

finalsbj <- sbj |>
  left_join(bign, by = c("trtn", "trt")) |>
  mutate(trtlab = glue("{trt} (N= {N})")) 
 
#finalae <- ae |>
#  left_join(bign, by = c("trtn", "trt")) |>
#  mutate(trtlab = glue("{trt} (N= {N})"))

bigN <- finalsbj |> distinct(trtn, trtlab, N) |> 
  arrange(trtn)

bigN

# A tibble: 4 × 3
   trtn trtlab              N
  <dbl> <glue>          <int>
1     1 Placebo (N= 5)      5
2     2 TRT A (N= 5)        5
3     3 TRT B (N= 5)        5
4    99 Overall (N= 15)    15

Impute Zeros for Treatment Arms with N = 0

Code

dummytrt<- tibble(trtn = c(1, 2, 3, 99))

Code

temptrtN<-sbj |> count(trtn, trt)
temptrtN

# A tibble: 4 × 3
   trtn trt         n
  <dbl> <chr>   <int>
1     1 Placebo     5
2     2 TRT A       5
3     3 TRT B       5
4    99 Overall    15

Code

trtN<-dummytrt  |> 
    left_join(temptrtN ,by=c("trtn")) |> 
    mutate(N=if_else(is.na(n),0,n)) |> 
    select(-n)

trtN

# A tibble: 4 × 3
   trtn trt         N
  <dbl> <chr>   <dbl>
1     1 Placebo     5
2     2 TRT A       5
3     3 TRT B       5
4    99 Overall    15

TOP row : Overall: Number of subjects with at least one TEAE.

Code

sub_n<- ae |> 
    group_by(trtn) |> 
    summarise(label= "Overall", count = n_distinct(usubjid), events=n()) |> 
    ungroup()

sub_n

# A tibble: 4 × 4
   trtn label   count events
  <dbl> <chr>   <int>  <int>
1     1 Overall     4     19
2     2 Overall     4     30
3     3 Overall     5     25
4    99 Overall    13     74

SOC rows: Number of subjects with at least one TEAE in the specified SOC.

Code

soc_n <- ae |>
    group_by(aebodsys, trtn) |>
    summarise(
    count  = n_distinct(usubjid),
    events = n(),
    .groups = "drop"        # or "drop_last" / "keep"
  )

soc_n

# A tibble: 28 × 4
   aebodsys                                              trtn count events
   <chr>                                                <dbl> <int>  <int>
 1 CARDIAC DISORDERS                                        1     2      2
 2 CARDIAC DISORDERS                                       99     2      2
 3 EYE DISORDERS                                            1     1      3
 4 EYE DISORDERS                                           99     1      3
 5 GASTROINTESTINAL DISORDERS                               1     2      3
 6 GASTROINTESTINAL DISORDERS                              99     2      3
 7 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS     1     2      3
 8 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS     2     3     13
 9 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS     3     5     19
10 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS    99    10     35
# ℹ 18 more rows

PT Rows: Number of subjects with at least one TEAE in the specified PT.

Code

pt_n <- ae |>
    group_by(aebodsys, aedecod,trtn) |>
    summarise(
    count  = n_distinct(usubjid),
    events = n(),
    .groups = "drop"
  )

pt_n

# A tibble: 74 × 5
   aebodsys          aedecod                               trtn count events
   <chr>             <chr>                                <dbl> <int>  <int>
 1 CARDIAC DISORDERS ATRIOVENTRICULAR BLOCK SECOND DEGREE     1     1      1
 2 CARDIAC DISORDERS ATRIOVENTRICULAR BLOCK SECOND DEGREE    99     1      1
 3 CARDIAC DISORDERS BUNDLE BRANCH BLOCK LEFT                 1     1      1
 4 CARDIAC DISORDERS BUNDLE BRANCH BLOCK LEFT                99     1      1
 5 EYE DISORDERS     EYE ALLERGY                              1     1      1
 6 EYE DISORDERS     EYE ALLERGY                             99     1      1
 7 EYE DISORDERS     EYE PRURITUS                             1     1      1
 8 EYE DISORDERS     EYE PRURITUS                            99     1      1
 9 EYE DISORDERS     EYE SWELLING                             1     1      1
10 EYE DISORDERS     EYE SWELLING                            99     1      1
# ℹ 64 more rows

Combine Top Row (Overall), SOC-level, and PT-level counts into a single dataset and replace missing values (NAs) with blanks.

Code

all_Ntemp <- bind_rows(sub_n, soc_n, pt_n) |> 
    mutate(across(c(label, aebodsys, aedecod), ~ if_else(is.na(.), "", .)))

Create zero counts for treatment groups where an event is not observed.

Get all available SOC and PT values (Overall, SOC, and SOC/PT combinations).
Create one row per treatment group for each Overall/SOC/PT row.

Code

dummy_ae<-all_Ntemp |> 
    complete(nesting(label,aebodsys,aedecod),trtn=c(1,2,3,99)) |> 
    select(-count,-events)
dummy_ae

# A tibble: 168 × 4
   label aebodsys          aedecod                                 trtn
   <chr> <chr>             <chr>                                  <dbl>
 1 ""    CARDIAC DISORDERS ""                                         1
 2 ""    CARDIAC DISORDERS ""                                         2
 3 ""    CARDIAC DISORDERS ""                                         3
 4 ""    CARDIAC DISORDERS ""                                        99
 5 ""    CARDIAC DISORDERS "ATRIOVENTRICULAR BLOCK SECOND DEGREE"     1
 6 ""    CARDIAC DISORDERS "ATRIOVENTRICULAR BLOCK SECOND DEGREE"     2
 7 ""    CARDIAC DISORDERS "ATRIOVENTRICULAR BLOCK SECOND DEGREE"     3
 8 ""    CARDIAC DISORDERS "ATRIOVENTRICULAR BLOCK SECOND DEGREE"    99
 9 ""    CARDIAC DISORDERS "BUNDLE BRANCH BLOCK LEFT"                 1
10 ""    CARDIAC DISORDERS "BUNDLE BRANCH BLOCK LEFT"                 2
# ℹ 158 more rows

Merge the dummy AE grid with the observed counts.
For rows not present in the data, set subject counts and event counts to 0.

Code

all_Ntemp2<-dummy_ae |> 
    left_join(all_Ntemp,by=c("label","aebodsys", "aedecod", "trtn")) |>
    mutate(across(c(count,events),~if_else(is.na(.),0,.)))

all_Ntemp2

# A tibble: 168 × 6
   label aebodsys          aedecod                             trtn count events
   <chr> <chr>             <chr>                              <dbl> <dbl>  <dbl>
 1 ""    CARDIAC DISORDERS ""                                     1     2      2
 2 ""    CARDIAC DISORDERS ""                                     2     0      0
 3 ""    CARDIAC DISORDERS ""                                     3     0      0
 4 ""    CARDIAC DISORDERS ""                                    99     2      2
 5 ""    CARDIAC DISORDERS "ATRIOVENTRICULAR BLOCK SECOND DE…     1     1      1
 6 ""    CARDIAC DISORDERS "ATRIOVENTRICULAR BLOCK SECOND DE…     2     0      0
 7 ""    CARDIAC DISORDERS "ATRIOVENTRICULAR BLOCK SECOND DE…     3     0      0
 8 ""    CARDIAC DISORDERS "ATRIOVENTRICULAR BLOCK SECOND DE…    99     1      1
 9 ""    CARDIAC DISORDERS "BUNDLE BRANCH BLOCK LEFT"             1     1      1
10 ""    CARDIAC DISORDERS "BUNDLE BRANCH BLOCK LEFT"             2     0      0
# ℹ 158 more rows

Merge with the denominator Big N count for percentage calculation

Code

all_N<-all_Ntemp2 %>%
    left_join(bigN,by="trtn")

Compute the percentage column and concatenate with count

Code

all_Perc<-all_N |> 
    mutate(
    percent=if_else(N!=0,count/N*100,0),
    percentc=str_c(" (",sprintf("%.1f",percent),"%)"),
    cp=if_else(count==0,"0",str_c(count, percentc))
 )

all_Perc

# A tibble: 168 × 11
   label aebodsys aedecod  trtn count events trtlab     N percent percentc cp   
   <chr> <chr>    <chr>   <dbl> <dbl>  <dbl> <glue> <int>   <dbl> <chr>    <chr>
 1 ""    CARDIAC… ""          1     2      2 Place…     5   40    " (40.0… 2 (4…
 2 ""    CARDIAC… ""          2     0      0 TRT A…     5    0    " (0.0%… 0    
 3 ""    CARDIAC… ""          3     0      0 TRT B…     5    0    " (0.0%… 0    
 4 ""    CARDIAC… ""         99     2      2 Overa…    15   13.3  " (13.3… 2 (1…
 5 ""    CARDIAC… "ATRIO…     1     1      1 Place…     5   20    " (20.0… 1 (2…
 6 ""    CARDIAC… "ATRIO…     2     0      0 TRT A…     5    0    " (0.0%… 0    
 7 ""    CARDIAC… "ATRIO…     3     0      0 TRT B…     5    0    " (0.0%… 0    
 8 ""    CARDIAC… "ATRIO…    99     1      1 Overa…    15    6.67 " (6.7%… 1 (6…
 9 ""    CARDIAC… "BUNDL…     1     1      1 Place…     5   20    " (20.0… 1 (2…
10 ""    CARDIAC… "BUNDL…     2     0      0 TRT A…     5    0    " (0.0%… 0    
# ℹ 158 more rows

Create the row labels column;

Code

prefinal1<-all_Perc |> 
    mutate(
    label=case_when(
    aebodsys=="" & aedecod=="" ~ label,
    aebodsys!="" & aedecod=="" ~ aebodsys,
    aebodsys!="" & aedecod!="" ~ str_c("\u00A0\u00A0\u00A0",aedecod),
    TRUE~""
 )
 )

prefinal1

# A tibble: 168 × 11
   label aebodsys aedecod  trtn count events trtlab     N percent percentc cp   
   <chr> <chr>    <chr>   <dbl> <dbl>  <dbl> <glue> <int>   <dbl> <chr>    <chr>
 1 CARD… CARDIAC… ""          1     2      2 Place…     5   40    " (40.0… 2 (4…
 2 CARD… CARDIAC… ""          2     0      0 TRT A…     5    0    " (0.0%… 0    
 3 CARD… CARDIAC… ""          3     0      0 TRT B…     5    0    " (0.0%… 0    
 4 CARD… CARDIAC… ""         99     2      2 Overa…    15   13.3  " (13.3… 2 (1…
 5    A… CARDIAC… "ATRIO…     1     1      1 Place…     5   20    " (20.0… 1 (2…
 6    A… CARDIAC… "ATRIO…     2     0      0 TRT A…     5    0    " (0.0%… 0    
 7    A… CARDIAC… "ATRIO…     3     0      0 TRT B…     5    0    " (0.0%… 0    
 8    A… CARDIAC… "ATRIO…    99     1      1 Overa…    15    6.67 " (6.7%… 1 (6…
 9    B… CARDIAC… "BUNDL…     1     1      1 Place…     5   20    " (20.0… 1 (2…
10    B… CARDIAC… "BUNDL…     2     0      0 TRT A…     5    0    " (0.0%… 0    
# ℹ 158 more rows

Code

prefinal2 <- prefinal1 |> 
    pivot_wider(
    id_cols = c(aebodsys, aedecod, label),
    names_from = trtlab,
    values_from = cp) |> 
 arrange(aebodsys,aedecod,label)
 
prefinal2

# A tibble: 42 × 7
   aebodsys         aedecod label `Placebo (N= 5)` `TRT A (N= 5)` `TRT B (N= 5)`
   <chr>            <chr>   <chr> <chr>            <chr>          <chr>         
 1 ""               ""      Over… 4 (80.0%)        4 (80.0%)      5 (100.0%)    
 2 "CARDIAC DISORD… ""      CARD… 2 (40.0%)        0              0             
 3 "CARDIAC DISORD… "ATRIO…    A… 1 (20.0%)        0              0             
 4 "CARDIAC DISORD… "BUNDL…    B… 1 (20.0%)        0              0             
 5 "EYE DISORDERS"  ""      EYE … 1 (20.0%)        0              0             
 6 "EYE DISORDERS"  "EYE A…    E… 1 (20.0%)        0              0             
 7 "EYE DISORDERS"  "EYE P…    E… 1 (20.0%)        0              0             
 8 "EYE DISORDERS"  "EYE S…    E… 1 (20.0%)        0              0             
 9 "GASTROINTESTIN… ""      GAST… 2 (40.0%)        0              0             
10 "GASTROINTESTIN… "DIARR…    D… 1 (20.0%)        0              0             
# ℹ 32 more rows
# ℹ 1 more variable: `Overall (N= 15)` <chr>

Code

# view(counts06)
final <- prefinal2 |> 
    select( -aebodsys, -aedecod )

glimpse(final)

Rows: 42
Columns: 5
$ label             <chr> "Overall", "CARDIAC DISORDERS", "   ATRIOVENTRICULAR…
$ `Placebo (N= 5)`  <chr> "4 (80.0%)", "2 (40.0%)", "1 (20.0%)", "1 (20.0%)", …
$ `TRT A (N= 5)`    <chr> "4 (80.0%)", "0", "0", "0", "0", "0", "0", "0", "0",…
$ `TRT B (N= 5)`    <chr> "5 (100.0%)", "0", "0", "0", "0", "0", "0", "0", "0"…
$ `Overall (N= 15)` <chr> "13 (86.7%)", "2 (13.3%)", "1 (6.7%)", "1 (6.7%)", "…

Code

tlf_gt <- function(df,
                   title = "Table X. Treatment-Emergent Adverse Events by System Organ Class and Preferred Term",
                   subtitle = "Safety Population",
                   stub_width = gt::px(420),   # <-- add
                   trt_width  = gt::px(90)) {  # <-- optional

  df <- as.data.frame(df)

  stub     <- names(df)[1]
  trt_cols <- names(df)[-1]

  # Section header rows = all treatment cells blank/NA
  is_section <- apply(df[, trt_cols, drop = FALSE], 1, function(x) {
    all(is.na(x) | trimws(as.character(x)) == "")
  })

  # Sub-rows = stub starts with spaces
  is_sub <- grepl("^\\s+", df[[stub]])
  df[[stub]] <- sub("^\\s+", "", df[[stub]])   # remove spaces; we’ll indent via gt

  # 2-line column headers: "Placebo (N= 19)" -> "Placebo<br>(N=19)"
  lab_trt <- setNames(lapply(trt_cols, function(x) {
    x2 <- gsub("\\s+", " ", x)
    gt::html(sub("\\s*\\(N\\s*=\\s*([0-9]+)\\s*\\)\\s*$",
                 "<br>(N=\\1)", x2, perl = TRUE))
  }), trt_cols)

  labs <- c(setNames(list(gt::html("")), stub), lab_trt)

  # ---- key fix: embed width values in formulas (no 'stub_width' symbol to resolve later) ----
  f_stub <- rlang::new_formula(1, stub_width, env = environment())                   # col 1
  f_trt  <- rlang::new_formula(dplyr::all_of(trt_cols), trt_width, env = environment())

  g <- gt::gt(df) %>%
    gt::tab_header(
      title = gt::md(paste0("**", title, "**")),
      subtitle = subtitle
    ) %>%
    gt::opt_row_striping() %>%
    gt::cols_width(f_stub, f_trt) %>%                      # <-- widen first col
    gt::cols_align("left",   columns = 1) %>%              # <-- use col position (robust)
    gt::cols_align("center", columns = dplyr::all_of(trt_cols)) %>%
    gt::opt_table_font(font = list("Courier New", "Consolas", "monospace")) %>%
    gt::tab_options(
      table.font.size = gt::px(12),
      data_row.padding = gt::px(2),

      table.border.top.style = "solid",
      table.border.top.width = gt::px(2),
      column_labels.border.bottom.style = "solid",
      column_labels.border.bottom.width = gt::px(2),
      table.border.bottom.style = "solid",
      table.border.bottom.width = gt::px(2),

      table_body.hlines.style = "none",
      table_body.vlines.style = "none",
      column_labels.vlines.style = "none"
    )

  # apply labels (programmatically)
  g <- do.call(gt::cols_label, c(list(g), labs))

  # Bold section headers (first column)
  g <- g %>%
    gt::tab_style(
      style = gt::cell_text(weight = "bold"),
      locations = gt::cells_body(columns = 1, rows = is_section)
    ) %>%
    # Indent sub-rows (first column)
    gt::tab_style(
      style = gt::cell_text(indent = gt::px(18)),
      locations = gt::cells_body(columns = 1, rows = is_sub & !is_section)
    ) %>%
    gt::tab_source_note(gt::md("*Percentages are based on the column N.*"))

  g
}

Code

# tlf_gt(final, stub_width = gt::px(420))
# or
# tlf_gt(final, stub_width = gt::pct(60))

tlf_gt(final, stub_width = gt::px(420), trt_width = gt::px(85))

	Placebo (N=5)	TRT A (N=5)	TRT B (N=5)	Overall (N=15)
Table X. Treatment-Emergent Adverse Events by System Organ Class and Preferred Term
Safety Population
Overall	4 (80.0%)	4 (80.0%)	5 (100.0%)	13 (86.7%)
CARDIAC DISORDERS	2 (40.0%)	0	0	2 (13.3%)
ATRIOVENTRICULAR BLOCK SECOND DEGREE	1 (20.0%)	0	0	1 (6.7%)
BUNDLE BRANCH BLOCK LEFT	1 (20.0%)	0	0	1 (6.7%)
EYE DISORDERS	1 (20.0%)	0	0	1 (6.7%)
EYE ALLERGY	1 (20.0%)	0	0	1 (6.7%)
EYE PRURITUS	1 (20.0%)	0	0	1 (6.7%)
EYE SWELLING	1 (20.0%)	0	0	1 (6.7%)
GASTROINTESTINAL DISORDERS	2 (40.0%)	0	0	2 (13.3%)
DIARRHOEA	1 (20.0%)	0	0	1 (6.7%)
HIATUS HERNIA	1 (20.0%)	0	0	1 (6.7%)
GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS	2 (40.0%)	3 (60.0%)	5 (100.0%)	10 (66.7%)
APPLICATION SITE DERMATITIS	0	1 (20.0%)	0	1 (6.7%)
APPLICATION SITE ERYTHEMA	1 (20.0%)	1 (20.0%)	4 (80.0%)	6 (40.0%)
APPLICATION SITE IRRITATION	0	1 (20.0%)	1 (20.0%)	2 (13.3%)
APPLICATION SITE PAIN	0	0	1 (20.0%)	1 (6.7%)
APPLICATION SITE PRURITUS	1 (20.0%)	2 (40.0%)	5 (100.0%)	8 (53.3%)
APPLICATION SITE URTICARIA	0	1 (20.0%)	0	1 (6.7%)
APPLICATION SITE VESICLES	0	1 (20.0%)	1 (20.0%)	2 (13.3%)
FATIGUE	0	1 (20.0%)	2 (40.0%)	3 (20.0%)
PYREXIA	1 (20.0%)	0	0	1 (6.7%)
INFECTIONS AND INFESTATIONS	2 (40.0%)	1 (20.0%)	1 (20.0%)	4 (26.7%)
CELLULITIS	0	1 (20.0%)	0	1 (6.7%)
LOWER RESPIRATORY TRACT INFECTION	0	0	1 (20.0%)	1 (6.7%)
UPPER RESPIRATORY TRACT INFECTION	1 (20.0%)	0	0	1 (6.7%)
URINARY TRACT INFECTION	1 (20.0%)	0	0	1 (6.7%)
MUSCULOSKELETAL AND CONNECTIVE TISSUE DISORDERS	0	1 (20.0%)	1 (20.0%)	2 (13.3%)
ARTHRALGIA	0	1 (20.0%)	0	1 (6.7%)
FLANK PAIN	0	0	1 (20.0%)	1 (6.7%)
RENAL AND URINARY DISORDERS	0	1 (20.0%)	1 (20.0%)	2 (13.3%)
CALCULUS URETHRAL	0	0	1 (20.0%)	1 (6.7%)
MICTURITION URGENCY	0	1 (20.0%)	0	1 (6.7%)
RESPIRATORY, THORACIC AND MEDIASTINAL DISORDERS	1 (20.0%)	1 (20.0%)	1 (20.0%)	3 (20.0%)
EPISTAXIS	0	0	1 (20.0%)	1 (6.7%)
NASAL CONGESTION	1 (20.0%)	1 (20.0%)	0	2 (13.3%)
PHARYNGOLARYNGEAL PAIN	0	1 (20.0%)	0	1 (6.7%)
SKIN AND SUBCUTANEOUS TISSUE DISORDERS	2 (40.0%)	2 (40.0%)	1 (20.0%)	5 (33.3%)
ACTINIC KERATOSIS	0	0	1 (20.0%)	1 (6.7%)
ERYTHEMA	1 (20.0%)	2 (40.0%)	0	3 (20.0%)
PRURITUS	1 (20.0%)	1 (20.0%)	0	2 (13.3%)
PRURITUS GENERALISED	0	1 (20.0%)	0	1 (6.7%)
URTICARIA	0	1 (20.0%)	0	1 (6.7%)
Percentages are based on the column N.