使用gtsummary合并事件/受试者层级统计表遇两类问题求助

我需要创建一个首行为事件级计数、后续为受试者级计数的统计表格，编写的R代码如下：

# Read in data
adsl <- cards::ADSL %>%
  mutate(TRTA = TRT01A)

adcm <- pharmaverseadam::adcm %>%
  filter(SAFFL == "Y" & ONTRTFL == 'Y') %>%
  select(c(USUBJID, TRTA, CMTRT, CMCLAS, CMDECOD, ONTRTFL))

# Event level counts
tbl1 <- adcm %>% tbl_hierarchical_count(
  by = TRTA,
  variables = c(CMTRT),
  overall_row = TRUE,
  label = list(..ard_hierarchical_overall.. = "TOTAL NUMBER OF CONCOMITANT MEDICATIONS")
  ) %>% add_overall(last = TRUE)

tbl1$table_body <- tbl1$table_body %>%
  filter(grepl("ard_hierarchical", variable))

# Subject level counts
tbl2 <- adcm %>% tbl_hierarchical(
  by = c(TRTA),
  variables = c(CMCLAS, CMDECOD),
  denominator = adsl,
  id = USUBJID,
  include = everything(),
  statistic = everything() ~ "{n} ({p}%)",
  overall_row = TRUE,
  label = list(
    ..ard_hierarchical_overall.. = "NUMBER OF PARTICIPANTS WITH ANY CONCOMITANT MEDICATION")
  ) %>%
  add_overall(last = TRUE)

# Stack the tables together
tbl.final <- tbl_stack(list(tbl1, tbl2),
                       quiet = TRUE) %>%
  # Modify the zero percent
  modify_table_body(
    ~ .x %>%
      dplyr::mutate(across(
        all_stat_cols(), ~ dplyr::case_when(. == "0.0 (0.00)" ~ "0", TRUE ~ .)
      ))) %>%
  # Update header
  modify_header(
    all_stat_cols() ~ "**{level}**  \n(N = {n}) <br>n(%)",
    label ~ "**ATC Level 4 <br> Preferred Term**") %>%
  # Remove default footnote
  remove_footnote_header(columns = all_stat_cols()) %>%
  # Create GT for print
  as_gt()

tbl.final$`_data` <- tbl.final$`_data` %>%
  mutate(tbl_id1 = if_else(!grepl("ard_hierarchical", variable),3,tbl_id1))

# Add blank rows for each tbl_id1
tbl.final <- tbl.final %>%
  gt::tab_row_group(
    label = md("<br>"),
    rows = tbl_id1 <= 1
  ) %>%
  tab_options(row_group.default_label = md("<br>"))

目前遇到两个问题：

• 问题1：tbl2原本包含表头N计数，但堆叠生成tbl.final后该信息丢失，输出显示N=NA；
• 问题2：尝试使用tab_row_group插入指定空白行（黄色高亮区域），借助tbl_id信息实现但未达预期效果。

解决方案 #

问题1：修复表头N丢失问题 #

堆叠表格时，tbl_stack不会自动合并两个表格的分母统计信息，导致表头动态变量{n}无法正确提取。解决方式是提前从原始数据中提取各治疗组的样本量，手动构建表头标签：

# 提前提取各治疗组及总体的样本量
trt_n <- adsl %>%
  group_by(TRTA) %>%
  summarise(n = n_distinct(USUBJID)) %>%
  bind_rows(tibble(TRTA = "Overall", n = n_distinct(adsl$USUBJID)))

# 构建带样本量的表头标签
header_labels <- setNames(
  paste0("**", trt_n$TRTA, "**  \n(N = ", trt_n$n, ") <br>n(%)"),
  trt_n$TRTA
)

之后在modify_header中替换动态模板，使用自定义标签：

modify_header(
  all_stat_cols() ~ header_labels[cur_column()],
  label ~ "**ATC Level 4 <br> Preferred Term**"
)

问题2：修复空白行插入问题 #

tbl_stack后会自动生成tbl_id列，标记行来自第一个表格（tbl_id=1）还是第二个表格（tbl_id=2），无需手动创建tbl_id1。最简单的方式是在堆叠前给tbl1末尾添加空白行，实现两段内容的分隔：

# 给tbl1添加空白行
tbl1_empty <- tbl1 %>%
  modify_table_body(
    ~ .x %>%
      add_row(label = "", variable = "", .before = nrow(.))
  )

# 堆叠带空白行的tbl1和tbl2
tbl.final <- tbl_stack(list(tbl1_empty, tbl2), quiet = TRUE)

如果需要更清晰的分段提示，还可以用tab_row_group给两段内容添加分组标题：

tbl.final <- tbl.final %>%
  gt::tab_row_group(
    label = md("**事件级计数**"),
    rows = 1:(nrow(tbl1$table_body))
  ) %>%
  gt::tab_row_group(
    label = md("**受试者级计数**"),
    rows = (nrow(tbl1$table_body)+2):nrow(.)
  ) %>%
  tab_options(row_group.font.weight = "bold")

修改后的完整代码 #

# Read in data
adsl <- cards::ADSL %>%
  mutate(TRTA = TRT01A)

adcm <- pharmaverseadam::adcm %>%
  filter(SAFFL == "Y" & ONTRTFL == 'Y') %>%
  select(c(USUBJID, TRTA, CMTRT, CMCLAS, CMDECOD, ONTRTFL))

# Event level counts
tbl1 <- adcm %>% tbl_hierarchical_count(
  by = TRTA,
  variables = c(CMTRT),
  overall_row = TRUE,
  label = list(..ard_hierarchical_overall.. = "TOTAL NUMBER OF CONCOMITANT MEDICATIONS")
) %>% add_overall(last = TRUE)

tbl1$table_body <- tbl1$table_body %>%
  filter(grepl("ard_hierarchical", variable))

# Subject level counts
tbl2 <- adcm %>% tbl_hierarchical(
  by = c(TRTA),
  variables = c(CMCLAS, CMDECOD),
  denominator = adsl,
  id = USUBJID,
  include = everything(),
  statistic = everything() ~ "{n} ({p}%)",
  overall_row = TRUE,
  label = list(
    ..ard_hierarchical_overall.. = "NUMBER OF PARTICIPANTS WITH ANY CONCOMITANT MEDICATION")
) %>%
  add_overall(last = TRUE)

# 提前提取各治疗组及总体的样本量
trt_n <- adsl %>%
  group_by(TRTA) %>%
  summarise(n = n_distinct(USUBJID)) %>%
  bind_rows(tibble(TRTA = "Overall", n = n_distinct(adsl$USUBJID)))

# 构建表头标签
header_labels <- setNames(
  paste0("**", trt_n$TRTA, "**  \n(N = ", trt_n$n, ") <br>n(%)"),
  trt_n$TRTA
)

# 给tbl1添加空白行
tbl1_empty <- tbl1 %>%
  modify_table_body(
    ~ .x %>%
      add_row(label = "", variable = "", .before = nrow(.))
  )

# Stack the tables together
tbl.final <- tbl_stack(list(tbl1_empty, tbl2), quiet = TRUE) %>%
  # Modify the zero percent
  modify_table_body(
    ~ .x %>%
      dplyr::mutate(across(
        all_stat_cols(), ~ dplyr::case_when(. == "0.0 (0.00)" ~ "0", TRUE ~ .)
      ))) %>%
  # Update header with custom N values
  modify_header(
    all_stat_cols() ~ header_labels[cur_column()],
    label ~ "**ATC Level 4 <br> Preferred Term**") %>%
  # Remove default footnote
  remove_footnote_header(columns = all_stat_cols()) %>%
  # Create GT for print
  as_gt()

# 添加分组标题分隔两段内容
tbl.final <- tbl.final %>%
  gt::tab_row_group(
    label = md("**事件级计数**"),
    rows = 1:(nrow(tbl1$table_body))
  ) %>%
  gt::tab_row_group(
    label = md("**受试者级计数**"),
    rows = (nrow(tbl1$table_body)+2):nrow(.)
  ) %>%
  tab_options(row_group.font.weight = "bold")

内容的提问来源于stack exchange，提问作者Ranjan Karmakar