如何使用gtsummary包构建与自定义函数等效的描述性统计表格

现有代码逻辑 #

你当前已编写的自定义统计函数及表格生成代码如下：

sum_stats = function(data, group, value, alpha=0.05)data %>%
  group_by(!!enquo(group)) %>%
  summarise(
    n = n(),
    q1 = quantile(!!enquo(value),1/4,8),
    min = min(!!enquo(value)),
    mean = mean(!!enquo(value)),
    median = median(!!enquo(value)),
    q3 = quantile(!!enquo(value),3/4,8),
    max = max(!!enquo(value)),
    sd = sd(!!enquo(value)),
    stderr = sd/sqrt(n),
    kurtosis = e1071::kurtosis(!!enquo(value)),
    skewness = e1071::skewness(!!enquo(value)),
    LCL = mean - qt(1 - (0.05 / 2), n - 1) * stderr,
    UCL = mean + qt(1 -(0.05 / 2), n - 1) * stderr,
    #SW.stat = ShapiroTest(!!enquo(value), alpha)$statistic,
    #SW.p = ShapiroTest(!!enquo(value), alpha)$p.value,
    #SW.test = ShapiroTest(!!enquo(value), alpha)$test,
    nout = length(boxplot.stats(!!enquo(value))$out)
  )

nested_out <- out %>% 
  mutate(cdn = factor(CATEGORY)) %>%
  group_by(MARKERS) %>% 
  nest() 

stats_nested <- nested_out %>% group_by(MARKERS) %>%
  mutate(stats = map(data, ~sum_stats(.x, CATEGORY, value))) %>% 
  unnest(stats) %>% 
  dplyr::select(-'data') %>% 
  flextable() %>% 
  merge_v(j = 'MARKERS') %>% 
  colformat_double(digits = 2)

数据集示例 #

你提供的样例数据集结构如下：

structure(list(
  SAMPLE = c("A1", "A1", "A1", "A1", "A1", "A1"), 
  GROUP = c("AA", "AA", "AA", "AA", "AA", "AA"), 
  SESSION = c("L", "L", "L", "L", "L", "L"), 
  CATEGORY = c("LUM-ALT", "LUM-ALT", "LUM-ALT", "LUM-ALT", "LUM-ALT", "LUM-ALT"), 
  MARKERS = c("Z1(300-350).Fx", "Z1(300-350).Cx", "Z1(300-350).Px", 
              "QPP(600-800).Fx", "QPP(600-800).Cx", "QPP(600-800).Px"), 
  READING = c(5.2436729184, -3.1987456201, 9.8273642157, 
              4.1256789012, -2.8764532109, 7.5421367984)
), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"))

gtsummary实现代码 #

首先需要先加载依赖包：tidyverse、gtsummary、e1071，之后可通过以下代码实现完全一致的输出效果：

# 1. 定义适配gtsummary的自定义统计函数，完全复刻原有计算逻辑
custom_stats <- function(x, alpha = 0.05) {
  n <- length(x)
  sd_val <- sd(x, na.rm = TRUE)
  stderr <- sd_val / sqrt(n)
  t_crit <- qt(1 - alpha/2, n - 1)
  list(
    n = n,
    q1 = quantile(x, 1/4, type = 8, na.rm = TRUE),
    min = min(x, na.rm = TRUE),
    mean = mean(x, na.rm = TRUE),
    median = median(x, na.rm = TRUE),
    q3 = quantile(x, 3/4, type = 8, na.rm = TRUE),
    max = max(x, na.rm = TRUE),
    sd = sd_val,
    stderr = stderr,
    kurtosis = e1071::kurtosis(x, na.rm = TRUE),
    skewness = e1071::skewness(x, na.rm = TRUE),
    LCL = mean(x, na.rm = TRUE) - t_crit * stderr,
    UCL = mean(x, na.rm = TRUE) + t_crit * stderr,
    nout = length(boxplot.stats(x)$out)
  )
}

# 2. 生成统计表格
out %>%
  # 按MARKERS分层，实现相同MARKERS单元格自动合并效果
  tbl_strata(
    strata = MARKERS,
    .tbl_fun = ~ .x %>%
      tbl_summary(
        by = CATEGORY,
        include = READING,
        statistic = list(all_continuous() ~ custom_stats),
        digits = everything() ~ 2
      ) %>%
      modify_header(stat_1 = "**{level}**")
  ) %>%
  # 调整列结构
  modify_column_hide(columns = stratum) %>%
  modify_column_merge(pattern = "{strata}", rows = !is.na(strata)) %>%
  # 自定义表头
  modify_header(
    label = "**统计项**",
    stat_1 = "**统计值**"
  )

补充说明 #

• 若需要转为flextable格式做进一步样式调整，可在上述代码末尾添加as_flex_table()，直接兼容原有flextable的样式操作逻辑
• 注释掉的Shapiro检验项可以直接添加到custom_stats的返回列表中，无需调整其他逻辑

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