如何无循环实现数据集列的类group_by分析并输出单表结果

现有一份采用李克特量表（1-7分）的问卷数据：

set.seed(1234)
results <- data.frame(
  user = paste0("V", 1:10),
  measurement = "0m",
  q1 = sample(1:7, size = 10, replace = TRUE),
  q2 = sample(1:7, size = 10, replace = TRUE),
  q3 = sample(1:7, size = 10, replace = TRUE),
  q4 = sample(1:7, size = 10, replace = TRUE),
  q5 = sample(1:7, size = 10, replace = TRUE),
  q6 = sample(1:7, size = 10, replace = TRUE)
)

这是第0次测量数据，每行代表一位用户对q1至q6的作答。

> as_tibble(results) %>% head()
# A tibble: 6 × 8
  user  measurement    q1    q2    q3    q4    q5    q6
  <chr> <chr>       <int> <int> <int> <int> <int> <int>
1 V1    0m              4     2     6     2     1     1
2 V2    0m              2     7     4     5     3     6
3 V3    0m              6     6     4     2     6     3
4 V4    0m              5     2     5     6     4     6
5 V5    0m              4     6     4     7     2     1
6 V6    0m              7     7     3     3     3     5

我们将得分<6标记为"bad"，其余标记为"good"，预处理数据如下：

classifications <- dplyr::mutate(
  results,
  across(
    where(is.numeric),
    ~case_when(
      .x < 6 ~ "bad",
      TRUE ~ "good"
    )
  )
)
data <- left_join(
  results,
  classifications,
  by = c("user", "measurement"),
  suffix = c("_score", "_class")
)

> as_tibble(data) %>% head()
# A tibble: 6 × 14
  user  measurement q1_score q2_score q3_score q4_score q5_score q6_score q1_class q2_class q3_class q4_class q5_class q6_class
  <chr> <chr>          <int>    <int>    <int>    <int>    <int>    <int> <chr>    <chr>    <chr>    <chr>    <chr>    <chr>   
1 V1    0m                 4        2        6        2        1        1 bad      bad      good     bad      bad      bad     
2 V2    0m                 2        7        4        5        3        6 bad      good     bad      bad      bad      good    
3 V3    0m                 6        6        4        2        6        3 good     good     bad      bad      good     bad     
4 V4    0m                 5        2        5        6        4        6 bad      bad      bad      good     bad      good    
5 V5    0m                 4        6        4        7        2        1 bad      good     bad      good     bad      bad     
6 V6    0m                 7        7        3        3        3        5 good     good     bad      bad      bad      bad     

针对特定问题（如q2），需要分析"good"类用户在其他所有问题上的平均得分，以及"bad"类用户的对应平均得分，示例代码及结果如下：

> group_by(data, measurement, q2_class) %>% summarise(across(where(is.numeric), mean))
# A tibble: 2 × 8
# Groups:   measurement [1]
  measurement q2_class q1_score q2_score q3_score q4_score q5_score q6_score
  <chr>       <chr>       <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>
1 0m          bad          4.67     2.67     6        4        3.33     2.67
2 0m          good         4.29     6.29     4.43     4.43     4.14     2.71

现在需要对所有问题执行上述分析，并将结果合并为一张表。目前已有循环实现方案，但希望采用向量化方法。若将group_by(...) %>% summarise()封装为函数并通过across()调用，会得到单元格均为数据框的结果；了解到可使用nest()但不熟悉其用法。

该分析将应用于大型数据集（10万用户、约70个问题），需找到高效优化方案，同时疑问：针对此类数据集，循环方案是否与向量化方案效率相当？

期望输出示例（将q1、q2的分析结果合并）：

> rbindlist(list("q1" = tmp, "q2" = tmp), idcol = "question") %>% as_tibble()
# A tibble: 4 × 9
  question measurement class    q1_score q2_score q3_score q4_score q5_score q6_score
  <chr>    <chr>       <chr>       <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>
1 q1       0m          bad          4.67     2.67     6        4        3.33     2.67
2 q1       0m          good         4.29     6.29     4.43     4.43     4.14     2.71
3 q2       0m          bad          4.67     2.67     6        4        3.33     2.67
4 q2       0m          good         4.29     6.29     4.43     4.43     4.14     2.71

方法一：用purrr::map_dfr实现批量向量化处理 #

先提取所有问题名称，再对每个问题执行分组汇总，最后自动合并结果：

library(dplyr)
library(purrr)
library(stringr)

# 提取所有问题前缀（q1~q6）
questions <- str_subset(names(data), "_score$") %>% 
  str_remove("_score$")

# 批量处理每个问题
final_result <- map_dfr(questions, function(q) {
  group_by(data, measurement, !!sym(paste0(q, "_class"))) %>%
    summarise(across(ends_with("_score"), mean), .groups = "drop") %>%
    rename(class = !!sym(paste0(q, "_class"))) %>%
    mutate(question = q) %>%
    select(question, measurement, class, everything())
})

# 查看最终结果
final_result

该方法利用map_dfr自动按行绑定结果，避免手动循环拼接，代码简洁且保持向量化特性。

方法二：长格式重塑处理（适合大型数据集） #

将宽格式数据转为长格式后分组计算，再转回宽格式，内部优化更高效：

library(tidyr)

# 拆分得分和分类数据为长格式
scores_long <- data %>%
  select(user, measurement, ends_with("_score")) %>%
  pivot_longer(ends_with("_score"), 
               names_to = "target_q", 
               values_to = "score",
               names_pattern = "(q\\d+)_score")

class_long <- data %>%
  select(user, measurement, ends_with("_class")) %>%
  pivot_longer(ends_with("_class"), 
               names_to = "group_q", 
               values_to = "class",
               names_pattern = "(q\\d+)_class")

# 合并后分组计算均值，再转回宽格式
final_result_long <- inner_join(scores_long, class_long, by = c("user", "measurement")) %>%
  group_by(group_q, measurement, class, target_q) %>%
  summarise(mean_score = mean(score), .groups = "drop") %>%
  pivot_wider(names_from = target_q, 
              values_from = mean_score,
              names_glue = "{target_q}_score") %>%
  rename(question = group_q) %>%
  select(question, measurement, class, everything())

final_result_long

长格式处理在大型数据集上效率更高，因为dplyr和tidyr对长表操作的内存分配和计算逻辑做了优化，减少重复开销。

效率对比：循环 vs 向量化 #

针对10万用户、70个问题的场景：

• 普通for循环如果每次迭代都用rbind拼接结果，会因频繁复制数据框导致效率极低，时间复杂度接近O(n²)。
• 优化后的循环（先存列表最后一次性绑定）效率接近向量化方法，但代码可读性和维护性差。
• map_dfr或长格式处理的向量化方案，内部预先分配内存，时间复杂度为O(n)，效率远高于普通循环，且代码更简洁。

优先选择上述两种向量化方案，兼顾效率和可维护性。

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