Chapter 4 Commonly Used Tables
4.1 Demographic Tables
4.1.1 rtables
Using rtables only:
Code
resetSession()
library(rtables)
<- function(x) {
a_demo_num in_rows(n = length(x),
"Mean (SD)" = rcell(c(mean(x, na.rm = TRUE),
sd(x, na.rm=TRUE)), format = "xx.x (xx.x)"),
"Median" = median(x,na.rm = TRUE),
"Min - Max" = rcell(range(x, na.rm = TRUE), format = "xx.x - xx.x"))
}
<- function(x) {
a_demo_fac in_rows(.list = c(c(n = length(x)), table(x)))
}
<- basic_table(title = "x.x: Study Subject Data",
lyt subtitles= c("x.x.x: Demographic Characteristics",
"Table x.x.x.x: Demographic Characteristics - Full Analysis Set"),
prov_footer = "Source: ADSL DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY") |>
split_cols_by("ARM") |>
analyze(c("AGE", "SEX", "COUNTRY"), afun = list(AGE = a_demo_num, SEX = a_demo_fac,
COUNTRY = a_demo_fac))
build_table(lyt, ex_adsl)
x.x: Study Subject Data
x.x.x: Demographic Characteristics
Table x.x.x.x: Demographic Characteristics - Full Analysis Set
———————————————————————————————————————————————————————————————
A: Drug X B: Placebo C: Combination
———————————————————————————————————————————————————————————————
AGE
n 134 134 132
Mean (SD) 33.8 (6.6) 35.4 (7.9) 35.4 (7.7)
Median 33 35 35
Min - Max 21.0 - 50.0 21.0 - 62.0 20.0 - 69.0
SEX
n 134 134 132
F 79 77 66
M 51 55 60
U 3 2 4
UNDIFFERENTIATED 1 0 2
COUNTRY
n 134 134 132
CHN 74 81 64
USA 10 13 17
BRA 13 7 10
PAK 12 9 10
NGA 8 7 11
RUS 5 8 6
JPN 5 4 9
GBR 4 3 2
CAN 3 2 3
CHE 0 0 0
———————————————————————————————————————————————————————————————
Source: ADSL DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY
4.1.2 tern (+ rtables)
Code
resetSession()
library(tern)
<- basic_table(title = "x.x: Study Subject Data",
lyt subtitles= c("x.x.x: Demographic Characteristics",
"Table x.x.x.x: Demographic Characteristics - Full Analysis Set"),
prov_footer = "Source: ADSL DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY") |>
split_cols_by("ARM") |>
summarize_vars(c("AGE", "SEX", "COUNTRY"))
Warning: `summarize_vars()` was deprecated in tern 0.8.5.9010.
ℹ Please use `analyze_vars()` instead.
This warning is displayed once every 8 hours.
Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
generated.
Code
build_table(lyt, ex_adsl)
x.x: Study Subject Data
x.x.x: Demographic Characteristics
Table x.x.x.x: Demographic Characteristics - Full Analysis Set
———————————————————————————————————————————————————————————————
A: Drug X B: Placebo C: Combination
———————————————————————————————————————————————————————————————
AGE
n 134 134 132
Mean (SD) 33.8 (6.6) 35.4 (7.9) 35.4 (7.7)
Median 33.0 35.0 35.0
Min - Max 21.0 - 50.0 21.0 - 62.0 20.0 - 69.0
SEX
n 134 134 132
F 79 (59%) 77 (57.5%) 66 (50%)
M 51 (38.1%) 55 (41%) 60 (45.5%)
U 3 (2.2%) 2 (1.5%) 4 (3%)
UNDIFFERENTIATED 1 (0.7%) 0 2 (1.5%)
COUNTRY
n 134 134 132
CHN 74 (55.2%) 81 (60.4%) 64 (48.5%)
USA 10 (7.5%) 13 (9.7%) 17 (12.9%)
BRA 13 (9.7%) 7 (5.2%) 10 (7.6%)
PAK 12 (9%) 9 (6.7%) 10 (7.6%)
NGA 8 (6%) 7 (5.2%) 11 (8.3%)
RUS 5 (3.7%) 8 (6%) 6 (4.5%)
JPN 5 (3.7%) 4 (3%) 9 (6.8%)
GBR 4 (3%) 3 (2.2%) 2 (1.5%)
CAN 3 (2.2%) 2 (1.5%) 3 (2.3%)
CHE 0 0 0
———————————————————————————————————————————————————————————————
Source: ADSL DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY
4.1.3 gt
Code
resetSession()
library(gt)
library(tidyverse)
# We will use ex_adsl but will assign a unit to the Age column
<- formatters::ex_adsl
ex_adsl <- ex_adsl
gt_adsl attr(gt_adsl$AGE, "units") <- "Years"
# This is a customized summary function
# It creates numeric and categorical summaries for specified variables, following the rtables exmaple
<- function(df, group_var, sum_var){
custom_summary <- rlang::ensym(group_var)
group_var <- rlang::ensym(sum_var)
sum_var
<- is.character(eval(expr(`$`(df, !!sum_var)))) | is.factor(eval(expr(`$`(df, !!sum_var))))
is_categorical
if (is_categorical){
<- df |>
df ::group_by(!!group_var) |>
dplyr::mutate(N = n()) |>
dplyr::ungroup() |>
dplyr::group_by(!!group_var, !!sum_var) |>
dplyr::summarize(
dplyrval = n(),
sd = 100*n()/mean(N),
.groups = "drop"
|>
) ::pivot_wider(id_cols = !!sum_var, names_from = !!group_var, values_from = c(val, sd)) |>
tidyr::rename(label = !!sum_var) |>
dplyr::mutate(isnum = FALSE,
dplyracross(where(is.numeric), ~ifelse(is.na(.), 0, .)))
<- ", n (%)"
sum_unit
else {
}
<- sprintf(" (%s)", attr(eval(expr(`$`(df, !!sum_var))), "units"))
sum_unit
<- df |>
df ::group_by(!!group_var) |>
dplyr::summarize(
dplyrn = sum(!is.na(!!sum_var)),
mean = mean(!!sum_var, na.rm = TRUE),
sd = sd(!!sum_var, na.rm = TRUE),
median = median(!!sum_var, na.rm = TRUE),
min = min(!!sum_var, na.rm = TRUE),
max = max(!!sum_var, na.rm = TRUE),
min_max = NA,
.groups = "drop"
|>
) ::pivot_longer(cols = c(n, mean, median, min_max), names_to = "label", values_to = "val") |>
tidyr::mutate(sd = ifelse(label == "mean", sd, NA),
dplyrmax = ifelse(label == "min_max", max, NA),
min = ifelse(label == "min_max", min, NA),
label = dplyr::recode(label, "mean" = "Mean (SD)", "min_max" = "Min - Max", "median" = "Median")) |>
::pivot_wider(id_cols = label, names_from = !!group_var, values_from = c(val, sd, min, max)) |>
tidyr::mutate(isnum = TRUE)
dplyr
}
|>
df ::mutate(category = paste0(stringr::str_to_title(deparse(substitute(!!sum_var))),
dplyr
sum_unit))
}
# Perform aggregation for variables Age, Sex and Country
<- purrr::map_df(.x = vars(AGE, SEX, COUNTRY),
adsl_summary .f = ~custom_summary(df = gt_adsl, group_var = ARM, sum_var = !!.x))
# Count number of patients per Arm
<- ex_adsl |>
adsl_n ::summarize(
dplyrNLBL = sprintf("%s \n(N=%i)",unique(ARM), dplyr::n()),
.by = ARM
)
<- as.list(adsl_n$NLBL)
header_n names(header_n) <- paste0("val_", adsl_n$ARM)
# gt
gt(adsl_summary,
rowname_col = "label",
groupname_col = "category") |>
tab_header(
title = "x.x: Study Subject Data",
subtitle = md("x.x.x: Demographic Characteristics \n Table x.x.x.x: Demographic Characteristics - Full Analysis Set"),
preheader = c("Protocol: XXXXX", "Cutoff date: DDMMYYYY")
|>
) tab_source_note("Source: ADSL DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY") |>
opt_align_table_header(align = "left") |>
fmt_integer(columns = starts_with(c("val", "min", "max")), rows = label != "Mean (SD)") |>
fmt_number(columns = starts_with(c("val", "sd")), rows = label == "Mean (SD)", decimals = 1) |>
fmt_number(columns = starts_with("sd"), rows = isnum == FALSE, decimals = 1) |>
sub_missing(missing_text = "") |>
summary_rows(
groups = c("Sex, n (%)", "Country, n (%)"),
columns = starts_with("val"),
fns = list(n = ~sum(.)),
missing_text = "",
side = "top"
|>
) cols_merge_n_pct(col_n = "val_A: Drug X", col_pct = "sd_A: Drug X") |>
cols_merge_n_pct(col_n = "val_B: Placebo", col_pct = "sd_B: Placebo") |>
cols_merge_n_pct(col_n = "val_C: Combination", col_pct = "sd_C: Combination") |>
cols_merge_range(col_begin = "min_A: Drug X", col_end = "max_A: Drug X", sep = " - ") |>
cols_merge_range(col_begin = "min_B: Placebo", col_end = "max_B: Placebo", sep = " - ") |>
cols_merge_range(col_begin = "min_C: Combination", col_end = "max_C: Combination", sep = " - ") |>
cols_merge(columns = c("val_A: Drug X", "min_A: Drug X"), pattern = "{1}{2}") |>
cols_merge(columns = c("val_B: Placebo", "min_B: Placebo"), pattern = "{1}{2}") |>
cols_merge(columns = c("val_C: Combination", "min_C: Combination"), pattern = "{1}{2}") |>
cols_hide(columns = isnum) |>
cols_align(
align = "center",
columns = c("val_A: Drug X", "val_B: Placebo", "val_C: Combination")
|>
) cols_align(
align = "left",
columns = 1
|>
) tab_style(
style = cell_text(indent = px(10)),
locations = cells_stub()
|>
) cols_label(
.list = header_n,
.fn = md
|>
) tab_options(
table.font.size = 9,
page.orientation = "landscape",
page.numbering = TRUE,
page.header.use_tbl_headings = TRUE,
page.footer.use_tbl_notes = TRUE)
x.x: Study Subject Data | |||
x.x.x: Demographic Characteristics Table x.x.x.x: Demographic Characteristics - Full Analysis Set |
|||
A: Drug X (N=134) |
B: Placebo (N=134) |
C: Combination (N=132) |
|
---|---|---|---|
Age (Years) | |||
n | 134 |
134 |
132 |
Mean (SD) | 33.8 (6.6) |
35.4 (7.9) |
35.4 (7.7) |
Median | 33 |
35 |
35 |
Min - Max | 21 - 50 |
21 - 62 |
20 - 69 |
Sex, n (%) | |||
n | 134 | 134 | 132 |
F | 79 (59.0) |
77 (57.5) |
66 (50.0) |
M | 51 (38.1) |
55 (41.0) |
60 (45.5) |
U | 3 (2.2) |
2 (1.5) |
4 (3.0) |
UNDIFFERENTIATED | 1 (0.7) |
0 |
2 (1.5) |
Country, n (%) | |||
n | 134 | 134 | 132 |
CHN | 74 (55.2) |
81 (60.4) |
64 (48.5) |
USA | 10 (7.5) |
13 (9.7) |
17 (12.9) |
BRA | 13 (9.7) |
7 (5.2) |
10 (7.6) |
PAK | 12 (9.0) |
9 (6.7) |
10 (7.6) |
NGA | 8 (6.0) |
7 (5.2) |
11 (8.3) |
RUS | 5 (3.7) |
8 (6.0) |
6 (4.5) |
JPN | 5 (3.7) |
4 (3.0) |
9 (6.8) |
GBR | 4 (3.0) |
3 (2.2) |
2 (1.5) |
CAN | 3 (2.2) |
2 (1.5) |
3 (2.3) |
Source: ADSL DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY |
4.1.4 flextable
Code
# The two steps in creating 'Demographic Tables' are:
#
# - summarize the information with the `flextable::summarizor()` function.
# It computes a set of statistics for each variable by groups. It returns
# a data.frame ready to be used by `flextable::as_flextable()`.
# - Create the flextable with the `as_flextable()` function.
resetSession()
<- formatters::ex_adsl
ex_adsl
library(flextable)
library(tidyverse)
library(officer)
set_flextable_defaults(
border.color = "#AAAAAA", font.family = "Open Sans",
font.size = 10, padding = 3, line_spacing = 1.4
)
# data
<- select(ex_adsl, AGE, SEX, COUNTRY, ARM)
adsl
# In the illustration, we use labels from the column attributes.
<- map_chr(adsl, function(x) attr(x, "label"))
col_labels
# Now let's use the labels and customize the ‘flextable’ output.
<- summarizor(adsl, by = "ARM") |>
ft as_flextable(sep_w = 0, separate_with = "variable",
spread_first_col = TRUE) |>
align(i = ~ !is.na(variable), align = "left") |>
prepend_chunks(i = ~ is.na(variable), j ="stat", as_chunk("\t") ) |>
labelizor(j = c("stat"),
labels = col_labels, part = "all") |>
autofit() |>
add_header_lines(
c("x.x: Study Subject Data",
"x.x.x: Demographic Characteristics",
"Table x.x.x.x: Demographic Characteristics - Full Analysis Set")) |>
add_footer_lines("Source: ADSL DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY")
ft
x.x: Study Subject Data | |||
---|---|---|---|
x.x.x: Demographic Characteristics | |||
Table x.x.x.x: Demographic Characteristics - Full Analysis Set | |||
A: Drug X | B: Placebo | C: Combination | |
Age | |||
Mean (SD) | 33.8 (6.6) | 35.4 (7.9) | 35.4 (7.7) |
Median (IQR) | 33.0 (11.0) | 35.0 (10.0) | 35.0 (10.0) |
Range | 21.0 - 50.0 | 21.0 - 62.0 | 20.0 - 69.0 |
Sex | |||
F | 79 (58.96%) | 77 (57.46%) | 66 (50.00%) |
M | 51 (38.06%) | 55 (41.04%) | 60 (45.45%) |
U | 3 (2.24%) | 2 (1.49%) | 4 (3.03%) |
UNDIFFERENTIATED | 1 (0.75%) | 0 (0.00%) | 2 (1.52%) |
Country | |||
CHN | 74 (55.22%) | 81 (60.45%) | 64 (48.48%) |
USA | 10 (7.46%) | 13 (9.70%) | 17 (12.88%) |
BRA | 13 (9.70%) | 7 (5.22%) | 10 (7.58%) |
PAK | 12 (8.96%) | 9 (6.72%) | 10 (7.58%) |
NGA | 8 (5.97%) | 7 (5.22%) | 11 (8.33%) |
RUS | 5 (3.73%) | 8 (5.97%) | 6 (4.55%) |
JPN | 5 (3.73%) | 4 (2.99%) | 9 (6.82%) |
GBR | 4 (2.99%) | 3 (2.24%) | 2 (1.52%) |
CAN | 3 (2.24%) | 2 (1.49%) | 3 (2.27%) |
CHE | 0 (0.00%) | 0 (0.00%) | 0 (0.00%) |
Source: ADSL DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY |
4.1.5 tables
The tables package uses a different style than the other packages for tables such as this, where there are separate sections for age, sex and country breakdowns of the data. Rather than putting the section heading on a separate line, it normally puts the heading in a separate column to the left of the other columns.
Code
resetSession()
<- formatters::ex_adsl
ex_adsl
library(tables)
table_options(doCSS = TRUE)
<- function(x) sprintf("%.1f (%.1f)", mean(x), sd(x))
meansd
<- function(x) quantile(x, 0.75) - quantile(x, 0.25)
iqr
<- function(x) sprintf("%.1f (%.1f)", median(x), iqr(x))
medianiqr
<- function(x) sprintf("%.1f - %.1f", min(x), max(x))
minmax
<- function(num, denom)
countpercent sprintf("%d (%.1f%%)",
length(num),
100*length(num)/length(denom))
<- function(x) sprintf("(N=%d)", length(x))
count
<- tabular( Heading()*1*Heading()*count +
tab Heading("Age (Years)")*
* (Heading("Mean (SD)")*meansd +
AGE Heading("Median (IQR)")*medianiqr +
Heading("Min - Max")*minmax) +
Heading("Sex, n, (%)")*SEX +
(Heading("Country, n, (%)")*COUNTRY)*
Heading()*Percent(denom = Equal(ARM), fn = countpercent) ~
Heading()*ARM,
data = ex_adsl )
Warning in cbind(padNA, leftjustification): number of rows of result is not a
multiple of vector length (arg 1)
Code
useGroupLabels(tab, indent = " ")
A: Drug X | B: Placebo | C: Combination | |
---|---|---|---|
(N=134) | (N=134) | (N=132) | |
Age (Years) | |||
Mean (SD) | 33.8 (6.6) | 35.4 (7.9) | 35.4 (7.7) |
Median (IQR) | 33.0 (11.0) | 35.0 (10.0) | 35.0 (10.0) |
Min - Max | 21.0 - 50.0 | 21.0 - 62.0 | 20.0 - 69.0 |
Sex, n, (%) | |||
F | 79 (59.0%) | 77 (57.5%) | 66 (50.0%) |
M | 51 (38.1%) | 55 (41.0%) | 60 (45.5%) |
U | 3 (2.2%) | 2 (1.5%) | 4 (3.0%) |
UNDIFFERENTIATED | 1 (0.7%) | 0 (0.0%) | 2 (1.5%) |
Country, n, (%) | |||
CHN | 74 (55.2%) | 81 (60.4%) | 64 (48.5%) |
USA | 10 (7.5%) | 13 (9.7%) | 17 (12.9%) |
BRA | 13 (9.7%) | 7 (5.2%) | 10 (7.6%) |
PAK | 12 (9.0%) | 9 (6.7%) | 10 (7.6%) |
NGA | 8 (6.0%) | 7 (5.2%) | 11 (8.3%) |
RUS | 5 (3.7%) | 8 (6.0%) | 6 (4.5%) |
JPN | 5 (3.7%) | 4 (3.0%) | 9 (6.8%) |
GBR | 4 (3.0%) | 3 (2.2%) | 2 (1.5%) |
CAN | 3 (2.2%) | 2 (1.5%) | 3 (2.3%) |
CHE | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) |
4.1.6 tidytlg
Code
resetSession()
library(dplyr)
library(tidytlg)
<- formatters::ex_adsl
adsl
# create univariate stats for age
<- univar(adsl,
tbl1 rowvar = "AGE",
colvar = "ARM",
statlist = statlist(c("N","MEANSD","MEDIAN","RANGE")),
row_header = "Age (years)",
decimal = 0)
# create counts (percentages) for gender categories
<- freq(adsl,
tbl2 rowvar = "SEX",
colvar = "ARM",
statlist = statlist(c("N", "n (x.x%)")),
row_header = "Gender, n(%)")
# create counts (percentages) for country
<- freq(adsl,
tbl3 rowvar = "COUNTRY",
colvar = "ARM",
statlist = statlist(c("N", "n (x.x%)")),
row_header = "Country, n(%)",
descending_by = "C: Combination")
# combine analysis results together
<- bind_table(tbl1, tbl2, tbl3)
tbl
# output the analysis results
gentlg(huxme = tbl,
format = "HTML",
print.hux = FALSE,
file = "Table x.x.x.x",
orientation = "portrait",
title = "Demographic Characteristics - Full Analysis Set",
footers = "Source: ADSL DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY",
colheader = c("","A: Drug X","B: Placebo","C: Combination"))
Table x.x.x.x: Demographic Characteristics - Full Analysis Set | |||
A: Drug X | B: Placebo | C: Combination | |
---|---|---|---|
Age (years) | |||
N | 134 | 134 | 132 |
Mean (SD) | 33.8 (6.55) | 35.4 (7.90) | 35.4 (7.72) |
Median | 33.0 | 35.0 | 35.0 |
Range | (21; 50) | (21; 62) | (20; 69) |
Gender, n(%) | |||
N | 134 | 134 | 132 |
F | 79 (59.0%) | 77 (57.5%) | 66 (50.0%) |
M | 51 (38.1%) | 55 (41.0%) | 60 (45.5%) |
U | 3 (2.2%) | 2 (1.5%) | 4 (3.0%) |
UNDIFFERENTIATED | 1 (0.7%) | 0 | 2 (1.5%) |
Country, n(%) | |||
N | 134 | 134 | 132 |
CHN | 74 (55.2%) | 81 (60.4%) | 64 (48.5%) |
USA | 10 (7.5%) | 13 (9.7%) | 17 (12.9%) |
NGA | 8 (6.0%) | 7 (5.2%) | 11 (8.3%) |
BRA | 13 (9.7%) | 7 (5.2%) | 10 (7.6%) |
PAK | 12 (9.0%) | 9 (6.7%) | 10 (7.6%) |
JPN | 5 (3.7%) | 4 (3.0%) | 9 (6.8%) |
RUS | 5 (3.7%) | 8 (6.0%) | 6 (4.5%) |
CAN | 3 (2.2%) | 2 (1.5%) | 3 (2.3%) |
GBR | 4 (3.0%) | 3 (2.2%) | 2 (1.5%) |
CHE | 0 | 0 | 0 |
Source: ADSL DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY | |||
[table x.x.x.x.html][/home/runner/work/_temp/dbc50335-555d-4c9d-8c49-eaade0bcc058] 03NOV2023, 00:16 |
4.1.7 tfrmt
Please note that the tfrmt package is intended for use with mock data or ARD (analysis results data). This package creates the same tables as other packages but requires the starting data to be transformed first.
The first chunk of code takes the CDISC data and modifies it into an ARD. The second chunk demonstrates how to format the table.
Code
resetSession()
library(tidyverse)
library(tfrmt)
# Get data
data("cadsl", package = "random.cdisc.data")
# Number of unique subjects per ARM
<- cadsl |>
big_n ::group_by(ARM) |>
dplyr::summarize(
dplyrN = dplyr::n_distinct(USUBJID)
)
# Join big_n with adsl
<- cadsl |>
adsl_with_n ::left_join(big_n, by = "ARM")
dplyr
# Explore column: AGE
<-
age_stats |>
adsl_with_n group_by(ARM) |>
reframe(
n = n_distinct(USUBJID),
Mean = mean(AGE),
SD = sd(AGE),
Median = median(AGE),
Min = min(AGE),
Max = max(AGE)
|>
) pivot_longer(
c("n", "Mean", "SD", "Median", "Min", "Max")
|>
) mutate(
group = "Age (years)",
label = case_when(name == "Mean" ~ "Mean (SD)",
== "SD" ~ "Mean (SD)",
name == "Min" ~ "Min - Max",
name == "Max" ~ "Min - Max",
name TRUE ~ name)
)
<-
sex_n |>
adsl_with_n group_by(ARM, SEX) |>
reframe(
n = n(),
pct = (n/N)*100
|>
) distinct() |>
pivot_longer(
c("n", "pct")
|>
) rename(
label = SEX
|>
) mutate(
group = "Sex"
)
# Explore column: COUNTRY
<-
country_n |>
adsl_with_n group_by(ARM, COUNTRY) |>
reframe(
n = n(),
pct = (n/N)*100
|>
) distinct() |>
pivot_longer(
c("n", "pct")
|>
) rename(
label = COUNTRY
|>
) mutate(
group = "Country"
)
# Header n
<- big_n |>
header_n ::rename(value = N) |>
dplyr::mutate(name = "header_n")
dplyr
# Create ARD
<-
demog_ard bind_rows(
age_stats,
sex_n,
country_n,#header_n
|>
) rename(
column = ARM,
param = name
|>
) select(
group, label, param, column, value|>
) group_by(group, label)
Now we can used the demog_ard
to make the demographic table using tfrmt.
Code
tfrmt(
# Add titles
title = "x.x: Study Subject Data",
subtitle = c("x.x.x: Demographic Characteristics. \n
Table x.x.x.x: Demographic Characteristics - Full Analysis Set"),
# Specify table features
group = group,
label = label,
column = column,
param = param,
value = value,
# Define cell formatting
body_plan = body_plan(
# Define rounding and structure of values in each row
frmt_structure(group_val = ".default", label_val = ".default", frmt("xx")),
frmt_structure(group_val = "Age (years)",
label_val = c("Mean (SD)"),
frmt_combine(
"{Mean} ({SD})",
Mean = frmt("xx.x"),
SD = frmt("x.x") )),
frmt_structure(group_val = "Age (years)",
label_val = c("Min - Max"),
frmt_combine(
"{Min} - {Max}",
frmt("xx.x") )),
frmt_structure(group_val = "Sex",
label_val = c("M", "F", "U", "UNDIFFERENTIATED"),
frmt_combine(
"{n} ({pct}%)",
n = frmt("XXX"),
pct = frmt("XX.X") )),
frmt_structure(group_val = "Country",
label_val = c("CHN", "USA", "BRA", "PAK", "NGA", "RUS", "JPN", "GBR", "CAN", "NA"),
frmt_combine(
"{n} ({pct}%)",
n = frmt("XXX"),
pct = frmt("XX.X") ))
),
# Align values on decimal places and spaces
col_style_plan = col_style_plan(
col_style_structure(col = matches("[A-Z]:.*"),
align = c(".", " "))
%>%
) ) print_to_gt(demog_ard)
x.x: Study Subject Data | |||
x.x.x: Demographic Characteristics. Table x.x.x.x: Demographic Characteristics - Full Analysis Set | |||
A: Drug X | B: Placebo | C: Combination | |
---|---|---|---|
Age (years) | |||
n | 134 | 134 | 132 |
Mean (SD) | 33.8 (6.6) | 35.4 (7.9) | 35.4 (7.7) |
Median | 33 | 35 | 35 |
Min - Max | 21.0 - 50.0 | 21.0 - 62.0 | 20.0 - 69.0 |
Sex | |||
F | 79 (59.0%) | 82 (61.2%) | 70 (53.0%) |
M | 55 (41.0%) | 52 (38.8%) | 62 (47.0%) |
Country | |||
CHN | 74 (55.2%) | 81 (60.4%) | 64 (48.5%) |
USA | 10 ( 7.5%) | 13 ( 9.7%) | 17 (12.9%) |
BRA | 13 ( 9.7%) | 7 ( 5.2%) | 10 ( 7.6%) |
PAK | 12 ( 9.0%) | 9 ( 6.7%) | 10 ( 7.6%) |
NGA | 8 ( 6.0%) | 7 ( 5.2%) | 11 ( 8.3%) |
RUS | 5 ( 3.7%) | 8 ( 6.0%) | 6 ( 4.5%) |
JPN | 5 ( 3.7%) | 4 ( 3.0%) | 9 ( 6.8%) |
GBR | 4 ( 3.0%) | 3 ( 2.2%) | 2 ( 1.5%) |
CAN | 3 ( 2.2%) | 2 ( 1.5%) | 3 ( 2.3%) |
See this vignette for more details on formatting functions: link to website
See this vignette for the completed table example: link to website
4.2 Adverse Event Tables
We will use the ex_adae
data included within the formatters package.
Code
head(formatters::ex_adae)
# A tibble: 6 × 48
STUDYID USUBJID SUBJID SITEID AGE SEX RACE COUNTRY INVID ARM ARMCD
<chr> <chr> <chr> <chr> <int> <fct> <fct> <fct> <chr> <fct> <fct>
1 AB12345 AB12345-BRA… id-134 BRA-1 47 M WHITE BRA BRA-1 A: D… ARM A
2 AB12345 AB12345-BRA… id-134 BRA-1 47 M WHITE BRA BRA-1 A: D… ARM A
3 AB12345 AB12345-BRA… id-134 BRA-1 47 M WHITE BRA BRA-1 A: D… ARM A
4 AB12345 AB12345-BRA… id-134 BRA-1 47 M WHITE BRA BRA-1 A: D… ARM A
5 AB12345 AB12345-BRA… id-141 BRA-1 35 F WHITE BRA BRA-1 C: C… ARM C
6 AB12345 AB12345-BRA… id-141 BRA-1 35 F WHITE BRA BRA-1 C: C… ARM C
# ℹ 37 more variables: ACTARM <fct>, ACTARMCD <fct>, STRATA1 <fct>,
# STRATA2 <fct>, BMRKR1 <dbl>, BMRKR2 <fct>, ITTFL <fct>, SAFFL <fct>,
# BMEASIFL <fct>, BEP01FL <fct>, RANDDT <date>, TRTSDTM <dttm>,
# TRTEDTM <dttm>, EOSSTT <fct>, EOSDT <date>, EOSDY <int>, DCSREAS <fct>,
# DTHDT <date>, LSTALVDT <date>, study_duration_secs <dbl>, ASEQ <int>,
# AESEQ <int>, AETERM <fct>, AELLT <fct>, AEDECOD <fct>, AEHLT <fct>,
# AEHLGT <fct>, AEBODSYS <fct>, AESOC <fct>, AESEV <fct>, AESER <fct>, …
4.2.1 rtables
Adverse Events by ID
Code
resetSession()
library(rtables)
<- function(x, labelstr, .N_col) {
s_events_patients in_rows(
"Patients with at least one event" =
rcell(length(unique(x)) * c(1, 1 / .N_col), format = "xx (xx.xx%)"),
"Total number of events" = rcell(length(x), format = "xx")
)
}
<- function(df, .N_col, termvar = "AEDECOD", idvar = "USUBJID") {
table_count_per_id
<- df[[termvar]]
x <- df[[idvar]]
id
<- table(x[!duplicated(paste0(id, x))])
counts
in_rows(
.list = lapply(counts,
function(xi) rcell(c(xi, xi/.N_col), "xx (xx.xx%)")),
.labels = names(counts)
)
}
<- basic_table(show_colcounts = TRUE) %>%
lyt split_cols_by("ARM") %>%
analyze("USUBJID", afun = s_events_patients) %>%
split_rows_by("AEBODSYS", child_labels = "visible",
split_fun = trim_levels_in_group("AEDECOD"),
section_div = " ") %>%
summarize_row_groups("USUBJID", cfun = s_events_patients) %>%
analyze("AEDECOD", table_count_per_id, show_labels = "hidden", indent_mod = -1)
build_table(lyt, ex_adae, alt_counts_df = ex_adsl)
A: Drug X B: Placebo C: Combination
(N=134) (N=134) (N=132)
—————————————————————————————————————————————————————————————————————————————————
Patients with at least one event 122 (91.04%) 123 (91.79%) 120 (90.91%)
Total number of events 609 622 703
cl A.1
Patients with at least one event 78 (58.21%) 75 (55.97%) 89 (67.42%)
Total number of events 132 130 160
dcd A.1.1.1.1 50 (37.31%) 45 (33.58%) 63 (47.73%)
dcd A.1.1.1.2 48 (35.82%) 48 (35.82%) 50 (37.88%)
cl B.1
Patients with at least one event 47 (35.07%) 49 (36.57%) 43 (32.58%)
Total number of events 56 60 62
dcd B.1.1.1.1 47 (35.07%) 49 (36.57%) 43 (32.58%)
cl B.2
Patients with at least one event 79 (58.96%) 74 (55.22%) 85 (64.39%)
Total number of events 129 138 143
dcd B.2.1.2.1 49 (36.57%) 44 (32.84%) 52 (39.39%)
dcd B.2.2.3.1 48 (35.82%) 54 (40.30%) 51 (38.64%)
cl C.1
Patients with at least one event 43 (32.09%) 46 (34.33%) 43 (32.58%)
Total number of events 55 63 64
dcd C.1.1.1.3 43 (32.09%) 46 (34.33%) 43 (32.58%)
cl C.2
Patients with at least one event 35 (26.12%) 48 (35.82%) 55 (41.67%)
Total number of events 48 53 65
dcd C.2.1.2.1 35 (26.12%) 48 (35.82%) 55 (41.67%)
cl D.1
Patients with at least one event 79 (58.96%) 67 (50.00%) 80 (60.61%)
Total number of events 127 106 135
dcd D.1.1.1.1 50 (37.31%) 42 (31.34%) 51 (38.64%)
dcd D.1.1.4.2 48 (35.82%) 42 (31.34%) 50 (37.88%)
cl D.2
Patients with at least one event 47 (35.07%) 58 (43.28%) 57 (43.18%)
Total number of events 62 72 74
dcd D.2.1.5.3 47 (35.07%) 58 (43.28%) 57 (43.18%)
4.2.2 tern (+ rtables)
Code
resetSession()
library(tern)
<- basic_table(show_colcounts = TRUE) %>%
lyt split_cols_by(var = "ARM") %>%
analyze_num_patients(
vars = "USUBJID",
.stats = c("unique", "nonunique"),
.labels = c(
unique = "Patients with at least one event",
nonunique = "Total number of events"
)%>%
) split_rows_by(
"AEBODSYS",
child_labels = "visible",
split_fun = drop_split_levels,
section_div = " "
%>%
) summarize_num_patients(
var = "USUBJID",
.stats = c("unique", "nonunique"),
.labels = c(
unique = "Patients with at least one event",
nonunique = "Total number of events"
)%>%
) count_occurrences(vars = "AEDECOD", .indent_mods = -1L)
build_table(lyt, df = ex_adae, alt_counts_df = ex_adsl)
A: Drug X B: Placebo C: Combination
(N=134) (N=134) (N=132)
———————————————————————————————————————————————————————————————————————————————
Patients with at least one event 122 (91.0%) 123 (91.8%) 120 (90.9%)
Total number of events 609 622 703
cl A.1
Patients with at least one event 78 (58.2%) 75 (56.0%) 89 (67.4%)
Total number of events 132 130 160
dcd A.1.1.1.1 50 (37.3%) 45 (33.6%) 63 (47.7%)
dcd A.1.1.1.2 48 (35.8%) 48 (35.8%) 50 (37.9%)
cl B.1
Patients with at least one event 47 (35.1%) 49 (36.6%) 43 (32.6%)
Total number of events 56 60 62
dcd B.1.1.1.1 47 (35.1%) 49 (36.6%) 43 (32.6%)
cl B.2
Patients with at least one event 79 (59.0%) 74 (55.2%) 85 (64.4%)
Total number of events 129 138 143
dcd B.2.1.2.1 49 (36.6%) 44 (32.8%) 52 (39.4%)
dcd B.2.2.3.1 48 (35.8%) 54 (40.3%) 51 (38.6%)
cl C.1
Patients with at least one event 43 (32.1%) 46 (34.3%) 43 (32.6%)
Total number of events 55 63 64
dcd C.1.1.1.3 43 (32.1%) 46 (34.3%) 43 (32.6%)
cl C.2
Patients with at least one event 35 (26.1%) 48 (35.8%) 55 (41.7%)
Total number of events 48 53 65
dcd C.2.1.2.1 35 (26.1%) 48 (35.8%) 55 (41.7%)
cl D.1
Patients with at least one event 79 (59.0%) 67 (50.0%) 80 (60.6%)
Total number of events 127 106 135
dcd D.1.1.1.1 50 (37.3%) 42 (31.3%) 51 (38.6%)
dcd D.1.1.4.2 48 (35.8%) 42 (31.3%) 50 (37.9%)
cl D.2
Patients with at least one event 47 (35.1%) 58 (43.3%) 57 (43.2%)
Total number of events 62 72 74
dcd D.2.1.5.3 47 (35.1%) 58 (43.3%) 57 (43.2%)
4.2.3 gt
Code
resetSession()
library(tidyverse)
library(gt)
<- formatters::ex_adsl
ex_adsl <- formatters::ex_adae
ex_adae
<- ex_adsl |>
header_n ::group_by(ARM) |>
dplyr::summarize(
dplyrN = dplyr::n_distinct(USUBJID)
)
<- header_n |>
col_lbls ::transmute(
dplyrARMN = sprintf("%s \n (N=%i)", ARM, N)
|>
) ::group_split(ARMN)
dplyr
<- merge(ex_adae, header_n, by = "ARM") |>
sum_ex ::group_by(ARM) |>
dplyr::summarize(
dplyrn_oe = dplyr::n_distinct(USUBJID),
pct_oe = n_oe/mean(N),
n_tot = dplyr::n(),
.groups = "drop"
)
<- merge(ex_adae, header_n, by = "ARM") |>
sum_aebodsys ::group_by(ARM, AEBODSYS) |>
dplyr::summarize(
dplyrn_oe = dplyr::n_distinct(USUBJID),
pct_oe = n_oe/mean(N),
n_tot = dplyr::n(),
.groups = "drop"
)
<- merge(ex_adae, header_n, by = "ARM") |>
sum_aedecod ::group_by(ARM, AEBODSYS, AEDECOD) |>
dplyr::summarize(
dplyrn_oe = dplyr::n_distinct(USUBJID),
pct_oe = n_oe/mean(N),
.groups = "drop"
)
<- dplyr::bind_rows(sum_ex, sum_aebodsys, sum_aedecod) |>
ex_tbl ::pivot_longer(cols = c(n_oe, n_tot), names_to = "lbl", values_to = "n") |>
tidyr::mutate(
dplyrpct_oe = ifelse(lbl == "n_tot", NA_real_, pct_oe)
|>
) pivot_wider(id_cols = c(AEBODSYS, AEDECOD, lbl), names_from = ARM, values_from = c(n, pct_oe)) |>
::mutate(
dplyrAEDECOD = forcats::fct_relevel(
.f = dplyr::case_when(
is.na(AEDECOD) & lbl == "n_tot" ~ "Total number of events",
is.na(AEDECOD) & lbl == "n_oe" ~ "Patients with at least one event",
TRUE ~ AEDECOD
),c("Patients with at least one event", "Total number of events"),
after = 0
),AEBODSYS = forcats::fct_relevel(
::fct_na_value_to_level(
forcats
AEBODSYS,level = " "
)," ",
after = 0
)|>
) ::filter(!(lbl == "n_tot" & !(AEDECOD %in% c("Patients with at least one event", "Total number of events")))) |>
dplyr::arrange(AEBODSYS, AEDECOD)
dplyr
|>
ex_tbl gt(
rowname_col = "AEDECOD",
groupname_col = "AEBODSYS"
|>
) cols_hide(columns = "lbl") |>
fmt_percent(
columns = starts_with("pct"),
decimals = 1
|>
) cols_merge_n_pct(
col_n = "n_A: Drug X",
col_pct = "pct_oe_A: Drug X"
|>
) cols_merge_n_pct(
col_n = "n_B: Placebo",
col_pct = "pct_oe_B: Placebo"
|>
) cols_merge_n_pct(
col_n = "n_C: Combination",
col_pct = "pct_oe_C: Combination"
|>
) cols_label(
"n_A: Drug X" = md(col_lbls[[1]]),
"n_B: Placebo" = md(col_lbls[[2]]),
"n_C: Combination" = md(col_lbls[[3]])
|>
) cols_align(
columns = 3:9,
align = "center"
|>
) cols_align(
columns = 1:2,
align = "left"
|>
) cols_width(
.list = list(
1:2 ~ px(250),
3:9 ~ px(120)
)|>
) tab_stub_indent(
rows = 2:18,
indent = 3
)
A: Drug X (N=134) |
B: Placebo (N=134) |
C: Combination (N=132) |
|
---|---|---|---|
Patients with at least one event | 122 (91.0%) | 123 (91.8%) | 120 (90.9%) |
Total number of events | 609 | 622 | 703 |
cl A.1 | |||
Patients with at least one event | 78 (58.2%) | 75 (56.0%) | 89 (67.4%) |
Total number of events | 132 | 130 | 160 |
dcd A.1.1.1.1 | 50 (37.3%) | 45 (33.6%) | 63 (47.7%) |
dcd A.1.1.1.2 | 48 (35.8%) | 48 (35.8%) | 50 (37.9%) |
cl B.1 | |||
Patients with at least one event | 47 (35.1%) | 49 (36.6%) | 43 (32.6%) |
Total number of events | 56 | 60 | 62 |
dcd B.1.1.1.1 | 47 (35.1%) | 49 (36.6%) | 43 (32.6%) |
cl B.2 | |||
Patients with at least one event | 79 (59.0%) | 74 (55.2%) | 85 (64.4%) |
Total number of events | 129 | 138 | 143 |
dcd B.2.1.2.1 | 49 (36.6%) | 44 (32.8%) | 52 (39.4%) |
dcd B.2.2.3.1 | 48 (35.8%) | 54 (40.3%) | 51 (38.6%) |
cl C.1 | |||
Patients with at least one event | 43 (32.1%) | 46 (34.3%) | 43 (32.6%) |
Total number of events | 55 | 63 | 64 |
dcd C.1.1.1.3 | 43 (32.1%) | 46 (34.3%) | 43 (32.6%) |
cl C.2 | |||
Patients with at least one event | 35 (26.1%) | 48 (35.8%) | 55 (41.7%) |
Total number of events | 48 | 53 | 65 |
dcd C.2.1.2.1 | 35 (26.1%) | 48 (35.8%) | 55 (41.7%) |
cl D.1 | |||
Patients with at least one event | 79 (59.0%) | 67 (50.0%) | 80 (60.6%) |
Total number of events | 127 | 106 | 135 |
dcd D.1.1.1.1 | 50 (37.3%) | 42 (31.3%) | 51 (38.6%) |
dcd D.1.1.4.2 | 48 (35.8%) | 42 (31.3%) | 50 (37.9%) |
cl D.2 | |||
Patients with at least one event | 47 (35.1%) | 58 (43.3%) | 57 (43.2%) |
Total number of events | 62 | 72 | 74 |
dcd D.2.1.5.3 | 47 (35.1%) | 58 (43.3%) | 57 (43.2%) |
4.2.4 tables
The tables package normally generates tables from single datasets, while this
kind of table requires information from two: adsl
and ex_adae
.
One way to handle this would be to add the adsl
patient count
information to a copy of the ex_adae
table. In this code we
use a different approach: we generate one table of patient counts
to produce the heading lines, and a second table with the adverse
event data, then use rbind()
to combine the two tables.
Code
resetSession()
library(tables)
table_options(doCSS = TRUE)
<- formatters::ex_adae
ex_adae
<- table(adsl$ARM)
subject_counts
<- function(num, ARM) {
countpercentid <- length(unique(num))
n if (n == 0) pct <- 0
else pct <- 100*n/subject_counts[ARM[1]]
sprintf("%d (%.2f%%)",
length(unique(num)),
pct)
}
<- function(x) sprintf("(N=%d)", length(x))
count
<- tabular(Heading("")*1*
heading Heading("")*count ~
Heading()*ARM, data = adsl)
<- tabular( Heading("Patients with at least one event")*1*
body Heading("")*countpercentid*Arguments(ARM = ARM)*
Heading()*USUBJID +
Heading("Total number of events")*1*Heading("")*1 +
Heading()*AEBODSYS*
Heading("Patients with at least one event")*
(Percent(denom = ARM, fn = countpercentid)*
Heading()*USUBJID +
Heading("Total number of events")*1 +
Heading()*AEDECOD*DropEmpty(which = "row")*
Heading()*Percent(denom = ARM, fn = countpercentid)*
Heading()*USUBJID) ~
Heading()*ARM,
data = ex_adae )
<- rbind(heading, body)
tab useGroupLabels(tab, indent = " ", extraLines = 1)
A: Drug X | B: Placebo | C: Combination | |
---|---|---|---|
(N=134) | (N=134) | (N=132) | |
Patients with at least one event | 122 (91.04%) | 123 (91.79%) | 120 (90.91%) |
Total number of events | 609 | 622 | 703 |
cl A.1 | |||
Patients with at least one event | 78 (58.21%) | 75 (55.97%) | 89 (66.42%) |
Total number of events | 132 | 130 | 160 |
dcd A.1.1.1.1 | 50 (37.31%) | 45 (33.58%) | 63 (47.01%) |
dcd A.1.1.1.2 | 48 (35.82%) | 48 (35.82%) | 50 (37.31%) |
cl B.1 | |||
Patients with at least one event | 47 (35.07%) | 49 (36.57%) | 43 (32.09%) |
Total number of events | 56 | 60 | 62 |
dcd B.1.1.1.1 | 47 (35.07%) | 49 (36.57%) | 43 (32.09%) |
cl B.2 | |||
Patients with at least one event | 79 (58.96%) | 74 (55.22%) | 85 (63.43%) |
Total number of events | 129 | 138 | 143 |
dcd B.2.1.2.1 | 49 (36.57%) | 44 (32.84%) | 52 (38.81%) |
dcd B.2.2.3.1 | 48 (35.82%) | 54 (40.30%) | 51 (38.06%) |
cl C.1 | |||
Patients with at least one event | 43 (32.09%) | 46 (34.33%) | 43 (32.09%) |
Total number of events | 55 | 63 | 64 |
dcd C.1.1.1.3 | 43 (32.09%) | 46 (34.33%) | 43 (32.09%) |
cl C.2 | |||
Patients with at least one event | 35 (26.12%) | 48 (35.82%) | 55 (41.04%) |
Total number of events | 48 | 53 | 65 |
dcd C.2.1.2.1 | 35 (26.12%) | 48 (35.82%) | 55 (41.04%) |
cl D.1 | |||
Patients with at least one event | 79 (58.96%) | 67 (50.00%) | 80 (59.70%) |
Total number of events | 127 | 106 | 135 |
dcd D.1.1.1.1 | 50 (37.31%) | 42 (31.34%) | 51 (38.06%) |
dcd D.1.1.4.2 | 48 (35.82%) | 42 (31.34%) | 50 (37.31%) |
cl D.2 | |||
Patients with at least one event | 47 (35.07%) | 58 (43.28%) | 57 (42.54%) |
Total number of events | 62 | 72 | 74 |
dcd D.2.1.5.3 | 47 (35.07%) | 58 (43.28%) | 57 (42.54%) |
4.2.5 flextable
By using tables::tabular()
to create a table and then
converting it to a flextable using as_flextable()
, you
can take advantage of the convenience and flexibility provided
by the tables package while still benefiting from the
formatting capabilities of flextable.
Code
library(flextable)
as_flextable(body, spread_first_col = TRUE, add_tab = TRUE) |>
align(j = 1, part = "all", align = "left") |>
padding(padding = 4, part = "all") |>
add_header_row(
values = c("", fmt_header_n(subject_counts, newline = FALSE)),
top = FALSE) |>
hline(i = 1, part = "header", border = fp_border_default(width = 0))
A: Drug X | B: Placebo | C: Combination | |
---|---|---|---|
(N=134) | (N=134) | (N=132) | |
Patients with at least one event | 122 (91.04%) | 123 (91.79%) | 120 (90.91%) |
Total number of events | 609 | 622 | 703 |
cl A.1 | |||
Patients with at least one event | 78 (58.21%) | 75 (55.97%) | 89 (66.42%) |
Total number of events | 132 | 130 | 160 |
dcd A.1.1.1.1 | 50 (37.31%) | 45 (33.58%) | 63 (47.01%) |
dcd A.1.1.1.2 | 48 (35.82%) | 48 (35.82%) | 50 (37.31%) |
cl B.1 | |||
Patients with at least one event | 47 (35.07%) | 49 (36.57%) | 43 (32.09%) |
Total number of events | 56 | 60 | 62 |
dcd B.1.1.1.1 | 47 (35.07%) | 49 (36.57%) | 43 (32.09%) |
cl B.2 | |||
Patients with at least one event | 79 (58.96%) | 74 (55.22%) | 85 (63.43%) |
Total number of events | 129 | 138 | 143 |
dcd B.2.1.2.1 | 49 (36.57%) | 44 (32.84%) | 52 (38.81%) |
dcd B.2.2.3.1 | 48 (35.82%) | 54 (40.30%) | 51 (38.06%) |
cl C.1 | |||
Patients with at least one event | 43 (32.09%) | 46 (34.33%) | 43 (32.09%) |
Total number of events | 55 | 63 | 64 |
dcd C.1.1.1.3 | 43 (32.09%) | 46 (34.33%) | 43 (32.09%) |
cl C.2 | |||
Patients with at least one event | 35 (26.12%) | 48 (35.82%) | 55 (41.04%) |
Total number of events | 48 | 53 | 65 |
dcd C.2.1.2.1 | 35 (26.12%) | 48 (35.82%) | 55 (41.04%) |
cl D.1 | |||
Patients with at least one event | 79 (58.96%) | 67 (50.00%) | 80 (59.70%) |
Total number of events | 127 | 106 | 135 |
dcd D.1.1.1.1 | 50 (37.31%) | 42 (31.34%) | 51 (38.06%) |
dcd D.1.1.4.2 | 48 (35.82%) | 42 (31.34%) | 50 (37.31%) |
cl D.2 | |||
Patients with at least one event | 47 (35.07%) | 58 (43.28%) | 57 (42.54%) |
Total number of events | 62 | 72 | 74 |
dcd D.2.1.5.3 | 47 (35.07%) | 58 (43.28%) | 57 (42.54%) |
4.2.6 tidytlg
Code
resetSession()
library(dplyr)
library(tidytlg)
<- formatters::ex_adsl
adsl <- formatters::ex_adae %>%
adae mutate(TRTEMFL = "Y")
# Create analysis population counts
<- freq(adsl,
tbl1 rowvar = "SAFFL",
colvar = "ARM",
statlist = statlist("n"),
rowtext = "Analysis Set: Safety Population",
subset = SAFFL == "Y")
# Create counts (percentages) for patients with at least one event
<- freq(adae,
tbl2 denom_df = adsl,
rowvar = "TRTEMFL",
colvar = "ARM",
statlist = statlist("n (x.x%)"),
rowtext = "Patients with at least one event",
subset = TRTEMFL == "Y")
# Create counts (percentages) of AE by AEBODSYS and AEDECOD
<- nested_freq(adae,
tbl3a denom_df = adsl,
rowvar = "AEBODSYS*AEDECOD",
colvar = "ARM",
statlist = statlist("n (x.x%)"))
# Create total event counts by AEBODSYS
<- freq(adae,
tbl3b rowvar = "AEBODSYS",
colvar = "ARM",
statlist = statlist("n", distinct = FALSE)) %>%
rename(AEBODSYS = label) %>%
mutate(label = "Total number of events",
nested_level = 0)
# interleave tbl3a and tbl3b by AEBODSYS
<- bind_rows(tbl3a, tbl3b) %>%
tbl3 arrange(AEBODSYS, nested_level)
# combine analysis results together
<- bind_table(tbl1, tbl2, tbl3) %>%
tbl select(-AEBODSYS)
# output the analysis results
gentlg(huxme = tbl,
format = "HTML",
print.hux = FALSE,
file = "Table x.x.x.x",
orientation = "portrait",
title = "Adverse Events Summary - Safety Analysis Set",
colheader = c("","A: Drug X","B: Placebo","C: Combination"))
Table x.x.x.x: Adverse Events Summary - Safety Analysis Set | |||
A: Drug X | B: Placebo | C: Combination | |
---|---|---|---|
Analysis Set: Safety Population | 134 | 134 | 132 |
Patients with at least one event | 122 (91.0%) | 123 (91.8%) | 120 (90.9%) |
cl A.1 | 78 (58.2%) | 75 (56.0%) | 89 (67.4%) |
Total number of events | 132 | 130 | 160 |
dcd A.1.1.1.1 | 50 (37.3%) | 45 (33.6%) | 63 (47.7%) |
dcd A.1.1.1.2 | 48 (35.8%) | 48 (35.8%) | 50 (37.9%) |
cl B.1 | 47 (35.1%) | 49 (36.6%) | 43 (32.6%) |
Total number of events | 56 | 60 | 62 |
dcd B.1.1.1.1 | 47 (35.1%) | 49 (36.6%) | 43 (32.6%) |
cl B.2 | 79 (59.0%) | 74 (55.2%) | 85 (64.4%) |
Total number of events | 129 | 138 | 143 |
dcd B.2.1.2.1 | 49 (36.6%) | 44 (32.8%) | 52 (39.4%) |
dcd B.2.2.3.1 | 48 (35.8%) | 54 (40.3%) | 51 (38.6%) |
cl C.1 | 43 (32.1%) | 46 (34.3%) | 43 (32.6%) |
Total number of events | 55 | 63 | 64 |
dcd C.1.1.1.3 | 43 (32.1%) | 46 (34.3%) | 43 (32.6%) |
cl C.2 | 35 (26.1%) | 48 (35.8%) | 55 (41.7%) |
Total number of events | 48 | 53 | 65 |
dcd C.2.1.2.1 | 35 (26.1%) | 48 (35.8%) | 55 (41.7%) |
cl D.1 | 79 (59.0%) | 67 (50.0%) | 80 (60.6%) |
Total number of events | 127 | 106 | 135 |
dcd D.1.1.1.1 | 50 (37.3%) | 42 (31.3%) | 51 (38.6%) |
dcd D.1.1.4.2 | 48 (35.8%) | 42 (31.3%) | 50 (37.9%) |
cl D.2 | 47 (35.1%) | 58 (43.3%) | 57 (43.2%) |
Total number of events | 62 | 72 | 74 |
dcd D.2.1.5.3 | 47 (35.1%) | 58 (43.3%) | 57 (43.2%) |
[table x.x.x.x.html][/home/runner/work/_temp/dbc50335-555d-4c9d-8c49-eaade0bcc058] 03NOV2023, 00:16 |
4.2.7 tfrmt
Rather than starting with an ADaM, tfrmt assumes users will start with an ARD (Analysis Results Dataset), because of this, making this table will be split into two parts, first to make the ARD and second to format the table.
Code
resetSession()
library(tidyverse)
library(tfrmt)
# Make ARD
<- formatters::ex_adsl
ex_adsl <- formatters::ex_adae
ex_adae
<- ex_adsl |>
big_n ::group_by(ARM) |>
dplyr::summarize(
dplyrN = dplyr::n_distinct(USUBJID)
)
<- ex_adae |>
adae_with_n ::left_join(big_n, by = "ARM")
dplyr
<- function(.data){
calc_tot_and_any |>
.data ::reframe(
dplyrn_subj = n_distinct(USUBJID),
pct_subj = n_subj/N,
n_evnts = n()
|>
) ::distinct() |>
dplyr::pivot_longer(c("n_subj", "pct_subj", "n_evnts")) |>
tidyr::mutate(label = dplyr::case_when(
dplyr%in% c("n_subj", "pct_subj") ~ "Patients with at least one event",
name == "n_evnts" ~ "Total number of events"
name
))
}
<- adae_with_n |>
overall ::group_by(ARM) |>
dplyrcalc_tot_and_any() |>
:: mutate(AEBODSYS = label)
dplyr
<- adae_with_n |>
bdysys_overall ::group_by(ARM, AEBODSYS) |>
dplyrcalc_tot_and_any()
<- adae_with_n |>
aeterm_sum ::group_by(ARM, AEBODSYS, AETERM) |>
dplyr::reframe(
dplyrn_subj = n_distinct(USUBJID),
pct_subj = n_subj/N) |>
::distinct() |>
dplyr::pivot_longer(ends_with("subj")) |>
tidyr::rename(label = AETERM)
dplyr
<- big_n |>
header_n ::rename(value = N) |>
dplyr::mutate(name = "header_n")
dplyr
<- dplyr::bind_rows(
ae_ard
overall,
bdysys_overall,
aeterm_sum,
header_n
)
## Format Table
tfrmt(
column = ARM,
group = c("AEBODSYS"),
param = name,
value = value,
label = label,
|>
) # Then we cam combine it with an n percent template
tfrmt_n_pct(n = "n_subj",
pct = "pct_subj",
pct_frmt_when = frmt_when("==1" ~ "",
">.99" ~ "(>99%)",
"==0" ~ "",
"<.01" ~ "(<1%)",
"TRUE" ~ frmt("(xx.x%)", transform = ~.*100))
|>
) #Finally we are going to add some additional formatting
tfrmt(
body_plan = body_plan(
frmt_structure("n_evnts" = frmt("XXX"))
),big_n = big_n_structure("header_n"),
# Aligning on decimal places and spaces
col_style_plan = col_style_plan(
col_style_structure(col = matches("[A-Z]:.*"),
align = c(".", " "))
)|>
) print_to_gt(ae_ard)
A: Drug X N = 134 | B: Placebo N = 134 | C: Combination N = 132 | |
---|---|---|---|
Patients with at least one event | 122 (91.0%) | 123 (91.8%) | 120 (90.9%) |
Total number of events | 609 | 622 | 703 |
cl A.1 | |||
Patients with at least one event | 78 (58.2%) | 75 (56.0%) | 89 (67.4%) |
Total number of events | 132 | 130 | 160 |
trm A.1.1.1.1 | 50 (37.3%) | 45 (33.6%) | 63 (47.7%) |
trm A.1.1.1.2 | 48 (35.8%) | 48 (35.8%) | 50 (37.9%) |
cl B.1 | |||
Patients with at least one event | 47 (35.1%) | 49 (36.6%) | 43 (32.6%) |
Total number of events | 56 | 60 | 62 |
trm B.1.1.1.1 | 47 (35.1%) | 49 (36.6%) | 43 (32.6%) |
cl B.2 | |||
Patients with at least one event | 79 (59.0%) | 74 (55.2%) | 85 (64.4%) |
Total number of events | 129 | 138 | 143 |
trm B.2.1.2.1 | 49 (36.6%) | 44 (32.8%) | 52 (39.4%) |
trm B.2.2.3.1 | 48 (35.8%) | 54 (40.3%) | 51 (38.6%) |
cl C.1 | |||
Patients with at least one event | 43 (32.1%) | 46 (34.3%) | 43 (32.6%) |
Total number of events | 55 | 63 | 64 |
trm C.1.1.1.3 | 43 (32.1%) | 46 (34.3%) | 43 (32.6%) |
cl C.2 | |||
Patients with at least one event | 35 (26.1%) | 48 (35.8%) | 55 (41.7%) |
Total number of events | 48 | 53 | 65 |
trm C.2.1.2.1 | 35 (26.1%) | 48 (35.8%) | 55 (41.7%) |
cl D.1 | |||
Patients with at least one event | 79 (59.0%) | 67 (50.0%) | 80 (60.6%) |
Total number of events | 127 | 106 | 135 |
trm D.1.1.1.1 | 50 (37.3%) | 42 (31.3%) | 51 (38.6%) |
trm D.1.1.4.2 | 48 (35.8%) | 42 (31.3%) | 50 (37.9%) |
cl D.2 | |||
Patients with at least one event | 47 (35.1%) | 58 (43.3%) | 57 (43.2%) |
Total number of events | 62 | 72 | 74 |
trm D.2.1.5.3 | 47 (35.1%) | 58 (43.3%) | 57 (43.2%) |
4.3 Time to Event Analysis Tables
4.3.1 Data and models used throughout
Code
resetSession()
library(dplyr)
library(tidyr)
library(stringr)
library(purrr)
library(survival)
data("cadaette", package = "random.cdisc.data")
head(cadaette)
# A tibble: 6 × 66
STUDYID USUBJID SUBJID SITEID AGE AGEU SEX RACE ETHNIC COUNTRY DTHFL
<chr> <chr> <chr> <chr> <int> <fct> <fct> <fct> <fct> <fct> <fct>
1 AB12345 AB12345-BR… id-105 BRA-1 38 YEARS M BLAC… HISPA… BRA N
2 AB12345 AB12345-BR… id-105 BRA-1 38 YEARS M BLAC… HISPA… BRA N
3 AB12345 AB12345-BR… id-105 BRA-1 38 YEARS M BLAC… HISPA… BRA N
4 AB12345 AB12345-BR… id-105 BRA-1 38 YEARS M BLAC… HISPA… BRA N
5 AB12345 AB12345-BR… id-105 BRA-1 38 YEARS M BLAC… HISPA… BRA N
6 AB12345 AB12345-BR… id-105 BRA-1 38 YEARS M BLAC… HISPA… BRA N
# ℹ 55 more variables: INVID <chr>, INVNAM <chr>, ARM <fct>, ARMCD <fct>,
# ACTARM <fct>, ACTARMCD <fct>, TRT01P <fct>, TRT01A <fct>, TRT02P <fct>,
# TRT02A <fct>, REGION1 <fct>, STRATA1 <fct>, STRATA2 <fct>, BMRKR1 <dbl>,
# BMRKR2 <fct>, ITTFL <fct>, SAFFL <fct>, BMEASIFL <fct>, BEP01FL <fct>,
# AEWITHFL <fct>, RANDDT <date>, TRTSDTM <dttm>, TRTEDTM <dttm>,
# TRT01SDTM <dttm>, TRT01EDTM <dttm>, TRT02SDTM <dttm>, TRT02EDTM <dttm>,
# AP01SDTM <dttm>, AP01EDTM <dttm>, AP02SDTM <dttm>, AP02EDTM <dttm>, …
Code
<- cadaette %>%
adtte ::filter(PARAMCD == "AETTE2", SAFFL == "Y") dplyr
Cox Proportional Hazard fit:
Code
<- coxph(Surv(AVAL, CNSR==0) ~ TRT01A + STRATA1, ties = "exact", data = adtte) cph
Kaplan-Meier Model
Code
<- as.data.frame(summary(survfit(Surv(AVAL, CNSR==0) ~ TRT01A,
surv_tbl data = adtte, conf.type = "log-log"))$table) %>%
::mutate(TRT01A = factor(str_remove(row.names(.), "TRT01A="),
dplyrlevels = levels(adtte$TRT01A)),
ind = FALSE)
<- c("Serious adverse events are defined as (...). All p-values are exploratory.",
mn_footer_txt "Hazard ratios are from a stratified Cox model of serious adverse event hazard rate,",
"with terms for treatment groups and strata1. Ties were handled using the exact",
"method. Hazard ratios of Placebo Combination over Drug X are presented, an",
"HR < 1 denotes improvement compared to Drug X.")
<- c("x.x.x: Time to First Serious Adverse Event",
stitle_txt "Table x.x.x.x: Safety Endpoint - Safety Analysis Set")
<- currentState() .kmState
4.3.2 rtables
Code
resetSession(.kmState)
library(rtables)
## this will be properly exported in the next release of rtables
<- rtables:::RefFootnote
RefFootnote
<- function(df, .var, .N_col) {
cnsr_counter <- df[!duplicated(df$USUBJID), .var]
x <- x[x != "__none__"]
x lapply(table(x), function(xi) rcell(xi*c(1, 1/.N_col), format = "xx (xx.xx%)"))
}
<- function(x, .N_col) {
a_count_subjs in_rows("Subjects with Adverse Events n (%)" = rcell(length(unique(x)) * c(1, 1 / .N_col),
format = "xx (xx.xx%)"))
}
<- function(df, .var, .in_ref_col, .ref_full, full_cox_fit) {
a_cph if(.in_ref_col) {
<- replicate(3, list(rcell(NULL)))
ret else {
} <- df[[.var]][1]
curtrt <- coef(full_cox_fit)
coefs <- grep(curtrt, names(coefs), fixed = TRUE)
sel_pos <- exp(coefs[sel_pos])
hrval <- rcell(hrval, format = "xx.x")
hrvalret <- survdiff(Surv(AVAL, CNSR==0) ~ TRT01A + STRATA1,
sdf data = rbind(df, .ref_full))
<- (1-pchisq(sdf$chisq, length(sdf$n)-1))/2
pval <- exp(unlist(confint(full_cox_fit)[sel_pos,]))
ci_val <- list(rcell(hrval, format = "xx.x"),
ret rcell(ci_val, format = "(xx.x, xx.x)"),
rcell(pval, format = "x.xxxx | (<0.0001)"))
}in_rows(.list = ret, .names = c("Hazard ratio",
"95% confidence interval",
"p-value (one-sided stratified log rank)"))
}
<- function(df, .var, kp_table) {
a_tte <- grep(df[[.var]][1], row.names(kp_table), fixed = TRUE)
ind <- range(df[["AVAL"]])
minmax
<- format_value(minmax, format = "xx.x, xx.x")
mm_val_str <- list()
rowfn in_rows(Median = kp_table[ind, "median", drop = TRUE],
"95% confidence interval" = unlist(kp_table[ind, c("0.95LCL", "0.95UCL")]),
"Min Max" = mm_val_str,
.formats = c("xx.xx",
"xx.xx - xx.xx",
"xx"), .cell_footnotes = list(NULL, NULL, list(RefFootnote("Denotes censoring", index = 0L, symbol = "*"))))
}
<- adtte |>
adtte2 mutate(CNSDTDSC = ifelse(CNSDTDSC == "", "__none__", CNSDTDSC))
<- basic_table(show_colcounts = TRUE,
lyt title = "x.x: Safety Data",
subtitles = stitle_txt,
main_footer = mn_footer_txt,
prov_footer = "Source: ADTTE DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY") |>
split_cols_by("ARM", ref_group = "A: Drug X") |>
analyze("USUBJID", a_count_subjs, show_labels = "hidden") |>
analyze("CNSDTDSC", cnsr_counter, var_labels = "Censored Subjects", show_labels = "visible") |>
analyze("ARM", a_cph, extra_args = list(full_cox_fit = cph), show_labels = "hidden") |>
analyze("ARM", a_tte, var_labels = "Time to first adverse event", show_labels = "visible",
extra_args = list(kp_table = surv_tbl),
table_names = "kapmeier")
<- build_table(lyt, adtte2)
tbl_tte
fnotes_at_path(tbl_tte, c("ma_USUBJID_CNSDTDSC_ARM_kapmeier", "kapmeier")) <- "Product-limit (Kaplan-Meier) estimates."
tbl_tte
x.x: Safety Data
x.x.x: Time to First Serious Adverse Event
Table x.x.x.x: Safety Endpoint - Safety Analysis Set
————————————————————————————————————————————————————————————————————————————————————————
A: Drug X B: Placebo C: Combination
(N=134) (N=134) (N=132)
————————————————————————————————————————————————————————————————————————————————————————
Subjects with Adverse Events n (%) 134 (100.00%) 134 (100.00%) 132 (100.00%)
Censored Subjects
Clinical Cut Off 10 (7.46%) 4 (2.99%) 14 (10.61%)
Completion or Discontinuation 13 (9.70%) 3 (2.24%) 16 (12.12%)
End of AE Reporting Period 22 (16.42%) 4 (2.99%) 14 (10.61%)
Hazard ratio 1.5 1.1
95% confidence interval (1.1, 1.9) (0.8, 1.5)
p-value (one-sided stratified log rank) 0.0208 0.4619
Time to first adverse event {1}
Median 0.39 0.37 0.26
95% confidence interval 0.23 - 0.60 0.25 - 0.46 0.18 - 0.34
Min Max 0.0, 3.0 {*} 0.0, 3.0 {*} 0.0, 3.0 {*}
————————————————————————————————————————————————————————————————————————————————————————
{1} - Product-limit (Kaplan-Meier) estimates.
{*} - Denotes censoring
————————————————————————————————————————————————————————————————————————————————————————
Serious adverse events are defined as (...). All p-values are exploratory.
Hazard ratios are from a stratified Cox model of serious adverse event hazard rate,
with terms for treatment groups and strata1. Ties were handled using the exact
method. Hazard ratios of Placebo Combination over Drug X are presented, an
HR < 1 denotes improvement compared to Drug X.
Source: ADTTE DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY
4.3.3 tern (+rtables)
tern encapsulates the specific statistical choices used by Roche. In particulate, its implementation of the Cox pairwise analysis does not implement the one-tailed p-value strategy used in the rest of this chapter.
We will first showcaes the pure tern solution, which has different p-values for this reason, and then implement a hybrid tern + explicit rtables solution which fully recreates the exact table generated by other systems.
Code
resetSession(.kmState)
library(tern)
## this will be properly exported in the next release of rtables
<- rtables:::RefFootnote
RefFootnote
<- adtte
adtte3 $is_event <- adtte$CNSR == 0
adtte3$CNSDTDSC[adtte$CNSDTDSC == ""] <- NA
adtte3
<- basic_table(show_colcounts = TRUE,
lyt1 title = "x.x: Safety Data",
subtitles = stitle_txt,
main_footer = mn_footer_txt,
prov_footer = "Source: ADTTE DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY") |>
split_cols_by("TRT01A", ref_group = "A: Drug X") |>
count_values(
"STUDYID",
values = "AB12345",
.stats = "count_fraction",
.labels = c(count_fraction = "Subjects with Adverse Events n (%)")
|>
) count_occurrences(
"CNSDTDSC",
var_labels = "Censored Subjects",
show_labels = "visible",
.formats = c(count_fraction = "xx.xx (xx.xx%)")
|>
) coxph_pairwise(
vars = "AVAL",
is_event = "is_event",
control = control_coxph(pval_method = "log-rank", ties = "exact"),
strat = "STRATA1",
.stats = c("hr", "hr_ci", "pvalue"),
.formats = c(hr = "xx.x", hr_ci = "(xx.x, xx.x)", pvalue = "xx.xxxx"),
.labels = c(hr = "Hazard ratio", hr_ci = "95% confidence interval", pvalue = "p-value (stratified log rank)"),
show_labels = "hidden",
table_names = "coxph"
|>
) surv_time(
vars = "AVAL",
is_event = "is_event",
control = control_surv_time(conf_type = "log-log"),
.stats = c("median", "median_ci", "range"),
.formats = c(median = "xx.xx", median_ci = "xx.xx - xx.xx", range = "xx.x, xx.x"),
.labels = c(median_ci = "95% confidence interval", range = "Min Max"),
.indent_mods = c(median_ci = 0L),
var_labels = "Time to first adverse event"
)
<- build_table(lyt = lyt1, df = adtte3)
tbl_tte_tern
fnotes_at_path(tbl_tte_tern, c("ma_STUDYID_CNSDTDSC_coxph_AVAL", "AVAL")) <- "Product-limit (Kaplan-Meier) estimates."
<- RefFootnote("Censored.", index = 0L, symbol = "^")
fnote
for(pth in col_paths(tbl_tte_tern)) {
fnotes_at_path(tbl_tte_tern,
rowpath = c("ma_STUDYID_CNSDTDSC_coxph_AVAL", "AVAL", "range"),
colpath = pth) <- fnote
} tbl_tte_tern
x.x: Safety Data
x.x.x: Time to First Serious Adverse Event
Table x.x.x.x: Safety Endpoint - Safety Analysis Set
————————————————————————————————————————————————————————————————————————————————————
A: Drug X B: Placebo C: Combination
(N=134) (N=134) (N=132)
————————————————————————————————————————————————————————————————————————————————————
Subjects with Adverse Events n (%) 134 (100.00%) 134 (100.00%) 132 (100.00%)
Censored Subjects
Clinical Cut Off 10.00 (7.46%) 4.00 (2.99%) 14.00 (10.61%)
Completion or Discontinuation 13.00 (9.70%) 3.00 (2.24%) 16.00 (12.12%)
End of AE Reporting Period 22.00 (16.42%) 4.00 (2.99%) 14.00 (10.61%)
Hazard ratio 1.5 1.1
95% confidence interval (1.2, 2.0) (0.8, 1.5)
p-value (stratified log rank) 0.0023 0.6027
Time to first adverse event {1}
Median 0.39 0.37 0.26
95% confidence interval 0.23 - 0.60 0.25 - 0.46 0.18 - 0.34
Min Max 0.0, 3.0 {^} 0.0, 3.0 {^} 0.0, 3.0 {^}
————————————————————————————————————————————————————————————————————————————————————
{1} - Product-limit (Kaplan-Meier) estimates.
{^} - Censored.
————————————————————————————————————————————————————————————————————————————————————
Serious adverse events are defined as (...). All p-values are exploratory.
Hazard ratios are from a stratified Cox model of serious adverse event hazard rate,
with terms for treatment groups and strata1. Ties were handled using the exact
method. Hazard ratios of Placebo Combination over Drug X are presented, an
HR < 1 denotes improvement compared to Drug X.
Source: ADTTE DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY
We now create the hybrid table where we utilize a custom analysis function to recreate the one-sided p-values while using tern for the rest of the table structure.
Code
<- function(df, .var, .in_ref_col, .ref_full, full_cox_fit) {
a_cph if(.in_ref_col) {
<- replicate(3, list(rcell(NULL)))
ret else {
} <- df[[.var]][1]
curtrt <- coef(full_cox_fit)
coefs <- grep(curtrt, names(coefs), fixed = TRUE)
sel_pos <- exp(coefs[sel_pos])
hrval <- rcell(hrval, format = "xx.x")
hrvalret <- survival::survdiff(Surv(AVAL, CNSR==0) ~ TRT01A + STRATA1,
sdf data = rbind(df, .ref_full))
<- (1-pchisq(sdf$chisq, length(sdf$n)-1))/2
pval <- exp(unlist(confint(full_cox_fit)[sel_pos,]))
ci_val <- list(rcell(hrval, format = "xx.x"),
ret rcell(ci_val, format = "(xx.x, xx.x)"),
rcell(pval, format = "x.xxxx | (<0.0001)"))
}in_rows(.list = ret, .names = c("Hazard ratio",
"95% confidence interval",
"p-value (one-sided stratified log rank)"))
}
<- basic_table(show_colcounts = TRUE,
lyt2 title = "x.x: Safety Data",
subtitles = stitle_txt,
main_footer = mn_footer_txt,
prov_footer = "Source: ADTTE DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY") |>
split_cols_by("TRT01A", ref_group = "A: Drug X") |>
count_values(
"STUDYID",
values = "AB12345",
.stats = "count_fraction",
.labels = c(count_fraction = "Subjects with Adverse Events n (%)")
|>
) count_occurrences(
"CNSDTDSC",
var_labels = "Censored Subjects",
show_labels = "visible",
.formats = c(count_fraction = "xx.xx (xx.xx%)")
|>
) analyze("ARM", a_cph, extra_args = list(full_cox_fit = cph), show_labels = "hidden") |>
surv_time(
vars = "AVAL",
is_event = "is_event",
control = control_surv_time(conf_type = "log-log"),
.stats = c("median", "median_ci", "range"),
.formats = c(median = "xx.xx", median_ci = "xx.xx - xx.xx", range = "xx.x, xx.x"),
.labels = c(median_ci = "95% confidence interval", range = "Min Max"),
.indent_mods = c(median_ci = 0L),
var_labels = "Time to first adverse event"
)
<- build_table(lyt = lyt2, df = adtte3)
tbl_tte_tern2
fnotes_at_path(tbl_tte_tern2, c("ma_STUDYID_CNSDTDSC_ARM_AVAL", "AVAL")) <- "Product-limit (Kaplan-Meier) estimates."
<- RefFootnote("Denotes censoring.", index = 0L, symbol = "*")
fnote
for(pth in col_paths(tbl_tte_tern2)) {
fnotes_at_path(tbl_tte_tern2,
rowpath = c("ma_STUDYID_CNSDTDSC_ARM_AVAL", "AVAL", "range"),
colpath = pth) <- fnote
} tbl_tte_tern2
x.x: Safety Data
x.x.x: Time to First Serious Adverse Event
Table x.x.x.x: Safety Endpoint - Safety Analysis Set
—————————————————————————————————————————————————————————————————————————————————————————
A: Drug X B: Placebo C: Combination
(N=134) (N=134) (N=132)
—————————————————————————————————————————————————————————————————————————————————————————
Subjects with Adverse Events n (%) 134 (100.00%) 134 (100.00%) 132 (100.00%)
Censored Subjects
Clinical Cut Off 10.00 (7.46%) 4.00 (2.99%) 14.00 (10.61%)
Completion or Discontinuation 13.00 (9.70%) 3.00 (2.24%) 16.00 (12.12%)
End of AE Reporting Period 22.00 (16.42%) 4.00 (2.99%) 14.00 (10.61%)
Hazard ratio 1.5 1.1
95% confidence interval (1.1, 1.9) (0.8, 1.5)
p-value (one-sided stratified log rank) 0.0208 0.4619
Time to first adverse event {1}
Median 0.39 0.37 0.26
95% confidence interval 0.23 - 0.60 0.25 - 0.46 0.18 - 0.34
Min Max 0.0, 3.0 {*} 0.0, 3.0 {*} 0.0, 3.0 {*}
—————————————————————————————————————————————————————————————————————————————————————————
{1} - Product-limit (Kaplan-Meier) estimates.
{*} - Denotes censoring.
—————————————————————————————————————————————————————————————————————————————————————————
Serious adverse events are defined as (...). All p-values are exploratory.
Hazard ratios are from a stratified Cox model of serious adverse event hazard rate,
with terms for treatment groups and strata1. Ties were handled using the exact
method. Hazard ratios of Placebo Combination over Drug X are presented, an
HR < 1 denotes improvement compared to Drug X.
Source: ADTTE DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY
4.3.4 Cell Value Derivation for gt of Time to Event Analysis
Our standard TTE table consists of (a derivation of) four main parts:
- Descriptive stats including the number of subjects with an event, number of subjects censored and censoring reasons
- Hazard ratio with corresponding 95% CI from a (stratified) Cox model and a p-value from a stratified log rank test
- Median time to event Kaplan-Meier analysis
- Number of patients at risk at specified visits from Kaplan-Meier analysis (omitted here).
Code
resetSession(.kmState)
library(gt)
### Subject Count with events
## surv_tbl calculated above
<- surv_tbl |>
subj_count ::mutate(pct = sprintf("%i (%5.1f)", events, 100*events/records),
dplyrlabel = "Number of subjects with serious adverse event, n (%)") |>
::select(label, TRT01A, pct) |>
dplyr::pivot_wider(id_cols = label, names_from = TRT01A, values_from = pct) |>
tidyr::mutate(ind = FALSE)
dplyr
# Number of censored subjects
<- surv_tbl |>
cnsrd_subj_full ::mutate(pct = sprintf("%i (%4.1f)", records-events, 100*(records-events)/records),
dplyrCNSDTDSC = "Number of censored subjects, n (%)") |>
::select(CNSDTDSC, TRT01A, pct)
dplyr
<- adtte |>
cnsrd_subj ::group_by(TRT01A) |>
dplyr::mutate(CNSR = CNSR/n()) |>
dplyr::ungroup() |>
dplyr::filter(CNSR != 0) |>
dplyr::group_by(TRT01A, CNSDTDSC) |>
dplyr::summarise(pct = sprintf("%i (%4.1f)", sum(CNSR != 0), 100*sum(CNSR)), .groups = "drop") |>
dplyr::bind_rows(cnsrd_subj_full) |>
dplyr::pivot_wider(id_cols = CNSDTDSC, names_from = TRT01A, values_from = pct) |>
tidyr::rename(label = CNSDTDSC) |>
dplyr::mutate(ind = label != "Number of censored subjects, n (%)") |>
dplyr::arrange(ind) dplyr
Code
## cph calculated above
<- exp(coef(cph))
hr <- exp(confint(cph))
ci_hr
# Hazard ratio and 95% CI
<- cbind(ci_hr, hr) |>
df_hr as.data.frame() |>
::filter(data, grepl("TRT01A", row.names(data))))() |>
(\(data) dplyr::mutate(
(\(data) dplyr
data, TRT01A = factor(stringr::str_remove(row.names(data), "TRT01A")),
ci = sprintf("[%4.1f, %4.1f]", round(!!sym("2.5 %"), 1), round(!!sym("97.5 %"), 1))
|>
))() ::select(TRT01A, hr, ci)
dplyr
# Log rank p-value
<- purrr::map_df(.x = list(c("A: Drug X", "B: Placebo"),
log_rank_test c("A: Drug X", "C: Combination")),
.f = ~{sdf <- survdiff(Surv(AVAL, CNSR==0) ~ TRT01A + STRATA1,
data = adtte |> dplyr::filter(TRT01A %in% .x));
data.frame(TRT01A = .x[2],
pval = (1-pchisq(sdf$chisq, length(sdf$n)-1))/2)})
<- merge(df_hr, log_rank_test, by = "TRT01A") |>
df_hr_comp ::mutate(hr = sprintf("%4.1f", round(hr, 1)),
dplyrpval = ifelse(pval < 0.0001, "<0.0001", sprintf("%6.4f", round(pval, 4)))) |>
::pivot_longer(cols = c(hr, ci, pval), names_to = "label", values_to = "val") |>
tidyr::pivot_wider(names_from = TRT01A, values_from = "val") |>
tidyr::mutate(label = dplyr::recode(label,
dplyr"hr" = "Hazard ratio",
"ci" = "95% confidence interval",
"pval" = "p-value (one-sided stratified log rank)"),
ind = FALSE)
Code
<- surv_tbl |>
median_survtime ::mutate(ci = sprintf("[%4.2f, %4.2f]", !!sym("0.95LCL"), !!sym("0.95UCL")),
dplyrmedian = sprintf("%4.2f", median),
id = "") |>
::select(TRT01A, id, median, ci) |>
dplyr::pivot_longer(cols = c(id, median, ci), names_to = "label", values_to = "val") |>
tidyr::pivot_wider(names_from = TRT01A, values_from = val) |>
tidyr::mutate(ind = label != "id",
dplyrlabel = dplyr::recode(label, "median" = "Median (years)",
"ci" = "95% confidence interval",
"id" = "Time to first serious adverse event (a)"))
<- adtte |>
min_max ::filter(!(AVAL == 0 & CNSR == 1)) |>
dplyr::group_by(TRT01A) |>
dplyr::mutate(max_cnsr = !is.na(AVAL) & AVAL == max(AVAL, na.rm = TRUE) & CNSR == 1) |>
dplyr::summarize(
dplyrmin_max = sprintf("%4.2f, %4.2f%s", min(AVAL, na.rm = TRUE), max(AVAL, na.rm = TRUE), ifelse(sum(max_cnsr) > 0, "*", "")),
.groups = "drop"
|>
) ::pivot_wider(names_from = TRT01A, values_from = min_max) |>
tidyr::mutate(label = "Min, Max (b)",
dplyrind = TRUE)
<- dplyr::bind_rows(subj_count, cnsrd_subj, df_hr_comp, median_survtime, min_max) model_sum
4.3.5 gt
Code
<- adtte |>
header_n ::group_by(TRT01A) |>
dplyr::summarise(N = dplyr::n(), .groups = "drop") |>
dplyr::transmute(TRT = sprintf("%s \n N=%i (100%%)", TRT01A, N)) |>
dplyr::group_split(TRT)
dplyr
### Begin table creation
gt(model_sum) |>
cols_hide(ind) |>
tab_header(
title = "x.x: Safety Data",
subtitle = md("x.x.x: Time to First Serious Adverse Event \n Table x.x.x.x: Safety Endpoint - Safety Analysis Set"),
preheader = c("Protocol: XXXXX", "Cutoff date: DDMMYYYY")
|>
) tab_source_note("Source: ADTTE DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY") |>
opt_align_table_header(align = "left") |>
cols_align(align = c("center"),
columns = c("A: Drug X", "B: Placebo", "C: Combination")) |>
cols_align(align = "left",
columns = "label") |>
tab_style(style = cell_text(indent = pct(5)),
locations = cells_body(columns = 1,
rows = ind == TRUE)) |>
sub_missing(columns = everything(), missing_text = "") |>
cols_label("label" = "",
"A: Drug X" = md(header_n[[1]]),
"B: Placebo" = md(header_n[[2]]),
"C: Combination" = md(header_n[[3]])) |>
tab_footnote(footnote = md("Serious adverse events are defines as (...). All p-values are exploratory. \n (a) Product-limit (Kaplan-Meier) estimates. \n (b) Minimum and maximum of event times. * Denotes censoring. \n Hazard ratios are from a stratified Cox model of serious adverse event hazard rate, with terms for treatment groups and strata1. Ties were handled using the exact method. Hazard ratios of Placebo/ Combination over Drug X are presented, a HR < 1 denotes improvement compared to Drug X.")) |>
tab_options(
table.font.names = "Courier new",
table.font.size = 9,
page.orientation = "landscape",
page.numbering = TRUE,
page.header.use_tbl_headings = TRUE,
page.footer.use_tbl_notes = TRUE)
x.x: Safety Data | |||
x.x.x: Time to First Serious Adverse Event Table x.x.x.x: Safety Endpoint - Safety Analysis Set |
|||
A: Drug X N=134 (100%) |
B: Placebo N=134 (100%) |
C: Combination N=132 (100%) |
|
---|---|---|---|
Number of subjects with serious adverse event, n (%) | 89 ( 66.4) | 123 ( 91.8) | 88 ( 66.7) |
Number of censored subjects, n (%) | 45 (33.6) | 11 ( 8.2) | 44 (33.3) |
Clinical Cut Off | 10 ( 7.5) | 4 ( 3.0) | 14 (10.6) |
Completion or Discontinuation | 13 ( 9.7) | 3 ( 2.2) | 16 (12.1) |
End of AE Reporting Period | 22 (16.4) | 4 ( 3.0) | 14 (10.6) |
Hazard ratio | 1.5 | 1.1 | |
95% confidence interval | [ 1.1, 1.9] | [ 0.8, 1.5] | |
p-value (one-sided stratified log rank) | 0.0208 | 0.4619 | |
Time to first serious adverse event (a) | |||
Median (years) | 0.39 | 0.37 | 0.26 |
95% confidence interval | [0.23, 0.60] | [0.25, 0.46] | [0.18, 0.34] |
Min, Max (b) | 0.00, 3.00* | 0.01, 3.00* | 0.00, 3.00* |
Source: ADTTE DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY | |||
Serious adverse events are defines as (…). All p-values are exploratory. (a) Product-limit (Kaplan-Meier) estimates. (b) Minimum and maximum of event times. * Denotes censoring. Hazard ratios are from a stratified Cox model of serious adverse event hazard rate, with terms for treatment groups and strata1. Ties were handled using the exact method. Hazard ratios of Placebo/ Combination over Drug X are presented, a HR < 1 denotes improvement compared to Drug X. |
4.3.6 tables
Code
resetSession(.kmState)
library(tables)
table_options(doCSS = TRUE)
<- formatters::ex_adae
ex_adae
<- table(adsl$ARM)
subject_counts
<- function(num, ARM) {
countpercentid <- length(unique(num))
n if (n == 0) pct <- 0
else pct <- 100*n/subject_counts[ARM[1]]
sprintf("%d (%.2f%%)",
length(unique(num)),
pct)
}
<- function(x, ARM) {
valuepercent sprintf("%d (%.2f%%)", x, 100*x/subject_counts[ARM] )
}
<- function(x) ""
blanks
<- function(x) sprintf("(N=%d)", length(x))
count
<- function(ARM) {
hazardratio <- paste0("TRT01A", ARM)
entry <- coef(cph)
coef if (entry %in% names(coef)) sprintf("%.1f", exp(coef[entry]))
else ""
}
<- function(ARM) {
hazardratioconfint <- paste0("TRT01A", ARM)
entry <- confint(cph)
confint if (entry %in% rownames(confint)) {
<- as.numeric(confint[entry,])
confint sprintf("(%.1f, %.1f)", exp(confint[1]), exp(confint[2]))
else ""
}
}
<- function(ARM) {
hazardpvalue if (ARM == "A: Drug X") ""
else {
<- c("A: Drug X", ARM)
twogroups <- survdiff(Surv(AVAL, CNSR==0) ~ TRT01A + STRATA1,
sdf data = adtte, subset = TRT01A %in% twogroups)
<- (1-pchisq(sdf$chisq, length(sdf$n)-1))/2
pval sprintf("%.4f", pval)
}
}
<- function(ARM) {
Median <- subset(surv_tbl, TRT01A == ARM)
vals sprintf("%.2f", vals$median)
}
<- function(ARM) {
minmaxevent <- subset(adtte, TRT01A == ARM)
vals sprintf("%.2f, %.2f", min(vals$AVAL), max(vals$AVAL))
}
<- function(ARM) {
eventCI <- subset(surv_tbl, TRT01A == ARM)
vals sprintf("[%.2f, %.2f]", vals$`0.95LCL`, vals$`0.95UCL`)
}
<- tabular(Heading("")*1*Heading("")*count ~
heading Heading()*ARM,
data = adsl)
<- tabular( Heading("Subjects with serious adverse events")*1*Heading("")*
part1 *Heading()*
events*Arguments(ARM = TRT01A) ~
valuepercentHeading()*TRT01A,
data = surv_tbl )
<- tabular( Heading("Number of censored subjects")*1*Factor(CNSDTDSC, "")*
part2 Heading()*countpercentid*Arguments(ARM = TRT01A)*
Heading()*USUBJID ~
Heading()*TRT01A,
data = subset(adtte, nchar(CNSDTDSC) > 0))
<- tabular( ( Heading("Hazard ratio")*1*Heading("")*hazardratio +
part3 Heading("95% confidence interval")*1*Heading("")*hazardratioconfint +
Heading("p-value (one-sided stratified log rank)")*1*Heading("")*hazardpvalue +
Heading("Time to first serious adverse event")*1*(
Heading("Median (years)")*Median +
Heading("95% confidence interval")*eventCI +
Heading("Min, Max")*minmaxevent))*
Heading()*as.character(TRT01A) ~
Heading()*TRT01A,
data = surv_tbl)
useGroupLabels(rbind(heading, part1, part2, part3),
indent = " ")
A: Drug X | B: Placebo | C: Combination | |
---|---|---|---|
(N=134) | (N=134) | (N=132) | |
Subjects with serious adverse events | 89 (66.42%) | 123 (91.79%) | 88 (66.67%) |
Number of censored subjects | |||
Clinical Cut Off | 10 (7.46%) | 4 (2.99%) | 14 (10.61%) |
Completion or Discontinuation | 13 (9.70%) | 3 (2.24%) | 16 (12.12%) |
End of AE Reporting Period | 22 (16.42%) | 4 (2.99%) | 14 (10.61%) |
Hazard ratio | 1.5 | 1.1 | |
95% confidence interval | (1.1, 1.9) | (0.8, 1.5) | |
p-value (one-sided stratified log rank) | 0.0208 | 0.4619 | |
Time to first serious adverse event | |||
Median (years) | 0.39 | 0.37 | 0.26 |
95% confidence interval | [0.23, 0.60] | [0.25, 0.46] | [0.18, 0.34] |
Min, Max | 0.00, 3.00 | 0.00, 3.00 | 0.00, 3.00 |
4.3.7 flextable
This is a situation where the code required to create a flextable directly
becomes too long or complex. In such case, it is more convenient to leverage
existing functions from other packages to generate a tabular object and then
convert it to a flextable using the as_flextable()
method. Here we reuse
the tables
objects created in the previous section.
Code
library(flextable)
rbind(part1, part2, part3) |>
as_flextable(spread_first_col = TRUE, add_tab = TRUE) |>
align(j = 1, part = "all", align = "left") |>
padding(padding = 4, part = "all") |>
add_header_row(
values = c("", fmt_header_n(subject_counts, newline = FALSE)),
top = FALSE
|>
) hline(i = 1, part = "header", border = fp_border_default(width = 0))
A: Drug X | B: Placebo | C: Combination | |
---|---|---|---|
(N=134) | (N=134) | (N=132) | |
Subjects with serious adverse events | 89 (66.42%) | 123 (91.79%) | 88 (66.67%) |
Number of censored subjects | |||
Clinical Cut Off | 10 (7.46%) | 4 (2.99%) | 14 (10.61%) |
Completion or Discontinuation | 13 (9.70%) | 3 (2.24%) | 16 (12.12%) |
End of AE Reporting Period | 22 (16.42%) | 4 (2.99%) | 14 (10.61%) |
Hazard ratio | 1.5 | 1.1 | |
95% confidence interval | (1.1, 1.9) | (0.8, 1.5) | |
p-value (one-sided stratified log rank) | 0.0208 | 0.4619 | |
Time to first serious adverse event | |||
Median (years) | 0.39 | 0.37 | 0.26 |
95% confidence interval | [0.23, 0.60] | [0.25, 0.46] | [0.18, 0.34] |
Min, Max | 0.00, 3.00 | 0.00, 3.00 | 0.00, 3.00 |
4.3.8 tidytlg
Code
resetSession(.kmState)
library(dplyr)
library(tidytlg)
library(broom)
library(stringr)
# Create analysis population counts
<- freq(adtte,
tbl1 rowvar = "SAFFL",
colvar = "TRT01A",
statlist = statlist("n"),
rowtext = "Analysis Set: Safety Population",
subset = SAFFL == "Y")
# Create counts (percentages) for subjects with SAE
<- freq(adtte,
tbl2 rowvar = "CNSR",
colvar = "TRT01A",
statlist = statlist("n (x.x%)"),
rowtext = "Number of subjects with serious adverse events, n(%)",
subset = CNSR == 0)
# Create counts (percentages) for subjects with SAE
<- freq(adtte,
tbl3a rowvar = "CNSR",
colvar = "TRT01A",
statlist = statlist("n (x.x%)"),
rowtext = "Number of censored subjects, n(%)",
subset = CNSR == 1)
<- freq(adtte,
tbl3b rowvar = "CNSDTDSC",
colvar = "TRT01A",
statlist = statlist("n (x.x%)"),
subset = CNSR == 1)
<- bind_rows(tbl3a, tbl3b)
tbl3
# CoxPH model
<- tidy(cph, exponentiate = TRUE, conf.int = TRUE, conf.level = 0.95) %>%
coxmod filter(str_detect(term, "TRT01A")) %>%
mutate(term = str_remove(term, "TRT01A"))
<- coxmod %>%
tbl4a mutate(hr = roundSAS(estimate, digits = 2, as_char = TRUE)) %>%
select(term, hr) %>%
pivot_wider(names_from = "term", values_from = "hr") %>%
mutate(label = "Hazard ratio",
row_type = "HEADER")
<- coxmod %>%
tbl4b mutate(across(c(conf.low, conf.high), ~roundSAS(.x, digits = 2)),
ci = paste0("(", conf.low, ", ", conf.high, ")")) %>%
select(term, ci) %>%
pivot_wider(names_from = "term", values_from = "ci") %>%
mutate(label = "95% Confidence Interval",
row_type = "VALUE")
<- bind_rows(tbl4a, tbl4b) %>%
tbl4 mutate(group_level = 0)
# Logrank test
<- purrr::map_df(.x = list(c("A: Drug X", "B: Placebo"),
log_rank_test c("A: Drug X", "C: Combination")),
.f = ~{sdf <- survdiff(Surv(AVAL, CNSR==0) ~ TRT01A + STRATA1,
data = adtte %>% dplyr::filter(TRT01A %in% .x));
data.frame(TRT01A = .x[2],
pval = (1-pchisq(sdf$chisq, length(sdf$n)-1))/2)})
<- log_rank_test %>%
tbl5 mutate(pval = roundSAS(pval, digits = 3, as_char = TRUE)) %>%
pivot_wider(names_from = "TRT01A", values_from = "pval") %>%
mutate(label = "p-value (one-sided stratified log rank)",
row_type = "HEADER",
group_level = 0)
# surv time stats
<- surv_tbl %>%
tbl6a mutate(median = roundSAS(median, digits = 2, as_char = TRUE)) %>%
select(TRT01A, median) %>%
pivot_wider(names_from = "TRT01A", values_from = "median") %>%
mutate(label = "Median (years)",
row_type = "VALUE") %>%
add_row(label = "Time to first serious adverse event (1)", row_type = "HEADER", .before = 1)
<- surv_tbl %>%
tbl6b mutate(across(c(`0.95LCL`, `0.95UCL`), ~roundSAS(.x, digits = 2, as_char = TRUE)),
ci = paste0("(", `0.95LCL`, ", ", `0.95UCL`, ")")) %>%
select(TRT01A, ci) %>%
pivot_wider(names_from = "TRT01A", values_from = "ci") %>%
mutate(label = "95% Confidence Interval",
row_type = "VALUE")
<- adtte %>%
tbl6c filter(!(AVAL == 0 & CNSR == 1)) %>%
group_by(TRT01A) %>%
mutate(max_cnsr = !is.na(AVAL) & AVAL == max(AVAL, na.rm = TRUE) & CNSR == 1) %>%
summarise(
min = min(AVAL, na.rm = TRUE),
max = max(AVAL, na.rm = TRUE),
is_censored = sum(max_cnsr) > 0) %>%
mutate(across(c(min, max), ~roundSAS(.x, digits = 2, as_char = TRUE)),
min_max = ifelse(is_censored, paste0("(", min, ", ", max, "*)"),
paste0("(", min, ", ", max, ")"))) %>%
select(TRT01A, min_max) %>%
pivot_wider(names_from = "TRT01A", values_from = "min_max") %>%
mutate(label = "Min - Max (2)",
row_type = "VALUE")
<- bind_rows(tbl6a, tbl6b, tbl6c) %>%
tbl6 mutate(group_level = 0)
# combine analysis results together
<- bind_table(tbl1, tbl2, tbl3, tbl4, tbl5, tbl6)
tbl
# output the analysis results
gentlg(huxme = tbl,
format = "HTML",
print.hux = FALSE,
file = "Table x.x.x.x",
orientation = "portrait",
title = "Time to First Serious Adverse Event",
footers = c("(1) Product-limit (Kaplan-Meier) estimates.",
"(2) * indicates censoring",
"Serious adverse events are defines as (...). All p-values are exploratory.",
"Hazard ratios are from a stratified Cox model of serious adverse event hazard rate,
with terms for treatment groups and strata1. Ties were handled using the exact
method. Hazard ratios of Placebo Combination over Drug X are presented, an
HR < 1 denotes improvement compared to Drug X.",
"Source: ADTTE DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY"),
colheader = c("","A: Drug X","B: Placebo","C: Combination"))
Table x.x.x.x: Time to First Serious Adverse Event | |||
A: Drug X | B: Placebo | C: Combination | |
---|---|---|---|
Analysis Set: Safety Population | 134 | 134 | 132 |
Number of subjects with serious adverse events, n(%) | 89 (66.4%) | 123 (91.8%) | 88 (66.7%) |
Number of censored subjects, n(%) | 45 (33.6%) | 11 (8.2%) | 44 (33.3%) |
Clinical Cut Off | 10 (7.5%) | 4 (3.0%) | 14 (10.6%) |
Completion or Discontinuation | 13 (9.7%) | 3 (2.2%) | 16 (12.1%) |
End of AE Reporting Period | 22 (16.4%) | 4 (3.0%) | 14 (10.6%) |
Hazard ratio | 1.46 | 1.09 | |
95% Confidence Interval | (1.11, 1.92) | (0.81, 1.47) | |
p-value (one-sided stratified log rank) | 0.021 | 0.462 | |
Time to first serious adverse event (1) | |||
Median (years) | 0.39 | 0.37 | 0.26 |
95% Confidence Interval | (0.23, 0.60) | (0.25, 0.46) | (0.18, 0.34) |
Min - Max (2) | (0.00, 3.00*) | (0.01, 3.00*) | (0.00, 3.00*) |
(1) Product-limit (Kaplan-Meier) estimates. | |||
(2) * indicates censoring | |||
Serious adverse events are defines as (...). All p-values are exploratory. | |||
Hazard ratios are from a stratified Cox model of serious adverse event hazard rate, with terms for treatment groups and strata1. Ties were handled using the exact method. Hazard ratios of Placebo Combination over Drug X are presented, an HR < 1 denotes improvement compared to Drug X. | |||
Source: ADTTE DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY | |||
[table x.x.x.x.html][/home/runner/work/_temp/dbc50335-555d-4c9d-8c49-eaade0bcc058] 03NOV2023, 00:16 |
4.3.9 tfrmt
This first code chunk cleans up the data from the models to prepare it for going into a table.
Code
library(tidyverse)
library(broom)
<- surv_tbl |>
big_n ::select(N = n.max, TRT01A)
dplyr
# Number of subjects with a serious AE
<- surv_tbl |> # Calculated above
sae_n ::mutate(pct = events/n.max,
dplyrgroup = "Number of subjects with serious adverse event, n (%)",
label = "Number of subjects with serious adverse event, n (%)",
ord1 = 1 ) |>
::select(TRT01A, n = events, pct, group, label, ord1) |>
dplyr::pivot_longer(c("n", "pct"))
tidyr
# Count the number of censored subjects
<- adtte |>
adtte_with_N ::left_join(big_n, by = "TRT01A")
dplyr
<- adtte_with_N |>
cnsr_subjs ::filter(CNSR == "1")
dplyr
<- cnsr_subjs |>
tot_cnsr_subj ::group_by(TRT01A) |>
dplyr::reframe(
dplyrn = n_distinct(USUBJID),
pct = n/N
|>
) ::distinct() |>
dplyr::pivot_longer(c("n", "pct")) |>
tidyr::mutate(
dplyrgroup = "Number of censored subjects, n (%)",
label = "Number of censored subjects, n (%)",
ord1 = 2
)
<- cnsr_subjs |>
sub_cnsr_subj ::group_by(TRT01A, CNSDTDSC) |>
dplyr::reframe(
dplyrn = n_distinct(USUBJID),
pct = n/N
|>
) ::distinct() |>
dplyr::pivot_longer(c("n", "pct")) |>
tidyr::mutate(
dplyrgroup = "Number of censored subjects, n (%)",
ord1 = 2
|>
) ::rename(label = CNSDTDSC)
dplyr
# Information from the CPH model
<- broom::tidy(cph, conf.int = TRUE) |>
hzr mutate(across(c("estimate", "conf.low", "conf.high"), exp)) |>
::filter(stringr::str_detect(term, "TRT01A")) |>
dplyr::select(term, estimate, conf.low, conf.high) |>
dplyr::pivot_longer(c("estimate", "conf.low", "conf.high")) |>
tidyr::mutate(group = "Hazard ratio",
dplyrlabel = case_when(
== "estimate" ~ "Hazard ratio",
name TRUE ~ "95% confidence interval"
),TRT01A = case_when(
::str_detect(term, "Placebo") ~ "B: Placebo",
stringr::str_detect(term, "Combination") ~ "C: Combination"
stringr
),ord1 = 3) |>
::select(-term)
dplyr
# Get one-sided p-value from survival model
<- list(c("A: Drug X", "B: Placebo"), c("A: Drug X", "C: Combination")) |>
p_vals map_dfr(function(comparison){
survdiff(Surv(AVAL, CNSR == 0) ~ TRT01A + STRATA1, data = adtte |>
::filter(TRT01A %in% comparison)) |>
dplyr::glance() |>
broom::mutate(TRT01A = comparison[2])
dplyr|>
}) ::select(value = p.value, TRT01A) |>
dplyr::mutate(
dplyrname = "p.value",
group = "p-value (one-sided stratified log rank)",
label = "p-value (one-sided stratified log rank)",
ord1 = 5
)
# Time to event from model
<- surv_tbl |>
time_to_event ::select(TRT01A, median, LCL = `0.95LCL`, UCL=`0.95UCL`) |>
dplyr::pivot_longer(c("median", "LCL", "UCL")) |>
tidyr::mutate(
dplyrgroup = "Time to first serious adverse event",
label = case_when(
== "median" ~ "Median (years)",
name TRUE ~ "95% confidence interval"
),ord1 = 6
)
<- adtte |>
range ::group_by(TRT01A) |>
dplyr::summarise(
dplyrmin = min(AVAL),
max = max(AVAL)
|>
) ::mutate(group = "Time to first serious adverse event",
dplyrlabel = "Min, Max",
ord1 = 6)|>
::pivot_longer(c("min", "max"))
tidyr
<- bind_rows(
model_ard
sae_n,
tot_cnsr_subj,
sub_cnsr_subj,
hzr,
p_vals,
time_to_event,
range )
We now format this information into a table.
Code
library(tfrmt)
tfrmt(
column = TRT01A,
group = "group",
label = "label",
param = "name",
value = "value",
sorting_cols = "ord1",
body_plan = body_plan(
frmt_structure(group_val = ".default", label_val = ".default",
frmt_combine("{n} ({pct})",
n = frmt("xx"),
pct = frmt("xx%", transform = ~.*100))
),frmt_structure(group_val = "Hazard ratio", label_val = ".default",
frmt_combine("[{conf.low}, {conf.high}]",
frmt("x.x"))),
frmt_structure(group_val = ".default", label_val = "Hazard ratio", frmt("x.x")),
frmt_structure(group_val = ".default", label_val = "p-value (one-sided stratified log rank)", frmt("x.xxxx")),
frmt_structure(group_val = ".default", label_val = "Median (years)", frmt("x.xx")),
frmt_structure(group_val = "Time to first serious adverse event", label_val = "95% confidence interval",
frmt_combine("[{LCL}, {UCL}]",
frmt("x.xx"))),
frmt_structure(group_val = ".default", label_val = "Min, Max",
frmt_combine("[{min}, {max}*]",
frmt("x.xx")))
), col_plan = col_plan(-ord1),
footnote_plan = footnote_plan(
footnote_structure("Serious adverse events are defines as (...). All p-values are exploratory.
Hazard ratios are from a stratified Cox model of serious adverse event hazard rate, with terms for treatment groups and strata1. Ties were handled using the exact method. Hazard ratios of Placebo/ Combination over Drug X are presented, a HR < 1 denotes improvement compared to Drug X."),
footnote_structure(group_val = "Time to first serious adverse event",
"Product-limit (Kaplan-Meier) estimates"),
footnote_structure(group_val = "Time to first serious adverse event",
label_val = "Min, Max", "Minimum and maximum of event times. * Denotes censoring")
)|>
) print_to_gt(model_ard)
A: Drug X | B: Placebo | C: Combination | |
---|---|---|---|
Number of subjects with serious adverse event, n (%) | 89 (66%) | 123 (92%) | 88 (67%) |
Number of censored subjects, n (%) | 45 (34%) | 11 ( 8%) | 44 (33%) |
Clinical Cut Off | 10 ( 7%) | 4 ( 3%) | 14 (11%) |
Completion or Discontinuation | 13 (10%) | 3 ( 2%) | 16 (12%) |
End of AE Reporting Period | 22 (16%) | 4 ( 3%) | 14 (11%) |
Hazard ratio | 1.5 | 1.1 | |
95% confidence interval | [1.1, 1.9] | [0.8, 1.5] | |
p-value (one-sided stratified log rank) | 0.0416 | 0.9239 | |
Time to first serious adverse event1 | |||
Median (years) | 0.39 | 0.37 | 0.26 |
95% confidence interval | [0.23, 0.60] | [0.25, 0.46] | [0.18, 0.34] |
Min, Max2 | [0.00, 3.00*] | [0.01, 3.00*] | [0.00, 3.00*] |
Serious adverse events are defines as (...). All p-values are exploratory. Hazard ratios are from a stratified Cox model of serious adverse event hazard rate, with terms for treatment groups and strata1. Ties were handled using the exact method. Hazard ratios of Placebo/ Combination over Drug X are presented, a HR < 1 denotes improvement compared to Drug X. | |||
1 Product-limit (Kaplan-Meier) estimates | |||
2 Minimum and maximum of event times. * Denotes censoring |
4.4 Concomitant Medications
4.4.1 rtables
Code
resetSession()
library(rtables)
data("cadcm", package = "random.cdisc.data")
data("cadsl", package = "random.cdisc.data")
<- function(label = NULL) {
one_count_pct_gen function(x, .N_col) {
<- rcell(length(unique(x)) * c(1, 1/.N_col),
ret format = "xx (xx.x%)")
if(!is.null(label))
obj_label(ret) <- label
ret
}
}
<- basic_table(title = "Conmed Example",
lyt subtitles = "Uses the adcm dataset from random.cdisc.data",
show_colcounts = TRUE) |>
split_cols_by("ARM") |>
analyze("USUBJID", afun = one_count_pct_gen("At Least One Concomittant Med")) |>
split_rows_by("CMCLAS", split_fun = trim_levels_in_group("CMTRT")) |>
analyze("CMTRT", afun = function(df, .N_col) {
<- df$CMTRT
cmtrtvec <- split(df$USUBJID, cmtrtvec)
spl_usubj <- one_count_pct_gen()
fn <- lapply(spl_usubj, fn, .N_col = .N_col)
cells names(cells) <- names(spl_usubj)
in_rows(.list = cells)
})
build_table(lyt, cadcm, alt_counts_df = cadsl)
Conmed Example
Uses the adcm dataset from random.cdisc.data
——————————————————————————————————————————————————————————————————————————
A: Drug X B: Placebo C: Combination
(N=134) (N=134) (N=132)
——————————————————————————————————————————————————————————————————————————
At Least One Concomittant Med 122 (91.0%) 123 (91.8%) 120 (90.9%)
medcl A
A_1/3 54 (40.3%) 49 (36.6%) 69 (52.3%)
A_2/3 53 (39.6%) 50 (37.3%) 56 (42.4%)
A_3/3 45 (33.6%) 54 (40.3%) 48 (36.4%)
medcl B
B_1/4 52 (38.8%) 57 (42.5%) 59 (44.7%)
B_2/4 52 (38.8%) 55 (41.0%) 56 (42.4%)
B_3/4 47 (35.1%) 47 (35.1%) 52 (39.4%)
B_4/4 50 (37.3%) 45 (33.6%) 55 (41.7%)
medcl C
C_1/2 51 (38.1%) 50 (37.3%) 56 (42.4%)
C_2/2 52 (38.8%) 58 (43.3%) 60 (45.5%)
4.4.2 tern (+ rtables)
Code
library(tern)
<- basic_table(show_colcounts = TRUE) |>
lyt split_cols_by(var = "ARM") |>
analyze_num_patients(vars = "USUBJID",
.stats = "unique",
.labels = "At Least One Concomittant Med") |>
split_rows_by("CMCLAS",
split_fun = drop_split_levels) |>
count_occurrences(vars = "CMDECOD")
build_table(lyt = lyt, df = cadcm, alt_counts_df = cadsl)
A: Drug X B: Placebo C: Combination
(N=134) (N=134) (N=132)
——————————————————————————————————————————————————————————————————————————
At Least One Concomittant Med 122 (91.0%) 123 (91.8%) 120 (90.9%)
medcl A
medname A_1/3 54 (40.3%) 49 (36.6%) 69 (52.3%)
medname A_2/3 53 (39.6%) 50 (37.3%) 56 (42.4%)
medname A_3/3 45 (33.6%) 54 (40.3%) 48 (36.4%)
medcl B
medname B_1/4 52 (38.8%) 57 (42.5%) 59 (44.7%)
medname B_2/4 52 (38.8%) 55 (41.0%) 56 (42.4%)
medname B_3/4 47 (35.1%) 47 (35.1%) 52 (39.4%)
medname B_4/4 50 (37.3%) 45 (33.6%) 55 (41.7%)
medcl C
medname C_1/2 51 (38.1%) 50 (37.3%) 56 (42.4%)
medname C_2/2 52 (38.8%) 58 (43.3%) 60 (45.5%)
4.4.3 flextable
This is again a situation where the code required to create a flextable directly
requires too much data preparation. In the following example, we convert the
‘rtables’ object to a flextable using the as_flextable()
method and then we
change its aspect.
Code
library(flextable)
tt_to_flextable(build_table(lyt, cadcm, alt_counts_df = cadsl)) |>
theme_booktabs() |>
font(fontname = "Open Sans") |>
bold(i = ~ V2 %in% "", j = 1, bold = TRUE) |>
bold(i = 1, j = 1, bold = TRUE) |>
align(j = 2:4, align = "center", part = "all") |>
set_table_properties(layout = "fixed") |>
autofit() |>
mk_par(i = 1, j = 1, part = "header",
as_paragraph(as_chunk("Conmed Example", props = fp_text_default(font.size = 14)))) |>
mk_par(i = 2, j = 1, part = "header",
as_paragraph("Uses the adcm dataset from ", as_b("random.cdisc.data")))
Conmed Example | A: Drug X | B: Placebo | C: Combination |
---|---|---|---|
Uses the adcm dataset from random.cdisc.data | (N=134) | (N=134) | (N=132) |
At Least One Concomittant Med | 122 (91.0%) | 123 (91.8%) | 120 (90.9%) |
medcl A | |||
medname A_1/3 | 54 (40.3%) | 49 (36.6%) | 69 (52.3%) |
medname A_2/3 | 53 (39.6%) | 50 (37.3%) | 56 (42.4%) |
medname A_3/3 | 45 (33.6%) | 54 (40.3%) | 48 (36.4%) |
medcl B | |||
medname B_1/4 | 52 (38.8%) | 57 (42.5%) | 59 (44.7%) |
medname B_2/4 | 52 (38.8%) | 55 (41.0%) | 56 (42.4%) |
medname B_3/4 | 47 (35.1%) | 47 (35.1%) | 52 (39.4%) |
medname B_4/4 | 50 (37.3%) | 45 (33.6%) | 55 (41.7%) |
medcl C | |||
medname C_1/2 | 51 (38.1%) | 50 (37.3%) | 56 (42.4%) |
medname C_2/2 | 52 (38.8%) | 58 (43.3%) | 60 (45.5%) |
4.4.4 gt
Code
resetSession()
library(dplyr)
library(tidyr)
library(gt)
data("cadcm", package = "random.cdisc.data")
data("cadsl", package = "random.cdisc.data")
<- c("Number of sujects with any concomitant medication", levels(cadcm$CMDECOD))
cmdecod_levels <- c(NA, levels(cadcm$CMCLAS))
cmclas_levels
<- cadcm |>
adcm ::select(CMDECOD, CMCLAS, TRT01A) |>
dplyr::mutate(
dplyrCMDECOD = factor(CMDECOD, levels = cmdecod_levels),
CMCLAS = factor(CMCLAS, levels = cmclas_levels)
)
<- cadcm |>
ct_cm ::summarize(
dplyrn = dplyr::n_distinct(USUBJID),
.by = TRT01A
|>
) ::left_join(count(cadsl, TRT01A, name = "nall"), by = "TRT01A") |>
dplyr::mutate(
dplyrpct = n / nall, nall = NULL,
CMDECOD = factor("Number of sujects with any concomitant medication", levels = cmdecod_levels)
)
<- cadcm |>
ct_adcm ::summarize(
dplyrn = dplyr::n_distinct(USUBJID),
.by = c(TRT01A, CMCLAS, CMDECOD)
|>
) ::left_join(count(cadsl, TRT01A, name = "nall"), by = "TRT01A") |>
dplyr::mutate(pct = n / nall, nall = NULL)
dplyr
<- dplyr::bind_rows(ct_cm, ct_adcm) |>
gt_adcm ::pivot_wider(id_cols = c(CMCLAS, CMDECOD), names_from = TRT01A, values_from = c(n, pct))
tidyr
<- cadsl |>
trt_n ::filter(SAFFL == "Y") |>
dplyr::summarize(
dplyrn = sprintf("%s \n(N=%i)", unique(TRT01A), dplyr::n()),
.by = TRT01A
)
<- as.list(trt_n$n)
header_n names(header_n) <- paste("n", dplyr::pull(trt_n, TRT01A), sep = "_")
|>
gt_adcm gt(rowname_col = "CMDECOD") |>
tab_header(
title = "Conmed Example",
subtitle = md("Uses the *adcm* dataset from **random.cdisc.data**")
|>
) opt_align_table_header(align = "left") |>
fmt_percent(columns = dplyr::starts_with("pct_"), decimals = 1) |>
cols_merge_n_pct(col_n = "n_A: Drug X", col_pct = "pct_A: Drug X") |>
cols_merge_n_pct(col_n = "n_B: Placebo", col_pct = "pct_B: Placebo") |>
cols_merge_n_pct(col_n = "n_C: Combination", col_pct = "pct_C: Combination") |>
tab_row_group(
label = "medcl A",
rows = CMCLAS == "medcl A"
|>
) tab_row_group(
label = "medcl B",
rows = CMCLAS == "medcl B"
|>
) tab_row_group(
label = "medcl C",
rows = CMCLAS == "medcl C"
|>
) row_group_order(
groups = c(NA, paste("medcl", LETTERS[1:2]))
|>
) cols_hide(CMCLAS) |>
cols_label(
.list = header_n,
.fn = md
|>
) cols_width(
1 ~ px(500),
everything() ~ px(150)
|>
) cols_align(
align = "center",
columns = everything()
|>
) cols_align(
align = "left",
columns = 1
)
Conmed Example | |||
Uses the adcm dataset from random.cdisc.data | |||
A: Drug X (N=134) |
C: Combination (N=132) |
B: Placebo (N=134) |
|
---|---|---|---|
Number of sujects with any concomitant medication | 122 (91.0%) | 120 (90.9%) | 123 (91.8%) |
medcl A | |||
medname A_2/3 | 53 (39.6%) | 56 (42.4%) | 50 (37.3%) |
medname A_3/3 | 45 (33.6%) | 48 (36.4%) | 54 (40.3%) |
medname A_1/3 | 54 (40.3%) | 69 (52.3%) | 49 (36.6%) |
medcl B | |||
medname B_1/4 | 52 (38.8%) | 59 (44.7%) | 57 (42.5%) |
medname B_4/4 | 50 (37.3%) | 55 (41.7%) | 45 (33.6%) |
medname B_2/4 | 52 (38.8%) | 56 (42.4%) | 55 (41.0%) |
medname B_3/4 | 47 (35.1%) | 52 (39.4%) | 47 (35.1%) |
medcl C | |||
medname C_1/2 | 51 (38.1%) | 56 (42.4%) | 50 (37.3%) |
medname C_2/2 | 52 (38.8%) | 60 (45.5%) | 58 (43.3%) |
4.4.5 tables
Code
resetSession()
data("cadcm", package = "random.cdisc.data")
library(tables)
table_options(doCSS = TRUE)
<- table(adsl$ARM)
subject_counts
<- function(num, ARM) {
countpercentid <- length(unique(num))
n if (n == 0) pct <- 0
else pct <- 100*n/subject_counts[ARM[1]]
sprintf("%d (%.2f%%)",
length(unique(num)),
pct)
}
<- function(x) sprintf("(N=%d)", length(x))
count
<- tabular(Heading("")*1*Heading("")*count ~
heading Heading()*ARM,
data = adsl)
<- tabular( (Heading("Any concomitant medication")*1*Heading("")*1 +
body Heading()*CMCLAS*
Heading()*CMDECOD*DropEmpty(which = "row"))*
Heading()*countpercentid*Arguments(ARM = TRT01A)*
Heading()*USUBJID ~
Heading()*TRT01A,
data = cadcm)
useGroupLabels(rbind(heading, body), indent = " ")
A: Drug X | B: Placebo | C: Combination | |
---|---|---|---|
(N=134) | (N=134) | (N=132) | |
Any concomitant medication | 122 (91.04%) | 123 (91.79%) | 120 (90.91%) |
medcl A | |||
medname A_1/3 | 54 (40.30%) | 49 (36.57%) | 69 (52.27%) |
medname A_2/3 | 53 (39.55%) | 50 (37.31%) | 56 (42.42%) |
medname A_3/3 | 45 (33.58%) | 54 (40.30%) | 48 (36.36%) |
medcl B | |||
medname B_1/4 | 52 (38.81%) | 57 (42.54%) | 59 (44.70%) |
medname B_2/4 | 52 (38.81%) | 55 (41.04%) | 56 (42.42%) |
medname B_3/4 | 47 (35.07%) | 47 (35.07%) | 52 (39.39%) |
medname B_4/4 | 50 (37.31%) | 45 (33.58%) | 55 (41.67%) |
medcl C | |||
medname C_1/2 | 51 (38.06%) | 50 (37.31%) | 56 (42.42%) |
medname C_2/2 | 52 (38.81%) | 58 (43.28%) | 60 (45.45%) |
4.4.6 tidytlg
Code
resetSession()
library(dplyr)
library(tidytlg)
data("cadcm", package = "random.cdisc.data")
data("cadsl", package = "random.cdisc.data")
<- cadsl
adsl
<- cadcm %>%
adcm filter(SAFFL == "Y") %>%
mutate(CMFL = "Y")
# Create analysis population counts
<- freq(adsl,
tbl1 rowvar = "SAFFL",
colvar = "ARM",
statlist = statlist("n"),
rowtext = "Analysis Set: Safety Population",
subset = SAFFL == "Y")
# Create counts (percentages) for patients with any ConMed
<- freq(adcm,
tbl2 denom_df = adsl,
rowvar = "CMFL",
colvar = "ARM",
statlist = statlist("n (x.x%)"),
rowtext = "Number of subjects with any concomitant medication",
subset = CMFL == "Y")
# Create counts (percentages) by CMCLAS and CMDECOD
<- nested_freq(adcm,
tbl3 denom_df = adsl,
rowvar = "CMCLAS*CMDECOD",
colvar = "ARM",
statlist = statlist("n (x.x%)"))
# combine analysis results together
<- bind_table(tbl1, tbl2, tbl3) %>%
tbl select(-CMCLAS)
# output the analysis results
gentlg(huxme = tbl,
format = "HTML",
print.hux = FALSE,
file = "Table x.x.x.x",
orientation = "portrait",
title = "Conmed Example Uses the ‘adcm’ dataset from ‘random.cdisc.data’",
colheader = c("","A: Drug X","B: Placebo","C: Combination"))
Table x.x.x.x: Conmed Example Uses the ‘adcm’ dataset from ‘random.cdisc.data’ | |||
A: Drug X | B: Placebo | C: Combination | |
---|---|---|---|
Analysis Set: Safety Population | 134 | 134 | 132 |
Number of subjects with any concomitant medication | 122 (91.0%) | 123 (91.8%) | 120 (90.9%) |
medcl A | 97 (72.4%) | 98 (73.1%) | 102 (77.3%) |
medname A_1/3 | 54 (40.3%) | 49 (36.6%) | 69 (52.3%) |
medname A_2/3 | 53 (39.6%) | 50 (37.3%) | 56 (42.4%) |
medname A_3/3 | 45 (33.6%) | 54 (40.3%) | 48 (36.4%) |
medcl B | 102 (76.1%) | 101 (75.4%) | 108 (81.8%) |
medname B_1/4 | 52 (38.8%) | 57 (42.5%) | 59 (44.7%) |
medname B_2/4 | 52 (38.8%) | 55 (41.0%) | 56 (42.4%) |
medname B_3/4 | 47 (35.1%) | 47 (35.1%) | 52 (39.4%) |
medname B_4/4 | 50 (37.3%) | 45 (33.6%) | 55 (41.7%) |
medcl C | 82 (61.2%) | 84 (62.7%) | 89 (67.4%) |
medname C_1/2 | 51 (38.1%) | 50 (37.3%) | 56 (42.4%) |
medname C_2/2 | 52 (38.8%) | 58 (43.3%) | 60 (45.5%) |
[table x.x.x.x.html][/home/runner/work/_temp/dbc50335-555d-4c9d-8c49-eaade0bcc058] 03NOV2023, 00:16 |
4.4.7 tfrmt
Rather than starting with an ADaM, tfrmt assumes users will start with an ARD (Analysis Results Dataset), because of this, making this table will be split into two parts, first to make the ARD and second to format the table.
Code
resetSession()
library(tidyverse)
library(tfrmt)
## Create ARD
data("cadcm", package = "random.cdisc.data")
data("cadsl", package = "random.cdisc.data")
<- cadsl |>
big_n ::group_by(ARM) |>
dplyr::summarize(
dplyrN = dplyr::n_distinct(USUBJID)
)
<- cadcm |>
adcm_with_N left_join(big_n, by= "ARM")
<- adcm_with_N |>
overall ::group_by(ARM) |>
dplyr::reframe(
dplyrn_subj = n_distinct(USUBJID),
pct_subj = n_subj/N
|>
) ::distinct() |>
dplyr::mutate(CMCLAS = "At Least One Concomittant Med",
dplyrCMDECOD = CMCLAS)
<- adcm_with_N |>
med_lvl ::group_by(ARM,CMDECOD, CMCLAS) |>
dplyr::reframe(
dplyrn_subj = dplyr::n_distinct(USUBJID),
pct_subj = n_subj/N
|>
) distinct()
<- big_n |>
label_N ::rename(value = N) |>
dplyr::mutate(name = "header_n")
dplyr
<- bind_rows(overall, med_lvl) |>
cm_ard pivot_longer(ends_with("subj")) |>
bind_rows(label_N)
## Format Table
tfrmt(
column = ARM,
group = c("CMCLAS"),
param = name,
value = value,
label = CMDECOD,
|>
) # Then we cam combine it with an n percent template
tfrmt_n_pct(n = "n_subj",
pct = "pct_subj",
pct_frmt_when = frmt_when("==1" ~ "",
">.99" ~ "(>99%)",
"==0" ~ "",
"<.01" ~ "(<1%)",
"TRUE" ~ frmt("(xx.x%)", transform = ~.*100))
|>
) #Finally we are going to add some additional formatting
tfrmt(
big_n = big_n_structure("header_n"),
# Aligning on decimal places and spaces
col_style_plan = col_style_plan(
col_style_structure(col = matches("[A-Z]:.*"),
align = c(".", " "))
)|>
) print_to_gt(cm_ard)
A: Drug X N = 134 | B: Placebo N = 134 | C: Combination N = 132 | |
---|---|---|---|
At Least One Concomittant Med | 122 (91.0%) | 123 (91.8%) | 120 (90.9%) |
medcl A | |||
medname A_1/3 | 54 (40.3%) | 49 (36.6%) | 69 (52.3%) |
medname A_2/3 | 53 (39.6%) | 50 (37.3%) | 56 (42.4%) |
medname A_3/3 | 45 (33.6%) | 54 (40.3%) | 48 (36.4%) |
medcl B | |||
medname B_1/4 | 52 (38.8%) | 57 (42.5%) | 59 (44.7%) |
medname B_2/4 | 52 (38.8%) | 55 (41.0%) | 56 (42.4%) |
medname B_3/4 | 47 (35.1%) | 47 (35.1%) | 52 (39.4%) |
medname B_4/4 | 50 (37.3%) | 45 (33.6%) | 55 (41.7%) |
medcl C | |||
medname C_1/2 | 51 (38.1%) | 50 (37.3%) | 56 (42.4%) |
medname C_2/2 | 52 (38.8%) | 58 (43.3%) | 60 (45.5%) |
4.5 Disposition
4.5.1 rtables
Code
resetSession()
library(dplyr)
library(rtables)
data("cadsl", package = "random.cdisc.data")
<- cadsl |>
adsl select(USUBJID, TRT01A, EOSSTT, DCSREAS, DTHCAUS)
<- function(x, .N_col) {
top_afun in_rows(Completed = rcell(sum(x=="COMPLETED") * c(1, 1/.N_col), format = c("xx (xx.x%)")),
Ongoing = rcell(sum(x=="ONGOING") * c(1, 1/.N_col), format = c("xx (xx.x%)")))
}
<- function(x, .N_col) {
count_pct_afun <- table(x)
tbl <- lapply(tbl, function(xi) rcell(xi * c(1, 1/.N_col), format = c("xx (xx.x%)")))
lst in_rows(.list = lst, .names = names(tbl))
}
<- basic_table(show_colcounts = TRUE) |>
lyt split_cols_by("TRT01A") |>
analyze("EOSSTT", top_afun) |>
split_rows_by("EOSSTT", split_fun = keep_split_levels("DISCONTINUED")) |>
analyze("DCSREAS", count_pct_afun) |>
split_rows_by("DCSREAS", split_fun = keep_split_levels("DEATH")) |>
analyze("DTHCAUS", count_pct_afun)
build_table(lyt, adsl)
A: Drug X B: Placebo C: Combination
(N=134) (N=134) (N=132)
——————————————————————————————————————————————————————————————————————————
Completed 68 (50.7%) 66 (49.3%) 73 (55.3%)
Ongoing 24 (17.9%) 28 (20.9%) 21 (15.9%)
DISCONTINUED
ADVERSE EVENT 3 (2.2%) 6 (4.5%) 5 (3.8%)
DEATH 25 (18.7%) 23 (17.2%) 22 (16.7%)
LACK OF EFFICACY 2 (1.5%) 2 (1.5%) 3 (2.3%)
PHYSICIAN DECISION 2 (1.5%) 3 (2.2%) 2 (1.5%)
PROTOCOL VIOLATION 5 (3.7%) 3 (2.2%) 4 (3.0%)
WITHDRAWAL BY PARENT/GUARDIAN 4 (3.0%) 2 (1.5%) 1 (0.8%)
WITHDRAWAL BY SUBJECT 1 (0.7%) 1 (0.7%) 1 (0.8%)
DEATH
ADVERSE EVENT 9 (6.7%) 7 (5.2%) 10 (7.6%)
DISEASE PROGRESSION 8 (6.0%) 6 (4.5%) 6 (4.5%)
LOST TO FOLLOW UP 2 (1.5%) 2 (1.5%) 2 (1.5%)
MISSING 2 (1.5%) 3 (2.2%) 2 (1.5%)
Post-study reporting of death 1 (0.7%) 2 (1.5%) 1 (0.8%)
SUICIDE 2 (1.5%) 2 (1.5%) 1 (0.8%)
UNKNOWN 1 (0.7%) 1 (0.7%) 0 (0.0%)
4.5.2 tern (+ rtables)
tern makes slightly different formatting choices (2 decimals for the percents of completed and ongoing study counts, and not displaying the percent when a cell count is 0), but we can see the table structure and cell values are the same.
Code
library(tern)
<- basic_table(show_colcounts = TRUE) |>
lyt split_cols_by("TRT01A") |>
count_values("EOSSTT",
values = "COMPLETED",
table_names = "Completed",
.labels = c(count_fraction = "Completed Study")) |>
count_values("EOSSTT",
values = "ONGOING",
table_names = "Ongoing",
.labels = c(count_fraction = "Ongoing Study")) |>
split_rows_by("EOSSTT",
split_fun = keep_split_levels("DISCONTINUED")) |>
summarize_vars("DCSREAS",
.stats = "count_fraction",
denom = "N_col") |>
split_rows_by("DCSREAS",
split_fun = keep_split_levels("DEATH")) |>
summarize_vars("DTHCAUS",
.stats = "count_fraction",
denom = "N_col")
build_table(lyt = lyt, df = adsl)
A: Drug X B: Placebo C: Combination
(N=134) (N=134) (N=132)
————————————————————————————————————————————————————————————————————————————
Completed Study 68 (50.75%) 66 (49.25%) 73 (55.30%)
Ongoing Study 24 (17.91%) 28 (20.90%) 21 (15.91%)
DISCONTINUED
ADVERSE EVENT 3 (2.2%) 6 (4.5%) 5 (3.8%)
DEATH 25 (18.7%) 23 (17.2%) 22 (16.7%)
LACK OF EFFICACY 2 (1.5%) 2 (1.5%) 3 (2.3%)
PHYSICIAN DECISION 2 (1.5%) 3 (2.2%) 2 (1.5%)
PROTOCOL VIOLATION 5 (3.7%) 3 (2.2%) 4 (3%)
WITHDRAWAL BY PARENT/GUARDIAN 4 (3%) 2 (1.5%) 1 (0.8%)
WITHDRAWAL BY SUBJECT 1 (0.7%) 1 (0.7%) 1 (0.8%)
DEATH
ADVERSE EVENT 9 (6.7%) 7 (5.2%) 10 (7.6%)
DISEASE PROGRESSION 8 (6%) 6 (4.5%) 6 (4.5%)
LOST TO FOLLOW UP 2 (1.5%) 2 (1.5%) 2 (1.5%)
MISSING 2 (1.5%) 3 (2.2%) 2 (1.5%)
Post-study reporting of death 1 (0.7%) 2 (1.5%) 1 (0.8%)
SUICIDE 2 (1.5%) 2 (1.5%) 1 (0.8%)
UNKNOWN 1 (0.7%) 1 (0.7%) 0
4.5.3 gt
Code
resetSession()
library(tidyverse)
library(gt)
<- cadsl |>
adsl_tot ::summarize(
dplyrNTOT = dplyr::n(),
NTOTLBL = sprintf("%s \n(N=%i)", unique(TRT01A), dplyr::n()),
.by = TRT01A
)
<- as.list(adsl_tot$NTOTLBL)
header_n names(header_n) <- paste0("n_", adsl_tot$TRT01A)
<- merge(cadsl, adsl_tot, by = "TRT01A") |>
disp_df ::mutate(
dplyrEOSSTT = factor(EOSSTT, levels = c("COMPLETED", "ONGOING", "DISCONTINUED"))
)
<- disp_df |>
disc_status ::filter(EOSSTT != "DISCONTINUED") |>
dplyr::summarize(
dplyrn = dplyr::n(),
pct = dplyr::n()/mean(NTOT),
.by = c(TRT01A, EOSSTT)
|>
) ::pivot_wider(id_cols = EOSSTT, names_from = TRT01A, values_from = c(n, pct)) |>
tidyr::arrange(EOSSTT)
dplyr
<- disp_df |>
disc_reason ::filter(EOSSTT == "DISCONTINUED") |>
dplyr::summarize(
dplyrn = dplyr::n(),
pct = dplyr::n()/mean(NTOT),
.by = c(TRT01A, EOSSTT, DCSREAS)
|>
) ::pivot_wider(id_cols = c(EOSSTT, DCSREAS), names_from = TRT01A, values_from = c(n, pct)) |>
tidyr::arrange(EOSSTT, DCSREAS)
dplyr
<- disp_df |>
disc_death ::filter(DCSREAS == "DEATH") |>
dplyr::mutate(
dplyrEOSSTT = "DEATH",
DCSREAS = DTHCAUS
|>
) ::summarize(
dplyrn = dplyr::n(),
pct = dplyr::n()/mean(NTOT),
.by = c(TRT01A, EOSSTT, DCSREAS)
|>
) ::pivot_wider(id_cols = c(EOSSTT, DCSREAS), names_from = TRT01A, values_from = c(n, pct)) |>
tidyr::arrange(EOSSTT, DCSREAS)
dplyr
<- dplyr::bind_rows(disc_status, disc_reason, disc_death)
gt_disp
|>
gt_disp gt(rowname_col = "DCSREAS") |>
tab_row_group(
label = "Discontinued",
rows = EOSSTT == "DISCONTINUED"
|>
) tab_row_group(
label = "Death",
rows = EOSSTT == "DEATH"
|>
) row_group_order(
groups = c(NA, "Discontinued", "Death")
|>
) fmt_integer(
columns = starts_with("n_")
|>
) fmt_percent(
columns = starts_with("pct_"),
decimals = 2
|>
) cols_merge_n_pct(col_n = "n_A: Drug X", col_pct = "pct_A: Drug X") |>
cols_merge_n_pct(col_n = "n_B: Placebo", col_pct = "pct_B: Placebo") |>
cols_merge_n_pct(col_n = "n_C: Combination", col_pct = "pct_C: Combination") |>
cols_merge(
columns = c("DCSREAS", "EOSSTT"),
rows = EOSSTT %in% c("COMPLETED", "ONGOING"),
pattern = "<<{1}>><<{2}>>"
|>
) sub_missing(
columns = starts_with("n_"),
missing_text = "0"
|>
) text_transform(
locations = list(cells_body(), cells_stub()),
fn = stringr::str_to_title
|>
) cols_align(
align = "left",
columns = "DCSREAS"
|>
) cols_align(
align = "center",
columns = starts_with("n_")
|>
) cols_label(
.list = header_n,
.fn = md
|>
) tab_stub_indent(
rows = 3:16,
indent = 5
|>
) cols_width(
1 ~ px(200)
)
A: Drug X (N=134) |
B: Placebo (N=134) |
C: Combination (N=132) |
|
---|---|---|---|
Completed | 68 (50.75%) | 66 (49.25%) | 73 (55.30%) |
Ongoing | 24 (17.91%) | 28 (20.90%) | 21 (15.91%) |
Discontinued | |||
Adverse Event | 3 (2.24%) | 6 (4.48%) | 5 (3.79%) |
Death | 25 (18.66%) | 23 (17.16%) | 22 (16.67%) |
Lack Of Efficacy | 2 (1.49%) | 2 (1.49%) | 3 (2.27%) |
Physician Decision | 2 (1.49%) | 3 (2.24%) | 2 (1.52%) |
Protocol Violation | 5 (3.73%) | 3 (2.24%) | 4 (3.03%) |
Withdrawal By Parent/Guardian | 4 (2.99%) | 2 (1.49%) | 1 (0.76%) |
Withdrawal By Subject | 1 (0.75%) | 1 (0.75%) | 1 (0.76%) |
Death | |||
Adverse Event | 9 (6.72%) | 7 (5.22%) | 10 (7.58%) |
Disease Progression | 8 (5.97%) | 6 (4.48%) | 6 (4.55%) |
Lost To Follow Up | 2 (1.49%) | 2 (1.49%) | 2 (1.52%) |
Missing | 2 (1.49%) | 3 (2.24%) | 2 (1.52%) |
Post-Study Reporting Of Death | 1 (0.75%) | 2 (1.49%) | 1 (0.76%) |
Suicide | 2 (1.49%) | 2 (1.49%) | 1 (0.76%) |
Unknown | 1 (0.75%) | 1 (0.75%) | 0 |
4.5.4 flextable
Code
resetSession()
library(survival)
library(tidyverse)
library(flextable)
library(glue)
<- cadsl |>
adsl select(USUBJID, TRT01A, EOSSTT, DCSREAS)
# data parts calculations
<- adsl |> count(TRT01A, name = "n_part")
part_header
<- adsl |> filter(EOSSTT %in% "COMPLETED") |>
part_completed mutate(DCSREAS = "") |>
count(TRT01A, EOSSTT, DCSREAS)
<- adsl |> filter(EOSSTT %in% "ONGOING") |>
part_ongoing mutate(DCSREAS = "") |>
count(TRT01A, EOSSTT, DCSREAS)
<- adsl |>
part_discontinued filter(EOSSTT %in% "DISCONTINUED") |>
count(TRT01A, EOSSTT, DCSREAS)
<- cadsl |>
part_death filter(EOSSTT %in% "DISCONTINUED", DCSREAS %in% "DEATH") |>
count(TRT01A, EOSSTT, DTHCAUS) |>
mutate(DTHCAUS = paste0("\t", DTHCAUS)) |>
rename(DCSREAS = DTHCAUS)
<- c(
DCSREAS_LEV "", "ADVERSE EVENT", "DEATH",
$DCSREAS, levels(part_discontinued$DCSREAS)) |>
part_deathunique()
<- c("COMPLETED", "ONGOING", "DISCONTINUED")
EOSSTT_LEV
<- bind_rows(
dat
part_completed,
part_ongoing,
part_discontinued, |>
part_death) inner_join(part_header, by = "TRT01A") |>
mutate(percent = n / n_part, n_part = NULL,
DCSREAS = factor(DCSREAS, levels = DCSREAS_LEV),
EOSSTT = factor(EOSSTT, levels = EOSSTT_LEV)
)
# Now the flextable creation with help of `tabulator()`.
<- tabulator(
tab
dat,rows = c("EOSSTT", "DCSREAS"),
columns = "TRT01A",
`content_cell` = as_paragraph(fmt_n_percent(n, percent))
)<- as_flextable(tab, spread_first_col = TRUE,
ft columns_alignment = "center" )
<- setNames(part_header$n_part, part_header$TRT01A)
TRT_COUNTS for (TRT_COD in names(TRT_COUNTS)) {
<- append_chunks(x = ft, part = "header", i = 1,
ft j = tabulator_colnames(tab, columns = "content_cell", TRT01A %in% !!TRT_COD),
as_chunk(TRT_COUNTS[TRT_COD], formatter = function(n) sprintf("\n(N=%.0f)", n)))
}
<- labelizor(ft, j = "DCSREAS", part = "all", labels = function(x) tools::toTitleCase(tolower(x))) |>
ft labelizor(labels = c(Dcsreas = ""), j = "DCSREAS", part = "header") |>
align(i = ~!is.na(EOSSTT) | seq_along(EOSSTT) == 1, j = 1, align = "left") |>
prepend_chunks(i = ~is.na(EOSSTT), j = "DCSREAS", as_chunk("\t")) |>
autofit()
ft
A: Drug X | B: Placebo | C: Combination | ||||
---|---|---|---|---|---|---|
Completed | 68 (50.7%) | 66 (49.3%) | 73 (55.3%) | |||
Ongoing | 24 (17.9%) | 28 (20.9%) | 21 (15.9%) | |||
Discontinued | ||||||
Adverse Event | 3 (2.2%) | 6 (4.5%) | 5 (3.8%) | |||
Death | 25 (18.7%) | 23 (17.2%) | 22 (16.7%) | |||
Adverse Event | 9 (6.7%) | 7 (5.2%) | 10 (7.6%) | |||
Disease Progression | 8 (6.0%) | 6 (4.5%) | 6 (4.5%) | |||
Lost to Follow Up | 2 (1.5%) | 2 (1.5%) | 2 (1.5%) | |||
Missing | 2 (1.5%) | 3 (2.2%) | 2 (1.5%) | |||
Post-Study Reporting of Death | 1 (0.7%) | 2 (1.5%) | 1 (0.8%) | |||
Suicide | 2 (1.5%) | 2 (1.5%) | 1 (0.8%) | |||
Unknown | 1 (0.7%) | 1 (0.7%) | ||||
Lack of Efficacy | 2 (1.5%) | 2 (1.5%) | 3 (2.3%) | |||
Physician Decision | 2 (1.5%) | 3 (2.2%) | 2 (1.5%) | |||
Protocol Violation | 5 (3.7%) | 3 (2.2%) | 4 (3.0%) | |||
Withdrawal by Parent/Guardian | 4 (3.0%) | 2 (1.5%) | 1 (0.8%) | |||
Withdrawal by Subject | 1 (0.7%) | 1 (0.7%) | 1 (0.8%) |
4.5.5 tables
Code
resetSession()
<- cadsl
adsl
# Change the labels to title case
levels(adsl$EOSSTT) <- tools::toTitleCase(tolower(levels(adsl$EOSSTT)))
levels(adsl$DCSREAS) <- tools::toTitleCase(tolower(levels(adsl$DCSREAS)))
levels(adsl$DTHCAUS) <- tools::toTitleCase(tolower(levels(adsl$DTHCAUS)))
library(tables)
<- table(adsl$ARM)
subject_counts
<- function(num, ARM) {
countpercentid <- length(unique(num))
n if (n == 0) pct <- 0
else pct <- 100*n/subject_counts[ARM[1]]
sprintf("%d (%.2f%%)",
length(unique(num)),
pct)
}
<- function(x) sprintf("(N=%d)", length(x))
count
<- tabular(Heading("")*1*Heading("")*count ~
heading Heading()*TRT01A, data = adsl)
<- tabular( Heading("")*EOSSTT*DropEmpty(which = "row")*
part1 Heading("")*1*
Heading()*countpercentid*Arguments(ARM = TRT01A)*
Heading()*USUBJID ~
Heading()*TRT01A,
data = subset(adsl, EOSSTT != "Discontinued"))
<- tabular( Heading("")*EOSSTT*
part2 Heading("")*DCSREAS*DropEmpty(which = "row")*
Heading()*countpercentid*Arguments(ARM = TRT01A)*
Heading()*USUBJID ~
Heading()*TRT01A,
data = subset(adsl, EOSSTT == "Discontinued" &
!= "Death"))
DCSREAS
<- tabular( Heading("")*DCSREAS*
part3 Heading("")*DTHCAUS*DropEmpty(which = "row")*
Heading()*countpercentid*Arguments(ARM = TRT01A)*
Heading()*USUBJID ~
Heading()*TRT01A,
data = subset(adsl, EOSSTT == "Discontinued" &
== "Death"))
DCSREAS
useGroupLabels(rbind(heading, part1, part2, part3),
indent = " ")
A: Drug X | B: Placebo | C: Combination | |
---|---|---|---|
(N=134) | (N=134) | (N=132) | |
Completed | 68 (50.75%) | 66 (49.25%) | 73 (55.30%) |
Ongoing | 24 (17.91%) | 28 (20.90%) | 21 (15.91%) |
Discontinued | |||
Adverse Event | 3 (2.24%) | 6 (4.48%) | 5 (3.79%) |
Lack of Efficacy | 2 (1.49%) | 2 (1.49%) | 3 (2.27%) |
Physician Decision | 2 (1.49%) | 3 (2.24%) | 2 (1.52%) |
Protocol Violation | 5 (3.73%) | 3 (2.24%) | 4 (3.03%) |
Withdrawal by Parent/Guardian | 4 (2.99%) | 2 (1.49%) | 1 (0.76%) |
Withdrawal by Subject | 1 (0.75%) | 1 (0.75%) | 1 (0.76%) |
Death | |||
Adverse Event | 9 (6.72%) | 7 (5.22%) | 10 (7.58%) |
Disease Progression | 8 (5.97%) | 6 (4.48%) | 6 (4.55%) |
Lost to Follow Up | 2 (1.49%) | 2 (1.49%) | 2 (1.52%) |
Missing | 2 (1.49%) | 3 (2.24%) | 2 (1.52%) |
Post-Study Reporting of Death | 1 (0.75%) | 2 (1.49%) | 1 (0.76%) |
Suicide | 2 (1.49%) | 2 (1.49%) | 1 (0.76%) |
Unknown | 1 (0.75%) | 1 (0.75%) | 0 (0.00%) |
4.5.6 tidytlg
Code
resetSession()
library(dplyr)
library(tidytlg)
data("cadsl", package = "random.cdisc.data")
<- cadsl %>%
adsl mutate(COMPFL = case_when(EOSSTT == "COMPLETED" ~ "Y",
TRUE ~ "N"))
<- adsl %>%
disc filter(EOSSTT == "DISCONTINUED")
<- adsl %>%
dth filter(DTHFL == "Y")
# Create analysis population counts
<- freq(adsl,
tbl1 rowvar = "SAFFL",
colvar = "ARM",
statlist = statlist("n"),
rowtext = "Analysis Set: Safety Population",
subset = SAFFL == "Y")
# Create counts (percentages) for completed patients
<- freq(adsl,
tbl2 rowvar = "COMPFL",
colvar = "ARM",
statlist = statlist("n (x.x%)"),
rowtext = "Completed",
subset = COMPFL == "Y")
# Create counts (percentages) for discontinued reasons
<- freq(disc,
tbl3 denom_df = adsl,
rowvar = "DCSREAS",
colvar = "ARM",
statlist = statlist("n (x.x%)"),
row_header = "Discontinued")
# Create counts (percentages) for death reasons
<- freq(dth,
tbl4 denom_df = adsl,
rowvar = "DTHCAUS",
colvar = "ARM",
statlist = statlist("n (x.x%)"),
row_header = "Death Cause")
# combine analysis results together
<- bind_table(tbl1, tbl2, tbl3, tbl4)
tbl
# output the analysis results
gentlg(huxme = tbl,
format = "HTML",
print.hux = FALSE,
file = "Table x.x.x.x",
orientation = "portrait",
title = "Study Disposition Summary",
colheader = c("","A: Drug X","B: Placebo","C: Combination"))
Table x.x.x.x: Study Disposition Summary | |||
A: Drug X | B: Placebo | C: Combination | |
---|---|---|---|
Analysis Set: Safety Population | 134 | 134 | 132 |
Completed | 68 (50.7%) | 66 (49.3%) | 73 (55.3%) |
Discontinued | |||
ADVERSE EVENT | 3 (2.2%) | 6 (4.5%) | 5 (3.8%) |
DEATH | 25 (18.7%) | 23 (17.2%) | 22 (16.7%) |
LACK OF EFFICACY | 2 (1.5%) | 2 (1.5%) | 3 (2.3%) |
PHYSICIAN DECISION | 2 (1.5%) | 3 (2.2%) | 2 (1.5%) |
PROTOCOL VIOLATION | 5 (3.7%) | 3 (2.2%) | 4 (3.0%) |
WITHDRAWAL BY PARENT/GUARDIAN | 4 (3.0%) | 2 (1.5%) | 1 (0.8%) |
WITHDRAWAL BY SUBJECT | 1 (0.7%) | 1 (0.7%) | 1 (0.8%) |
Death Cause | |||
ADVERSE EVENT | 9 (6.7%) | 7 (5.2%) | 10 (7.6%) |
DISEASE PROGRESSION | 8 (6.0%) | 6 (4.5%) | 6 (4.5%) |
LOST TO FOLLOW UP | 2 (1.5%) | 2 (1.5%) | 2 (1.5%) |
MISSING | 2 (1.5%) | 3 (2.2%) | 2 (1.5%) |
Post-study reporting of death | 1 (0.7%) | 2 (1.5%) | 1 (0.8%) |
SUICIDE | 2 (1.5%) | 2 (1.5%) | 1 (0.8%) |
UNKNOWN | 1 (0.7%) | 1 (0.7%) | 0 |
[table x.x.x.x.html][/home/runner/work/_temp/dbc50335-555d-4c9d-8c49-eaade0bcc058] 03NOV2023, 00:16 |
4.5.7 tfrmt
Rather than starting with an ADaM, tfrmt assumes users will start with an ARD (Analysis Results Dataset), because of this, making this table will be split into two parts, first to make the ARD and second to format the table.
Code
resetSession()
library(tidyverse)
library(tfrmt)
data("cadsl", package = "random.cdisc.data")
<- cadsl |>
big_n ::group_by(ARM) |>
dplyr::summarize(
dplyrN = dplyr::n_distinct(USUBJID)
)
<- cadsl |>
disp_summary ::left_join(big_n, by = "ARM") |>
dplyr::group_by(ARM, EOSSTT, DCSREAS, DTHCAUS) |>
dplyr::reframe(
dplyrn_subj = n_distinct(USUBJID),
pct_subj = n_subj/N
|>
) ::distinct() |>
dplyr::pivot_longer(ends_with("subj")) |>
tidyr::mutate(
dplyrDCSREAS = if_else(is.na(DCSREAS), EOSSTT, DCSREAS),
DTHCAUS = if_else(is.na(DTHCAUS), DCSREAS, DTHCAUS),
EOSSTT = forcats::fct_relevel(EOSSTT,
"ONGOING", "COMPLETED", "DISCONTINUED")
%>%
) ::arrange(EOSSTT, DCSREAS, DTHCAUS)
dplyr
<- big_n |>
label_N ::rename(value = N) |>
dplyr::mutate(name = "header_n")
dplyr
<- disp_summary |>
disp_ard bind_rows(label_N)
## Format Table
tfrmt(
column = ARM,
group = c("EOSSTT", "DCSREAS"),
param = name,
value = value,
label = DTHCAUS
|>
) # Then we cam combine it with an n percent template
tfrmt_n_pct(n = "n_subj",
pct = "pct_subj",
pct_frmt_when = frmt_when("==1" ~ "",
">.99" ~ "(>99%)",
"==0" ~ "",
"<.01" ~ "(<1%)",
"TRUE" ~ frmt("(xx.x%)", transform = ~.*100))
|>
) #Finally we are going to add some additional formatting
tfrmt(
big_n = big_n_structure("header_n"),
# Aligning on decimal places and spaces
col_style_plan = col_style_plan(
col_style_structure(col = matches("[A-Z]:.*"),
align = c(".", " "))
)|>
)print_to_gt(disp_ard)
A: Drug X N = 134 | B: Placebo N = 134 | C: Combination N = 132 | |
---|---|---|---|
ONGOING | 24 (17.9%) | 28 (20.9%) | 21 (15.9%) |
COMPLETED | 68 (50.7%) | 66 (49.3%) | 73 (55.3%) |