在R中按组剔除离群重复样本后重新计算列均值的需求

问题背景 #

我有一份数据集：

• 共80行，分为16个分组，每组固定5行
• 包含1000+列，第一列为class分组列

需要完成以下操作：

1. 对所有数值列计算每个分组的初始均值
2. 针对每个数值列，计算组内每行与均值的绝对差值，剔除差值最大的行
3. 用剩余4行重新计算该分组对应数值列的均值，得到剔除离群行后的结果

示例数据 #

原示例数据：

class    Values1    Values2   
    A1      A        5        10
    A2      A        7        72
    A3      A        4         8 
    A4      A        4        10
    A5      A       30        10
    B1      B       10        20
    B2      B       12        18
    B3      B       70        15
    B4      B       15       100
    B5      B       16        20
    C1      C      120         5
    C2      C       20         2
    C3      C       25        72
    C4      C       21         8
    C5      C       22         3

预期结果（新增剔除离群行后的分组均值）：

row_id class Values1 Values2
     A1     A    5.00   10.00
     A2     A    7.00   72.00
     A3     A    4.00    8.00
     A4     A    4.00   10.00
     A5     A   30.00   10.00
     B1     B   10.00   20.00
     B2     B   12.00   18.00
     B3     B   70.00   15.00
     B4     B   15.00  100.00
     B5     B   16.00   20.00
     C1     C  120.00    5.00
     C2     C   20.00    2.00
     C3     C   25.00   72.00
     C4     C   21.00    8.00
     C5     C   22.00    3.00
   MeanA  <NA>    5.00    9.50
   MeanB  <NA>   13.25   18.25
   MeanC  <NA>   22.00    4.50

解决方案 #

1. 依赖包准备 #

使用dplyr做数据分组处理，purrr做批量列操作：

install.packages(c("dplyr", "purrr"))
library(dplyr)
library(purrr)

2. 数据导入（或模拟） #

如果是真实数据集，直接用read.csv()或对应函数导入；这里先模拟示例数据：

df <- data.frame(
  row_id = c("A1", "A2", "A3", "A4", "A5", "B1", "B2", "B3", "B4", "B5", "C1", "C2", "C3", "C4", "C5"),
  class = rep(c("A", "B", "C"), each = 5),
  Values1 = c(5,7,4,4,30,10,12,70,15,16,120,20,25,21,22),
  Values2 = c(10,72,8,10,10,20,18,15,100,20,5,2,72,8,3)
)

3. 核心处理逻辑 #

定义函数批量处理每个数值列，实现"初始均值计算→剔除离群行→重新计算均值"的流程：

# 单个数值列的处理函数
process_single_col <- function(col_name, data) {
  data %>%
    group_by(class) %>%
    mutate(
      current_val = .data[[col_name]],
      group_mean = mean(current_val, na.rm = TRUE),
      abs_diff = abs(current_val - group_mean)
    ) %>%
    slice(-which.max(abs_diff)) %>%  # 剔除差值最大的行
    summarise(!!col_name := mean(current_val, na.rm = TRUE)) %>%
    ungroup()
}

# 获取所有数值列（排除非数值列，这里排除row_id和class）
numeric_cols <- setdiff(names(df), c("row_id", "class"))

# 批量处理所有数值列并合并结果
final_group_means <- numeric_cols %>%
  map(~process_single_col(.x, df)) %>%
  reduce(full_join, by = "class")

# 整理成示例中的格式（添加Mean前缀行）
final_group_means <- final_group_means %>%
  mutate(row_id = paste0("Mean", class)) %>%
  select(row_id, class, everything()) %>%
  mutate(class = NA)  # 对应示例中的NA

4. 合并原始数据与结果 #

将原始数据和新计算的均值合并，得到最终输出：

result <- bind_rows(df, final_group_means)

# 打印验证
print(result, row.names = FALSE)

关键说明 #

• 每个数值列独立处理，确保不同列可以剔除组内不同的离群行（如示例中A组Values1剔除A5，Values2剔除A2）
• 批量处理逻辑支持1000+列的大规模数据，无需手动逐个列处理
• 保留原始数据结构，最终结果与示例格式完全匹配

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