Code
options(repos = c(CRAN = "https://cloud.r-project.org"))Table 1. Demographics Continuous and Categorical Summaries
Put this at the top so installs work during rendering
Install + load packages (run once; safe to re-run)
Code
pacman::p_load(haven, dplyr,tidyr, purrr, glue, lubridate,stringr, EDCimport, pharmaRTF,data.table,gtsummary,gt,flextable )Prepare the data
Code
adsl1 <- read_xpt("adsl.xpt")
temp1 <- adsl1 |>
mutate(trt01a = ifelse(trt01an == 1, "Placebo", "Active"))
temp2 <- bind_rows(
temp1 |> mutate(trtn = trt01an, trt = trt01a),
temp1 |> mutate(trtn = 3, trt = "Overall")
)
temp3 <- bind_rows(
temp1 |> mutate(trtn = trt01an, trt = trt01a)
)
# glimpse(temp2)Get the columns headers
Code
bign <- temp2 |>
distinct(usubjid, trtn, trt) |>
count(trtn, trt, name = "N")
finaldsn <- temp2 |>
left_join(bign, by = c("trtn", "trt")) |>
mutate(trtlab = glue("{trt} (N= {N})"))
bign2 <- finaldsn |> distinct(trtn, trtlab, N) |>
arrange(trtn)
bign2# A tibble: 3 × 3
trtn trtlab N
<dbl> <glue> <int>
1 1 Placebo (N= 19) 19
2 2 Active (N= 22) 22
3 3 Overall (N= 41) 41Continuous summary (all continuous variables)
Goal:
- Summarize each continuous variable by treatment
- Create standard rows: n(missing), Mean(SD), Median, Q1–Q3, Min–Max
- Output in a “stacked” table (variable header row + statistic rows)
Age Section
Code
summary1 <- finaldsn %>%
group_by(treat = as.character(trtlab)) %>%
summarise(
n_nonmiss = sum(!is.na(age)),
n_miss = sum(is.na(age)),
mean = if_else(n_nonmiss > 0, mean(age, na.rm = TRUE), NA_real_),
sd = if_else(n_nonmiss > 1, sd(age, na.rm = TRUE), NA_real_),
med = if_else(n_nonmiss > 0, median(age, na.rm = TRUE), NA_real_),
q1 = if_else(n_nonmiss > 0, as.numeric(quantile(age, .25, na.rm = TRUE, names = FALSE)), NA_real_),
q3 = if_else(n_nonmiss > 0, as.numeric(quantile(age, .75, na.rm = TRUE, names = FALSE)), NA_real_),
mn = if_else(n_nonmiss > 0, min(age, na.rm = TRUE), NA_real_),
mx = if_else(n_nonmiss > 0, max(age, na.rm = TRUE), NA_real_),
.groups = "drop"
) %>%
transmute(
treat,
` n (missing)` = sprintf("%d (%d)", n_nonmiss, n_miss),
` Mean (SD)` = sprintf("%.1f (%.1f)", mean, sd),
` Median` = sprintf("%.1f", med),
` Q1, Q3` = sprintf("%.1f, %.1f", q1, q3),
` Min, Max` = sprintf("%.1f, %.1f", mn, mx)
) %>%
pivot_longer(-treat, names_to = "label", values_to = "value") %>%
mutate(
label = factor(label, levels = c(" n (missing)"," Mean (SD)"," Median"," Q1, Q3"," Min, Max"))) %>%
arrange(label) %>%
pivot_wider(names_from = treat, values_from = value) %>%
mutate(row = as.character(label)) %>%
select(row, everything(), -label)
# add variable header row
header1 <- summary1[1,] %>%
mutate(row = "Age (years)", across(-row, ~ ""))
summary1 <- bind_rows(header1, summary1)WEIGHT Section
Code
summary2 <- finaldsn %>%
group_by(treat = as.character(trtlab)) %>%
summarise(
n_nonmiss = sum(!is.na(weightbl)),
n_miss = sum(is.na(weightbl)),
mean = if_else(n_nonmiss > 0, mean(weightbl, na.rm = TRUE), NA_real_),
sd = if_else(n_nonmiss > 1, sd(weightbl, na.rm = TRUE), NA_real_),
med = if_else(n_nonmiss > 0, median(weightbl, na.rm = TRUE), NA_real_),
q1 = if_else(n_nonmiss > 0, as.numeric(quantile(weightbl, .25, na.rm = TRUE, names = FALSE)), NA_real_),
q3 = if_else(n_nonmiss > 0, as.numeric(quantile(weightbl, .75, na.rm = TRUE, names = FALSE)), NA_real_),
mn = if_else(n_nonmiss > 0, min(weightbl, na.rm = TRUE), NA_real_),
mx = if_else(n_nonmiss > 0, max(weightbl, na.rm = TRUE), NA_real_),
.groups = "drop"
) %>%
transmute(
treat,
` n (missing)` = sprintf("%d (%d)", n_nonmiss, n_miss),
` Mean (SD)` = sprintf("%.1f (%.1f)", mean, sd),
` Median` = sprintf("%.1f", med),
` Q1, Q3` = sprintf("%.1f, %.1f", q1, q3),
` Min, Max` = sprintf("%.1f, %.1f", mn, mx)
) %>%
pivot_longer(-treat, names_to = "label", values_to = "value") %>%
mutate(label = factor(label, levels = c(" n (missing)"," Mean (SD)"," Median"," Q1, Q3"," Min, Max"))) %>%
arrange(label) %>%
pivot_wider(names_from = treat, values_from = value) %>%
mutate(row = as.character(label)) %>%
select(row, everything(), -label)
head2 <- summary2[1,] %>%
mutate(row = "Weight (kg)", across(-row, ~ ""))
summary2 <- bind_rows(head2, summary2)HEIGHT Section
Code
summary3 <- finaldsn %>%
group_by(treat = as.character(trtlab)) %>%
summarise(
n_nonmiss = sum(!is.na(heightbl)),
n_miss = sum(is.na(heightbl)),
mean = if_else(n_nonmiss > 0, mean(heightbl, na.rm = TRUE), NA_real_),
sd = if_else(n_nonmiss > 1, sd(heightbl, na.rm = TRUE), NA_real_),
med = if_else(n_nonmiss > 0, median(heightbl, na.rm = TRUE), NA_real_),
q1 = if_else(n_nonmiss > 0, as.numeric(quantile(heightbl, .25, na.rm = TRUE, names = FALSE)), NA_real_),
q3 = if_else(n_nonmiss > 0, as.numeric(quantile(heightbl, .75, na.rm = TRUE, names = FALSE)), NA_real_),
mn = if_else(n_nonmiss > 0, min(heightbl, na.rm = TRUE), NA_real_),
mx = if_else(n_nonmiss > 0, max(heightbl, na.rm = TRUE), NA_real_),
.groups = "drop"
) %>%
transmute(
treat,
` n (missing)` = sprintf("%d (%d)", n_nonmiss, n_miss),
` Mean (SD)` = sprintf("%.1f (%.1f)", mean, sd),
` Median` = sprintf("%.1f", med),
` Q1, Q3` = sprintf("%.1f, %.1f", q1, q3),
` Min, Max` = sprintf("%.1f, %.1f", mn, mx)
) %>%
pivot_longer(-treat, names_to = "label", values_to = "value") %>%
mutate(label = factor(label, levels = c(" n (missing)"," Mean (SD)"," Median"," Q1, Q3"," Min, Max"))) %>%
arrange(label) %>%
pivot_wider(names_from = treat, values_from = value) %>%
mutate(row = as.character(label)) %>%
select(row, everything(), -label)
head3 <- summary3[1,] %>%
mutate(row = "Height (cm)", across(-row, ~ ""))
summary3 <- bind_rows(head3, summary3)STACK all Sections
Code
# ---------- STACK all blocks ----------
cont_all <- bind_rows(summary1, summary2, summary3)
cont_all# A tibble: 18 × 4
row `Active (N= 22)` `Overall (N= 41)` `Placebo (N= 19)`
<chr> <chr> <chr> <chr>
1 "Age (years)" "" "" ""
2 " n (missing)" "22 (0)" "41 (0)" "19 (0)"
3 " Mean (SD)" "69.1 (6.1)" "69.2 (6.7)" "69.3 (7.4)"
4 " Median" "70.0" "70.0" "70.0"
5 " Q1, Q3" "66.0, 72.8" "66.0, 74.0" "64.0, 74.0"
6 " Min, Max" "55.0, 80.0" "55.0, 84.0" "56.0, 84.0"
7 "Weight (kg)" "" "" ""
8 " n (missing)" "22 (0)" "41 (0)" "19 (0)"
9 " Mean (SD)" "89.6 (12.4)" "91.8 (18.5)" "94.5 (23.8)"
10 " Median" "89.6" "91.2" "91.2"
11 " Q1, Q3" "80.3, 96.0" "80.1, 101.2" "77.5, 110.8"
12 " Min, Max" "72.3, 118.0" "53.5, 141.4" "53.5, 141.4"
13 "Height (cm)" "" "" ""
14 " n (missing)" "22 (0)" "41 (0)" "19 (0)"
15 " Mean (SD)" "169.9 (9.0)" "169.6 (9.7)" "169.2 (10.7)"
16 " Median" "169.5" "170.0" "172.0"
17 " Q1, Q3" "163.8, 177.8" "164.0, 178.0" "164.0, 177.0"
18 " Min, Max" "152.0, 186.0" "146.0, 186.0" "146.0, 183.0" Categorical summary (all categorical variables)
Goal:
- Summarize each categorical variable by treatment
- Create standard rows: each category level as n (%) (optionally include Missing)
- Output in a “stacked” table (variable header row + category level rows)
Treatment labels + Big N (denominator) per treatment
Code
bign <- finaldsn %>%
distinct(usubjid, trtn,trt) %>%
count(trtn,trt, name = "denom") %>%
mutate(trtlab = glue("{trt} (N= {denom})"))
bign# A tibble: 3 × 4
trtn trt denom trtlab
<dbl> <chr> <int> <glue>
1 1 Placebo 19 Placebo (N= 19)
2 2 Active 22 Active (N= 22)
3 3 Overall 41 Overall (N= 41)Code
trt_levels <- bign %>% arrange(trtn) %>% pull(trtlab)
trt_levelsPlacebo (N= 19)
Active (N= 22)
Overall (N= 41)SEX Section
Code
catsum1 <- finaldsn %>%
mutate(sex = if_else(is.na(sex), "Missing", sex)) %>%
count(trtn, sex, name = "n") %>%
complete(trtn, sex, fill = list(n = 0L)) %>%
left_join(bign %>% select(trtn, denom, trtlab), by = "trtn") %>%
mutate(
pct = if_else(denom > 0, 100 * n / denom, NA_real_),
value = sprintf("%d (%.1f%%)", n, pct),
row = paste0(" ", sex)
) %>%
select(row, trtlab, value) %>%
pivot_wider(
names_from = trtlab,
values_from = value,
values_fill = list(value = "0 (0.0%)")
) %>%
relocate(all_of(trt_levels), .after = row)
sheader <- catsum1[1, ] %>%
mutate(row = "Sex, n (%)", across(-row, ~ ""))
catsum1 <- bind_rows(sheader, catsum1)
catsum1# A tibble: 3 × 4
row `Placebo (N= 19)` `Active (N= 22)` `Overall (N= 41)`
<chr> <chr> <chr> <chr>
1 "Sex, n (%)" "" "" ""
2 " F" "6 (31.6%)" "6 (27.3%)" "12 (29.3%)"
3 " M" "13 (68.4%)" "16 (72.7%)" "29 (70.7%)" RACE Section
Code
race_order <- c(
"White",
"Black or African-American",
"Asian",
"American Indian or Alaska Native",
"Native Hawaiian or Other Pacific Islander",
"Other",
"Missing"
)
catsum2 <- finaldsn %>%
mutate(
arace = if_else(is.na(arace), "Missing", arace),
arace = factor(arace, levels = race_order)
) %>%
count(trtn, arace, name = "n") %>%
complete(trtn, arace, fill = list(n = 0L)) %>% # <- keeps all levels (factor)
left_join(bign %>% select(trtn, denom, trtlab), by = "trtn") %>%
mutate(
pct = if_else(denom > 0, 100 * n / denom, NA_real_),
value = sprintf("%d (%.1f%%)", n, pct),
row = paste0(" ", as.character(arace))
) %>%
select(row, trtlab, value) %>%
pivot_wider(
names_from = trtlab,
values_from = value,
values_fill = list(value = "0 (0.0%)")
) %>%
relocate(all_of(trt_levels), .after = row)
rheader <- catsum2[1, ] %>%
mutate(row = "Race, n (%)", across(-row, ~ ""))
catsum2 <- bind_rows(rheader, catsum2)
catsum2# A tibble: 8 × 4
row `Placebo (N= 19)` `Active (N= 22)` `Overall (N= 41)`
<chr> <chr> <chr> <chr>
1 "Race, n (%)" "" "" ""
2 " White" "19 (100.0%)" "20 (90.9%)" "39 (95.1%)"
3 " Black or African-Amer… "0 (0.0%)" "0 (0.0%)" "0 (0.0%)"
4 " Asian" "0 (0.0%)" "2 (9.1%)" "2 (4.9%)"
5 " American Indian or Al… "0 (0.0%)" "0 (0.0%)" "0 (0.0%)"
6 " Native Hawaiian or Ot… "0 (0.0%)" "0 (0.0%)" "0 (0.0%)"
7 " Other" "0 (0.0%)" "0 (0.0%)" "0 (0.0%)"
8 " Missing" "0 (0.0%)" "0 (0.0%)" "0 (0.0%)" Stack all sections
Code
cat_all <- bind_rows(catsum1, catsum2)
cat_all# A tibble: 11 × 4
row `Placebo (N= 19)` `Active (N= 22)` `Overall (N= 41)`
<chr> <chr> <chr> <chr>
1 "Sex, n (%)" "" "" ""
2 " F" "6 (31.6%)" "6 (27.3%)" "12 (29.3%)"
3 " M" "13 (68.4%)" "16 (72.7%)" "29 (70.7%)"
4 "Race, n (%)" "" "" ""
5 " White" "19 (100.0%)" "20 (90.9%)" "39 (95.1%)"
6 " Black or African-Ame… "0 (0.0%)" "0 (0.0%)" "0 (0.0%)"
7 " Asian" "0 (0.0%)" "2 (9.1%)" "2 (4.9%)"
8 " American Indian or A… "0 (0.0%)" "0 (0.0%)" "0 (0.0%)"
9 " Native Hawaiian or O… "0 (0.0%)" "0 (0.0%)" "0 (0.0%)"
10 " Other" "0 (0.0%)" "0 (0.0%)" "0 (0.0%)"
11 " Missing" "0 (0.0%)" "0 (0.0%)" "0 (0.0%)" Final output dataset
Code
alldata<- bind_rows(cat_all, cont_all)
alldata# A tibble: 29 × 4
row `Placebo (N= 19)` `Active (N= 22)` `Overall (N= 41)`
<chr> <chr> <chr> <chr>
1 "Sex, n (%)" "" "" ""
2 " F" "6 (31.6%)" "6 (27.3%)" "12 (29.3%)"
3 " M" "13 (68.4%)" "16 (72.7%)" "29 (70.7%)"
4 "Race, n (%)" "" "" ""
5 " White" "19 (100.0%)" "20 (90.9%)" "39 (95.1%)"
6 " Black or African-Ame… "0 (0.0%)" "0 (0.0%)" "0 (0.0%)"
7 " Asian" "0 (0.0%)" "2 (9.1%)" "2 (4.9%)"
8 " American Indian or A… "0 (0.0%)" "0 (0.0%)" "0 (0.0%)"
9 " Native Hawaiian or O… "0 (0.0%)" "0 (0.0%)" "0 (0.0%)"
10 " Other" "0 (0.0%)" "0 (0.0%)" "0 (0.0%)"
# ℹ 19 more rowsCode
tlf_gt <- function(df,
title = "Table 1. Demographics and Baseline Characteristics",
subtitle = "Safety Population (SAFFL)") {
stub <- names(df)[1]
trt_cols <- names(df)[-1]
# Section header rows = rows where all treatment cells are blank/NA
is_section <- apply(df[, trt_cols, drop = FALSE], 1, function(x) {
all(is.na(x) | trimws(as.character(x)) == "")
})
# Sub-rows = stub starts with spaces (like your " F", " M", etc.)
is_sub <- grepl("^\\s+", df[[stub]])
df %>%
gt(rowname_col = stub) %>%
tab_header(
title = md(paste0("**", title, "**")),
subtitle = subtitle
) %>%
cols_align("left", columns = all_of(stub)) %>%
cols_align("right", columns = all_of(trt_cols)) %>%
# OG clinical look: monospaced font + compact rows
opt_table_font(font = list("Courier New", "Consolas", "monospace")) %>%
tab_options(
table.font.size = px(12),
data_row.padding = px(2),
heading.title.font.size = px(14),
heading.subtitle.font.size = px(12),
# classic rules (SAS-style)
table.border.top.style = "solid",
table.border.top.width = px(2),
column_labels.border.bottom.style = "solid",
column_labels.border.bottom.width = px(2),
table.border.bottom.style = "solid",
table.border.bottom.width = px(2),
# minimal grid (no vertical lines)
table_body.hlines.style = "none",
table_body.vlines.style = "none",
column_labels.vlines.style = "none"
) %>%
# Bold section headers
tab_style(
style = cell_text(weight = "bold"),
locations = cells_stub(rows = is_section)
) %>%
# Indent sub-rows
tab_style(
style = cell_text(indent = px(18)),
locations = cells_stub(rows = is_sub & !is_section)
) %>%
# Optional clinical footnote
tab_source_note(md("*Percentages are based on the column N.*"))
}Code
tlf_gt(alldata,
title = "Table 14.1.2.1 Demographics and Baseline Characteristics",
subtitle = "Safety Population (SAFFL)")| Table 14.1.2.1 Demographics and Baseline Characteristics | |||
|---|---|---|---|
| Safety Population (SAFFL) | |||
| Placebo (N= 19) | Active (N= 22) | Overall (N= 41) | |
| Sex, n (%) | |||
| F | 6 (31.6%) | 6 (27.3%) | 12 (29.3%) |
| M | 13 (68.4%) | 16 (72.7%) | 29 (70.7%) |
| Race, n (%) | |||
| White | 19 (100.0%) | 20 (90.9%) | 39 (95.1%) |
| Black or African-American | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) |
| Asian | 0 (0.0%) | 2 (9.1%) | 2 (4.9%) |
| American Indian or Alaska Native | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) |
| Native Hawaiian or Other Pacific Islander | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) |
| Other | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) |
| Missing | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) |
| Age (years) | |||
| n (missing) | 19 (0) | 22 (0) | 41 (0) |
| Mean (SD) | 69.3 (7.4) | 69.1 (6.1) | 69.2 (6.7) |
| Median | 70.0 | 70.0 | 70.0 |
| Q1, Q3 | 64.0, 74.0 | 66.0, 72.8 | 66.0, 74.0 |
| Min, Max | 56.0, 84.0 | 55.0, 80.0 | 55.0, 84.0 |
| Weight (kg) | |||
| n (missing) | 19 (0) | 22 (0) | 41 (0) |
| Mean (SD) | 94.5 (23.8) | 89.6 (12.4) | 91.8 (18.5) |
| Median | 91.2 | 89.6 | 91.2 |
| Q1, Q3 | 77.5, 110.8 | 80.3, 96.0 | 80.1, 101.2 |
| Min, Max | 53.5, 141.4 | 72.3, 118.0 | 53.5, 141.4 |
| Height (cm) | |||
| n (missing) | 19 (0) | 22 (0) | 41 (0) |
| Mean (SD) | 169.2 (10.7) | 169.9 (9.0) | 169.6 (9.7) |
| Median | 172.0 | 169.5 | 170.0 |
| Q1, Q3 | 164.0, 177.0 | 163.8, 177.8 | 164.0, 178.0 |
| Min, Max | 146.0, 183.0 | 152.0, 186.0 | 146.0, 186.0 |
| Percentages are based on the column N. | |||
Code
tlf_gt <- function(df,
title = "Table 1. Demographics and Baseline Characteristics",
subtitle = "Safety Population (SAFFL)") {
df <- as.data.frame(df)
stub <- names(df)[1]
trt_cols <- names(df)[-1]
# Section header rows = all treatment cells blank/NA
is_section <- apply(df[, trt_cols, drop = FALSE], 1, function(x) {
all(is.na(x) | trimws(as.character(x)) == "")
})
# Sub-rows = stub starts with spaces
is_sub <- grepl("^\\s+", df[[stub]])
df[[stub]] <- sub("^\\s+", "", df[[stub]]) # remove spaces; we’ll indent via gt
# 2-line column headers: "Placebo (N= 19)" -> "Placebo<br>(N=19)"
lab_trt <- setNames(lapply(trt_cols, function(x) {
x2 <- gsub("\\s+", " ", x)
gt::html(sub("\\s*\\(N\\s*=\\s*([0-9]+)\\s*\\)\\s*$",
"<br>(N=\\1)", x2, perl = TRUE))
}), trt_cols)
labs <- c(setNames(list(gt::html("")), stub), lab_trt)
g <- gt::gt(df) %>%
gt::tab_header(
title = gt::md(paste0("**", title, "**")),
subtitle = subtitle
) %>%
gt::opt_row_striping() %>%
gt::cols_align("left", columns = all_of(stub)) %>%
gt::cols_align("center", columns = all_of(trt_cols)) %>%
gt::opt_table_font(font = list("Courier New", "Consolas", "monospace")) %>%
gt::tab_options(
table.font.size = gt::px(12),
data_row.padding = gt::px(2),
table.border.top.style = "solid",
table.border.top.width = gt::px(2),
column_labels.border.bottom.style = "solid",
column_labels.border.bottom.width = gt::px(2),
table.border.bottom.style = "solid",
table.border.bottom.width = gt::px(2),
table_body.hlines.style = "none",
table_body.vlines.style = "none",
column_labels.vlines.style = "none"
)
# apply labels (programmatically)
g <- do.call(gt::cols_label, c(list(g), labs))
# Bold section headers (stub column)
g <- g %>%
gt::tab_style(
style = gt::cell_text(weight = "bold"),
locations = gt::cells_body(columns = all_of(stub), rows = is_section)
) %>%
# Indent sub-rows (stub column)
gt::tab_style(
style = gt::cell_text(indent = gt::px(18)),
locations = gt::cells_body(columns = all_of(stub), rows = is_sub & !is_section)
) %>%
gt::tab_source_note(gt::md("*Percentages are based on the column N.*"))
g
}Code
tlf_gt(alldata)| Table 1. Demographics and Baseline Characteristics | |||
|---|---|---|---|
| Safety Population (SAFFL) | |||
| Placebo (N=19) |
Active (N=22) |
Overall (N=41) |
|
| Sex, n (%) | |||
| F | 6 (31.6%) | 6 (27.3%) | 12 (29.3%) |
| M | 13 (68.4%) | 16 (72.7%) | 29 (70.7%) |
| Race, n (%) | |||
| White | 19 (100.0%) | 20 (90.9%) | 39 (95.1%) |
| Black or African-American | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) |
| Asian | 0 (0.0%) | 2 (9.1%) | 2 (4.9%) |
| American Indian or Alaska Native | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) |
| Native Hawaiian or Other Pacific Islander | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) |
| Other | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) |
| Missing | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) |
| Age (years) | |||
| n (missing) | 19 (0) | 22 (0) | 41 (0) |
| Mean (SD) | 69.3 (7.4) | 69.1 (6.1) | 69.2 (6.7) |
| Median | 70.0 | 70.0 | 70.0 |
| Q1, Q3 | 64.0, 74.0 | 66.0, 72.8 | 66.0, 74.0 |
| Min, Max | 56.0, 84.0 | 55.0, 80.0 | 55.0, 84.0 |
| Weight (kg) | |||
| n (missing) | 19 (0) | 22 (0) | 41 (0) |
| Mean (SD) | 94.5 (23.8) | 89.6 (12.4) | 91.8 (18.5) |
| Median | 91.2 | 89.6 | 91.2 |
| Q1, Q3 | 77.5, 110.8 | 80.3, 96.0 | 80.1, 101.2 |
| Min, Max | 53.5, 141.4 | 72.3, 118.0 | 53.5, 141.4 |
| Height (cm) | |||
| n (missing) | 19 (0) | 22 (0) | 41 (0) |
| Mean (SD) | 169.2 (10.7) | 169.9 (9.0) | 169.6 (9.7) |
| Median | 172.0 | 169.5 | 170.0 |
| Q1, Q3 | 164.0, 177.0 | 163.8, 177.8 | 164.0, 178.0 |
| Min, Max | 146.0, 183.0 | 152.0, 186.0 | 146.0, 186.0 |
| Percentages are based on the column N. | |||
Code
tlf_demo_gts <- function(temp3,
title = "Table 1. Demographics and Baseline Characteristics",
subtitle = "Safety Population (SAFFL)") {
# ---- 1) Analysis data ----
dat <- temp3 %>%
filter(saffl == "Y") %>%
mutate(
trt = factor(trt, levels = c("Placebo", "Active")),
sex = factor(sex, levels = c("F", "M")),
arace = factor(arace, levels = c(
"White",
"Black or African-American",
"Asian",
"American Indian or Alaska Native",
"Native Hawaiian or Other Pacific Islander",
"Other"
))
)
# ---- 2) Ns for headers ----
n_by <- dat %>% count(trt, name = "N")
lvls <- levels(dat$trt)
Ns <- n_by$N[match(lvls, as.character(n_by$trt))]
Ntot <- sum(n_by$N)
# ---- 3) gtsummary table ----
cont2 <- c(
"n (missing)" = "{N_nonmiss} ({N_miss})",
"Mean (SD)" = "{mean} ({sd})",
"Median" = "{median}",
"Q1, Q3" = "{p25}, {p75}",
"Min, Max" = "{min}, {max}"
)
tbl <- dat %>%
select(trt, sex, arace, age, weightbl, heightbl, bmibl) %>%
tbl_summary(
by = trt,
type = all_continuous() ~ "continuous2",
statistic = list(
all_categorical() ~ "{n} ({p}%)",
all_continuous2() ~ cont2
),
digits = all_continuous2() ~ 1,
label = list(
sex ~ "Sex, n (%)",
arace ~ "Race, n (%)",
age ~ "Age (years)",
weightbl ~ "Weight (kg)",
heightbl ~ "Height (cm)",
bmibl ~ "BMI"
),
missing = "ifany",
missing_text = "Missing"
) %>%
add_overall(last = TRUE, col_label = "Overall") %>%
bold_labels()
# ---- 4) Convert to gt + base styling ----
g <- as_gt(tbl) %>%
tab_header(title = md(paste0("**", title, "**")), subtitle = subtitle) %>%
opt_row_striping() %>%
opt_table_font(font = list("Courier New", "Consolas", "monospace")) %>%
cols_width(label ~ px(430)) %>%
tab_options(
table.border.top.width = px(2),
column_labels.border.bottom.width = px(2),
table.border.bottom.width = px(2),
table_body.hlines.style = "none",
table_body.vlines.style = "none",
column_labels.vlines.style = "none"
) %>%
tab_source_note(md("*Percentages are based on the column N.*"))
# older-gt safe CSS (instead of table_additional_css)
if ("opt_css" %in% getNamespaceExports("gt")) {
g <- gt::opt_css(g, css = "tbody td { white-space: normal; hyphens: none; }")
}
# ---- 5) 2-line bold column headers (NO hard-coding) ----
stat_cols <- grep("^stat_", names(tbl$table_body), value = TRUE)
overall_col <- "stat_0"
by_cols <- setdiff(stat_cols, overall_col)
lab_list <- setNames(
lapply(seq_along(by_cols), function(i)
gt::html(paste0("<b>", lvls[i], "</b><br><b>(N=", Ns[i], ")</b>"))
),
by_cols
)
if (overall_col %in% stat_cols) {
lab_list[[overall_col]] <- gt::html(paste0("<b>Overall</b><br><b>(N=", Ntot, ")</b>"))
}
lab_list[["label"]] <- gt::html("")
g <- do.call(gt::cols_label, c(list(g), lab_list))
# ensure header bold (some versions need explicit style)
g <- g %>%
tab_style(
style = cell_text(weight = "bold"),
locations = cells_column_labels(columns = dplyr::everything())
)
# ---- 6) Wrap-safe indent for level/stat rows (fix 2nd-line indent) ----
sub_rows <- if ("indent" %in% names(tbl$table_body)) which(tbl$table_body$indent > 0) else integer(0)
if (length(sub_rows) > 0) {
g <- g %>%
text_transform(
locations = cells_body(columns = "label", rows = sub_rows),
fn = function(x) {
x2 <- sub("^\\s+", "", x) # remove gtsummary leading spaces (avoid double indent)
gt::html(paste0("<div style='padding-left:18px'>", x2, "</div>"))
}
)
}
# ---- 7) Bold section headers (Sex, Race, Age, Weight, Height) ----
if ("row_type" %in% names(tbl$table_body)) {
sec_rows <- which(tbl$table_body$row_type == "label")
g <- g %>%
tab_style(
style = cell_text(weight = "bold"),
locations = cells_body(columns = "label", rows = sec_rows)
)
}
g
}
# Run:
tlf_demo_gts(temp3)| Table 1. Demographics and Baseline Characteristics | |||
|---|---|---|---|
| Safety Population (SAFFL) | |||
| Placebo (N=19)1 |
Active (N=22)1 |
Overall (N=41)1 |
|
| Sex, n (%) | |||
| F | 6 (32%) | 6 (27%) | 12 (29%) |
| M | 13 (68%) | 16 (73%) | 29 (71%) |
| Race, n (%) | |||
| White | 19 (100%) | 20 (91%) | 39 (95%) |
| Black or African-American | 0 (0%) | 0 (0%) | 0 (0%) |
| Asian | 0 (0%) | 2 (9.1%) | 2 (4.9%) |
| American Indian or Alaska Native | 0 (0%) | 0 (0%) | 0 (0%) |
| Native Hawaiian or Other Pacific Islander | 0 (0%) | 0 (0%) | 0 (0%) |
| Other | 0 (0%) | 0 (0%) | 0 (0%) |
| Age (years) | |||
| N Non-missing (N Missing) | 19.0 (0.0) | 22.0 (0.0) | 41.0 (0.0) |
| Mean (SD) | 69.3 (7.4) | 69.1 (6.1) | 69.2 (6.7) |
| Median | 70.0 | 70.0 | 70.0 |
| Q1, Q3 | 64.0, 74.0 | 66.0, 73.0 | 66.0, 74.0 |
| Min, Max | 56.0, 84.0 | 55.0, 80.0 | 55.0, 84.0 |
| Weight (kg) | |||
| N Non-missing (N Missing) | 19.0 (0.0) | 22.0 (0.0) | 41.0 (0.0) |
| Mean (SD) | 94.5 (23.8) | 89.6 (12.4) | 91.8 (18.5) |
| Median | 91.2 | 89.6 | 91.2 |
| Q1, Q3 | 74.6, 116.6 | 80.1, 96.0 | 80.1, 101.2 |
| Min, Max | 53.5, 141.4 | 72.3, 118.0 | 53.5, 141.4 |
| Height (cm) | |||
| N Non-missing (N Missing) | 19.0 (0.0) | 22.0 (0.0) | 41.0 (0.0) |
| Mean (SD) | 169.2 (10.7) | 169.9 (9.0) | 169.6 (9.7) |
| Median | 172.0 | 169.5 | 170.0 |
| Q1, Q3 | 164.0, 178.0 | 163.0, 178.0 | 164.0, 178.0 |
| Min, Max | 146.0, 183.0 | 152.0, 186.0 | 146.0, 186.0 |
| BMI | |||
| N Non-missing (N Missing) | 19.0 (0.0) | 22.0 (0.0) | 41.0 (0.0) |
| Mean (SD) | 33.0 (8.3) | 31.0 (3.6) | 32.0 (6.3) |
| Median | 31.0 | 29.9 | 30.6 |
| Q1, Q3 | 25.1, 39.0 | 28.7, 33.6 | 28.7, 34.4 |
| Min, Max | 23.7, 56.8 | 25.7, 38.1 | 23.7, 56.8 |
| 1 n (%) | |||
| Percentages are based on the column N. | |||