如何用dplyr和qwraps2生成多分类变量计数百分比合并表格

需求说明 #

处理包含多分类变量的数据集，生成格式为「计数(百分比%)」的汇总表格，当前代码分别生成计数和百分比，需整合为美观的单一表格。

数据集与现有代码 #

数据集样本 #

DLO_TEST <- structure(list(SIDE = c("Left", "Right", "Left", "Right", "Left", 
"Right", "Right", "Right", "Right", "Right", "Left", "Left", 
"Left", "Right", "Left", "Right", "Right", "Left", "Left", "Left", 
"Left", "Right", "Right"), PREOP_mTFA = c(163.5, 164.9, 168.7, 
170.3, 162.8, 166.7, 171, 165.9, 165.9, 170.8, 170.5, 173.3, 
167.7, 170.7, 159, 170.9, 168.2, 171.2, 164, 166.6, 169.1, 171.2, 
175.9), PREOP_mLDFA = c(86, 95, 90, 86, 92, 89, 92, 96, 90, 86, 
89, 87, 93, 90, 98, 89, 90, 88, 92, 91, 89, 90, 88), KL = c("ONE", 
"THREE", "TWO", "FOUR", "FOUR", "FOUR", "THREE", "TWO", "ONE", 
"ONE", "TWO", "TWO", "TWO", "THREE", "ONE", "FOUR", "TWO", "THREE", 
"THREE", "TWO", "ONE", "TWO", "TWO"), WEDGE = c("OWHTO", "CWHTO", 
"OWHTO", "CWHTO", "OWDFO", "OWDFO", "CWDFO", "CWDFO", "CWDFO", 
"OWDFO", "OWHTO", "MOWHTO", "LCWHTO", "LCWHTO", "LCWHTO", "LCWHTO", 
"MOWHTO", "LCWDFO", "MOWDFO", "MCWDFO", "MCWDFO", "LOWDFO", "LOWDFO"
)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, 
-23L))

现有代码（拆分生成计数与百分比） #

library(dplyr)
library(qrwraps2)

# 单独生成SIDE的计数与百分比
DLO_TEST %>% group_by(SIDE) %>% 
  summarise(count = n())
DLO_TEST %>% group_by(SIDE) %>% 
  summarise(percent = 100 * n() / nrow(DLO_TEST))

# 单独生成KL的计数与百分比
DLO_TEST %>% group_by(KL) %>% 
  summarise(count = n())
DLO_TEST %>% group_by(KL) %>% 
  summarise(percent = 100 * n() / nrow(DLO_TEST))

# 单独生成WEDGE的计数与百分比
DLO_TEST %>% group_by(WEDGE) %>% 
  summarise(count = n())
DLO_TEST %>% group_by(WEDGE) %>% 
  summarise(percent = 100 * n() / nrow(DLO_TEST))

解决方案 #

方法1：用dplyr直接整合计数与百分比 #

在summarise中同时计算计数和百分比，拼接成要求的格式，还可以批量处理所有分类变量：

library(dplyr)

# 处理单个变量示例
DLO_TEST %>%
  group_by(SIDE) %>%
  summarise(n_percent = paste0(n(), " (", round(100 * n() / nrow(DLO_TEST), 1), "%)")) %>%
  ungroup()

# 批量处理所有分类变量
# 定义需要处理的分类变量列表
cat_vars <- c("SIDE", "KL", "WEDGE")

# 循环生成每个变量的汇总并合并
combined_table <- lapply(cat_vars, function(var) {
  DLO_TEST %>%
    group_by(!!sym(var)) %>%
    summarise(n_percent = paste0(n(), " (", round(100 * n() / nrow(DLO_TEST), 1), "%)")) %>%
    ungroup() %>%
    rename(类别 = !!sym(var)) %>%
    mutate(变量 = var) %>%
    select(变量, 类别, n_percent)
}) %>% bind_rows()

# 查看合并后的表格
print(combined_table)

该方法输出的表格会将所有分类变量的汇总结果整合到同一表格，便于统一查看。

方法2：用qwraps2生成结构化统计表格 #

qwraps2专门用于生成符合学术/医学风格的汇总表格，n_perc函数可直接生成「计数(百分比%)」格式：

library(qrwraps2)

# 设置输出为Markdown格式（适配R Markdown）
options(qwraps2_markup = "markdown")

# 定义各变量的汇总规则
summary_specs <- list(
  "手术侧 (SIDE)" = list(
    "左侧" = ~ n_perc(SIDE == "Left"),
    "右侧" = ~ n_perc(SIDE == "Right")
  ),
  "KL分级 (KL)" = list(
    "ONE" = ~ n_perc(KL == "ONE"),
    "TWO" = ~ n_perc(KL == "TWO"),
    "THREE" = ~ n_perc(KL == "THREE"),
    "FOUR" = ~ n_perc(KL == "FOUR")
  ),
  "楔形截骨方式 (WEDGE)" = list(
    "OWHTO" = ~ n_perc(WEDGE == "OWHTO"),
    "CWHTO" = ~ n_perc(WEDGE == "CWHTO"),
    "OWDFO" = ~ n_perc(WEDGE == "OWDFO"),
    "CWDFO" = ~ n_perc(WEDGE == "CWDFO"),
    "MOWHTO" = ~ n_perc(WEDGE == "MOWHTO"),
    "LCWHTO" = ~ n_perc(WEDGE == "LCWHTO"),
    "LCWDFO" = ~ n_perc(WEDGE == "LCWDFO"),
    "MOWDFO" = ~ n_perc(WEDGE == "MOWDFO"),
    "MCWDFO" = ~ n_perc(WEDGE == "MCWDFO"),
    "LOWDFO" = ~ n_perc(WEDGE == "LOWDFO")
  )
)

# 生成汇总表格
final_table <- summary_table(DLO_TEST, summary_specs)

# 在R Markdown中直接输出表格
final_table

该方法生成的表格层级清晰，直接适配R Markdown的输出格式，无需额外调整。

方法3：用janitor包快速生成（可选） #

若允许额外安装包，janitor的tabyl函数可一键生成计数与百分比，再拼接格式：

install.packages("janitor")
library(janitor)
library(dplyr)

# 单个变量处理
DLO_TEST %>%
  tabyl(SIDE) %>%
  mutate(percent = round(percent * 100, 1)) %>%
  mutate(n_percent = paste0(n, " (", percent, "%)")) %>%
  select(SIDE, n_percent)

# 批量处理分类变量
cat_vars <- c("SIDE", "KL", "WEDGE")
combined_tabyl <- lapply(cat_vars, function(var) {
  DLO_TEST %>%
    tabyl(!!sym(var)) %>%
    mutate(percent = round(percent * 100, 1)) %>%
    mutate(n_percent = paste0(n, " (", percent, "%)")) %>%
    rename(类别 = !!sym(var)) %>%
    mutate(变量 = var) %>%
    select(变量, 类别, n_percent)
}) %>% bind_rows()

print(combined_tabyl)

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