如何在tbl_summary()中指定自定义分母？

需求概述 #

给定两个分组（senior老年组、no_discount无折扣组），每组包含成员的唯一购买记录，需完成：

• 计算组内每种商品的购买频率（即购买该商品的组内人数）
• 计算购买百分比，分母为组内总人数（而非组内观测数）

示例 #

分组1：Senior（老年组）

• 组内总人数：2人
• Abby购买苹果、香蕉；Betty购买香蕉
• 苹果购买频率：1（占比50%），香蕉购买频率：2（占比100%）

分组2：no_discount（无折扣组）

• 组内总人数：3人
• Charlie购买苹果、香蕉；Dave购买苹果；Eric购买苹果、香蕉
• 苹果购买频率：3（占比100%），香蕉购买频率：2（占比66%）

测试数据生成代码 #

set.seed(5400)
library(gtsummary)
library(tidyverse)

produce  <- c("apples", "bananas", "cherries", "dill", "eclairs", "figs")
people <- (1:75)

# 生成带重复用户的随机购买记录
df <- tibble(ID = sample(people, 100, replace = TRUE), 
             fruit = as.factor(sample(produce, 100, replace = TRUE)), 
             )

df <- unique(df)   # 去重，确保每个用户对同一种商品只有一条购买记录

# 给每个唯一用户分配折扣状态
df <- df |> mutate(discount = case_when(ID %% 2 == 0 ~ "no_discount", 
                                        .default =  "senior"))

# 查看各分组下的商品购买次数（仅频率，未计算占比）
df |> 
  group_by(discount, fruit) %>% 
  summarize(Freq=n())

注：测试数据中no_discount组共28人，senior组共27人，总计55位唯一用户。

尝试过的错误代码及问题 #

错误代码1 #

df$present <- TRUE

df |>  complete(ID, fruit, fill = list(present = FALSE)) %>% 
  select(-ID) %>% 
  # 汇总数据
  tbl_summary(by = present, percent = "row") |> 
  modify_header(stat_2 ~ "**Overall**") %>% 
  modify_column_hide(stat_1)

问题：百分比计算以组内观测数为分母，而非组内总人数。

错误代码2 #

df$present <- TRUE
df |> select(-ID) |> 
  na.omit() |> 
  tbl_strata(
    strata = discount, ~ .x |> 
      tbl_summary(by = present, percent = "cell")) 

错误代码3 #

df |>  complete(ID, fruit, fill = list(present = FALSE)) %>% 
  select(-ID) %>% 
  tbl_strata(
     strata = discount, 
     ~ .x |> 
       # 汇总数据
       tbl_summary(by = present, percent = "column") ) 

问题：上述两种tbl_strata写法的频率计算正确，但百分比仍未以组内总人数为分母。

解决方案 #

方法1：先预处理数据，再用gtsummary展示 #

先计算每个分组的总人数，再关联到各商品的购买记录，计算频率和百分比，最后生成表格：

# 步骤1：计算每个分组的总人数
group_totals <- df |> 
  group_by(discount) |> 
  summarize(total_users = n_distinct(ID)) |> 
  ungroup()

# 步骤2：计算每个分组下各商品的购买人数及占比
purchase_stats <- df |> 
  group_by(discount, fruit) |> 
  summarize(purchase_count = n_distinct(ID)) |> 
  ungroup() |> 
  left_join(group_totals, by = "discount") |> 
  mutate(purchase_pct = round(purchase_count / total_users * 100, 1))

# 步骤3：用gtsummary整理成表格
purchase_stats |> 
  select(discount, fruit, purchase_count, purchase_pct) |> 
  tbl_summary(
    by = discount,
    statistic = list(
      purchase_count ~ "{n}",
      purchase_pct ~ "{p}%"
    ),
    label = list(
      purchase_count ~ "购买人数",
      purchase_pct ~ "占比"
    )
  ) |> 
  modify_spanning_header(all_stat_cols() ~ "**分组**") |> 
  modify_header(label ~ "**商品**")

方法2：自定义gtsummary统计量 #

如果想直接用tbl_strata结合自定义统计函数，避免预处理宽表：

# 定义自定义统计函数：计算购买人数及占比（以组内总人数为分母）
custom_stat <- function(data, variable, by, ...) {
  # 获取当前分组的总人数
  total_users <- data |> pull(ID) |> n_distinct()
  # 计算购买该商品的人数
  purchase_count <- data |> filter({{variable}}) |> pull(ID) |> n_distinct()
  # 计算占比
  purchase_pct <- round(purchase_count / total_users * 100, 1)
  # 返回格式化字符串
  glue::glue("{purchase_count} ({purchase_pct}%)")
}

# 整理数据为宽格式（每个商品对应一列，标记是否购买）
df_wide <- df |> 
  mutate(purchased = TRUE) |> 
  pivot_wider(names_from = fruit, values_from = purchased, values_fill = FALSE)

# 用tbl_strata生成分组表格
df_wide |> 
  tbl_strata(
    strata = discount,
    ~ .x |> 
      tbl_summary(
        include = all_of(produce),
        type = all_of(produce) ~ "categorical",
        statistic = all_of(produce) ~ custom_stat,
        label = set_names(produce, produce)
      ) |> 
      modify_header(label ~ "**商品**") |> 
      modify_caption("**各分组商品购买统计**")
  )

注：方法2中pivot_wider生成的宽表，因每个用户对应一行，数据量不会像全展开那样过大，适合真实数据场景。

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