在R的dplyr中基于多分组实现批量逐行平均的方案问询

场景与现有代码 #

我有一个包含Likert量表回答的随机数据框df，所有列是以q1、q2…q6命名的问题。另有一个数据框df2定义了问题的分组，例如q1、q2、q3属于A组，q4属于B组，q5、q6属于C组。我需要计算每组的逐行均值，例如结果数据框中需有列A存储q1、q2、q3的逐行均值。

已编写的手动指定分组的代码：

likert_levels <- c(1,2,3,4,5)
set.seed(42)
library(dplyr)
df <-
  tibble(
    "q1" = sample(likert_levels, 150, replace = TRUE),
    "q2" = sample(likert_levels, 150, replace = TRUE, prob = 5:1),
    "q3" = sample(likert_levels, 150, replace = TRUE, prob = 1:5),
    "q4" = sample(likert_levels, 150, replace = TRUE, prob = 1:5),
    "q5" = sample(c(likert_levels, NA), 150, replace = TRUE),
    "q6" = sample(likert_levels, 150, replace = TRUE, prob = c(1, 0, 1, 1, 0))
  ) %>%
  mutate(across(everything(), ~ factor(.x, levels = likert_levels)))

df
df2 = tibble(categories = c("A","A","A","B","C","C"),
             questions = c("q1","q2","q3","q4","q5","q6"))

df2
df%>%
  mutate(id = row_number())%>%
  tidyr::pivot_longer(!id,names_to = "questions",values_to = "responses")%>%
  left_join(.,df2,by="questions")

df_cor=df%>%
  mutate_if(is.factor,as.double)%>%
  rowwise() %>%
  mutate(QA = mean(c(q1, q2, q3),na.rm=TRUE),
         QB = mean(c(q4),na.rm=TRUE),
         QC = mean(c(q5, q6),na.rm=TRUE))%>%
  select(QA,QB,QC)
df_cor

问题 #

实际数据集包含100个问题和20余个分组，如何避免手动编写rowwise均值的mutate语句，实现自动批量处理？

解决方案 #

方法一：长格式转宽格式批量计算

利用tidyr的重塑函数，通过长格式处理自动关联分组并计算均值，无需手动指定分组：

library(dplyr)
library(tidyr)

# 转换因子为数值并添加行标识
df_processed <- df %>%
  mutate(across(everything(), as.double),
         id = row_number()) %>%
  # 转为长格式关联分组信息
  pivot_longer(-id, names_to = "questions", values_to = "responses") %>%
  left_join(df2, by = "questions") %>%
  # 按行和分组计算均值
  group_by(id, categories) %>%
  summarise(mean_value = mean(responses, na.rm = TRUE), .groups = "drop") %>%
  # 转回宽格式生成分组均值列
  pivot_wider(names_from = categories, values_from = mean_value, names_prefix = "Q")

# 输出最终结果（去掉id列）
df_processed %>% select(-id)

方法二：宽格式下动态生成均值列

从df2中提取分组与问题的映射关系，循环生成每个分组的均值计算逻辑：

library(dplyr)

# 转换因子为数值
df_numeric <- df %>% mutate(across(everything(), as.double))

# 提取每个分组对应的问题列表
group_questions <- df2 %>%
  group_by(categories) %>%
  summarise(questions = list(questions), .groups = "drop")

# 批量生成分组均值列
df_result <- df_numeric
for (row in 1:nrow(group_questions)) {
  group_name <- group_questions$categories[row]
  q_list <- group_questions$questions[row][[1]]
  df_result <- df_result %>%
    mutate(!!paste0("Q", group_name) := rowMeans(across(all_of(q_list)), na.rm = TRUE))
}

# 只保留分组均值列
df_result %>% select(starts_with("Q"))

两种方法均可自动适配任意数量的分组与问题，无需手动修改核心逻辑。方法一符合tidyverse风格，可读性更强；方法二直接在宽格式下操作，适合习惯宽格式数据的场景。

内容的提问来源于stack exchange，提问作者Homer Jay Simpson