R语言动态按多列组计算行均值的高效替代方案

需求背景 #

需要按列组自动计算每行均值：不同列组对应不同量表的题项，列名统一遵循「量表前缀_题号」的命名规则，实际场景中可能存在个别题项缺失的情况。

测试数据构造 #

使用如下代码生成10000行模拟数据，包含G、MOT、VAR三个量表的题项，其中VAR量表缺失VAR_3列：

#library(tidyverse)
set.seed(123)
df <- tibble(  G_1 =  sample(1:5, size = 10000, replace = TRUE),
               G_2 =  sample(1:5, size = 10000, replace = TRUE),
               G_3 =  sample(1:5, size = 10000, replace = TRUE),
             MOT_1 =  sample(1:5, size = 10000, replace = TRUE),
             MOT_2 =  sample(1:5, size = 10000, replace = TRUE),
             MOT_3 =  sample(1:5, size = 10000, replace = TRUE),
             VAR_1 =  sample(1:5, size = 10000, replace = TRUE),
             VAR_2 =  sample(1:5, size = 10000, replace = TRUE),
             VAR_4 =  sample(1:5, size = 10000, replace = TRUE))

目标输出 #

为每个量表自动生成命名格式为mean_量表前缀的均值列，存储对应列组的行均值，期望输出结构如下：

# A tibble: 6 x 12
    G_1   G_2   G_3 MOT_1 MOT_2 MOT_3 VAR_1 VAR_2 VAR_4 mean_G mean_MOT mean_VAR
  <int> <int> <int> <int> <int> <int> <int> <int> <int>  <dbl>    <dbl>    <dbl>
1     3     3     1     1     1     1     1     5     4   2.33     1        3.33
2     3     5     3     3     2     1     4     3     5   3.67     2        4   
3     2     5     4     5     3     2     4     1     1   3.67     3.33     2   
4     2     5     4     4     4     1     2     5     4   3.67     3        3.67
5     3     4     2     1     4     5     2     2     3   3        3.33     2.33
6     5     3     4     4     3     4     1     1     4   4        3.67     2   

现有方案缺陷 #

目前已实现两种方案，结果完全一致但各有明显缺陷：

• 动态函数式方案：基于rowwise()、c_across()搭配purrr实现，无需硬编码列名即可适配不同数据框，但运行速度极慢。核心问题是rowwise()会在R层面逐行执行运算，没有利用向量化性能，1万行测试数据平均耗时超48秒。

# 慢的动态方案
#get list of variable prefixes
var_names <- str_extract(names(df), "^.*(?=(_))") %>% 
  unique()

#use map and c_across to calculate the means rowwise per variable group
df_functional <-
      df %>% 
      bind_cols(
        map_dfc(.x = var_names, 
                .f = ~ .y %>% 
                  rowwise() %>% 
                  transmute(!!str_c("mean_", .x) := mean(c_across(starts_with(.x)))),
                .y = .))

• 手动硬编码方案：手动编写mutate+rowMeans实现，rowMeans是底层C实现的向量化函数，运行速度极快，同等数据量平均耗时仅27毫秒，但需要手动指定每个量表对应的列，无法适配列动态变化的场景。

# 快但无法动态适配的手动方案
df_manual <- df %>% mutate(mean_G   = rowMeans(select(., G_1,   G_2,   G_3)),
                             mean_MOT = rowMeans(select(., MOT_1,   MOT_2,   MOT_3)),
                             mean_VAR = rowMeans(select(., VAR_1,   VAR_2,   VAR_4)))

两种方案的基准测试结果如下，性能差距超千倍：

> identical(df_manual, df_functional)
[1] TRUE

#Benchmark (using the microbenchmark package)
benchmark
Unit: milliseconds
       expr        min         lq        mean     median         uq        max neval
 functional 37198.3569 38592.6855 48313.00156 52936.3254 55349.0561 59831.0141   100
     manual    16.0662    18.0139    27.53403    19.9085    22.9384   138.5401   100

实际业务中数据框包含的量表、题项数量更多，且不同数据框的列组成存在变动，硬编码方案无法复用，需要兼顾动态适配能力和运行效率的实现方法。

高性能动态方案 #

核心思路是保留rowMeans的向量化高性能特性，同时通过前缀匹配动态选择列，避免rowwise()带来的R层面逐行运算开销，实现代码如下：

library(tidyverse)
# 提取所有不重复的量表前缀
var_names <- str_extract(names(df), "^.*(?=_)") %>% 
  unique()

# 动态向量化计算，性能和手动硬编码基本一致
df_fast <- df %>%
  bind_cols(
    map_dfc(.x = var_names, .f = ~{
      # 对每个前缀，动态匹配对应列，调用向量化的rowMeans计算
      tibble(!!str_c("mean_", .x) := rowMeans(select(df, starts_with(.x)), na.rm = TRUE))
    })
  )

该方案特性：

• 无需硬编码任何列名，自动识别所有量表前缀，自动适配题项缺失、量表增减的场景
• 全程使用向量化运算，性能和手动硬编码方案处于同一量级，1万行数据耗时仅20-30毫秒
• 增加na.rm = TRUE参数，可自动处理个别题项值为NA的情况
• 计算结果和原有两种方案完全一致

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