如何在R中批量计算分组内排除当前观测的变量均值？

环境信息 #

使用RStudio 2022.12.0+353 "Elsbeth Geranium"（Windows NT 10.0; Win64）及R版本4.2.2（2022-10-31 ucrt）

需求背景 #

处理Manifesto Project数据集，数据框包含209个变量、1190条观测，按edate（选举日期）分组，每组对应某国一次选举中的多个政党。需计算每组内指定变量（如示例中的econw）排除当前政党观测后的均值，用于对比政党与其他政党的议题关注度。

当前困境 #

此前通过手动编写代码实现单组计算（示例代码如下），但因分组数量过多需批量处理，尝试for循环和自定义函数时均失败，无法正确在均值计算中引用循环索引，现寻求可行解决方案。

示例数据 #

date <- c("1990-03-25", "1990-03-25", "1990-03-25", "1990-03-25", "1990-03-25", "1990-03-25", "1990-03-25", "1990-03-25", "1990-04-08", "1990-04-08", "1990-04-08", "1990-04-08", "1990-04-22", "1990-04-22", "1990-04-22", "1990-04-22", "1990-04-22", "1990-04-22", "1990-04-22", "1990-04-22", "1990-05-20", "1990-05-20", "1990-05-20", "1990-05-20", "1990-05-20", "1990-05-20", "1990-05-20", "1990-05-20", "1990-05-20", "1990-05-20", "1990-05-20", "1990-05-20", "1990-05-20", "1990-05-20")
party <- c("86220", "86320", "86421", "86422", "86521", "86522", "86810", "86811", "97220", "97320", "97421", "97810", "81111", "81112", "81220", "81221", "81222", "81229", "81420", "81711", "93111", "93112", "93221", "93222", "93320", "93430", "93521", "93523", "93524", "93529", "93711", "93714", "93719", "93951")
country <- c("86", "86", "86", "86", "86", "86", "86", "86", "97", "97", "97", "97", "81", "81", "81", "81", "81", "81", "81", "81", "93", "93", "93", "93", "93", "93", "93", "93", "93", "93", "93", "93", "93", "93")
countryname <- c("Hungary", "Hungary", "Hungary", "Hungary", "Hungary", "Hungary", "Hungary", "Hungary", "Slovenia", "Slovenia", "Slovenia","Slovenia", "Croatia", "Croatia", "Croatia", "Croatia", "Croatia", "Croatia", "Croatia", "Croatia", "Romania", "Romania", "Romania", "Romania", "Romania", "Romania", "Romania", "Romania", "Romania", "Romania", "Romania", "Romania", "Romania", "Romania")
econw <- c(0.211374468421053, 0.0495444789473684, 0.0883421052631579, 0.254285829473684, 0.288283657894737, 0.0914804, 0.214830792105263, 0, 0.219519663157895, 0.167761411578947, 0.16954572631579, "NA", "NA", "NA", "NA", "NA", "NA", 0.554445789473684, 0.412379641578948, 0.666462765263158, 0.043414707368421, 0.0141368757894737, 1.04711717157895, 0.0240855263157895, 0.00793917526315789, 0.219133023684211, 0.040332177368421, "NA", "NA", 0.00572921631578947, "NA", "NA", 0.0320958084210526, 0.0740951968421053)
# 修正原代码变量名错误，将date转为edate
mydata <- data.frame(edate = date, party, country, countryname, econw)
# 将字符串"NA"转换为R识别的缺失值NA
mydata$econw <- as.numeric(mydata$econw)

原手动实现代码示例 #

# 注：econwmean_1、econwmean_2为按edate分组后的子数据框
econwmean_cal_1 <- c(mean(econwmean_1$econw[which(econwmean_1$econw!=econwmean_1[1,32])], na.rm = TRUE),
                     mean(econwmean_1$econw[which(econwmean_1$econw!=econwmean_1[2,32])], na.rm = TRUE),
                     mean(econwmean_1$econw[which(econwmean_1$econw!=econwmean_1[3,32])], na.rm = TRUE),
                     mean(econwmean_1$econw[which(econwmean_1$econw!=econwmean_1[4,32])], na.rm = TRUE),
                     mean(econwmean_1$econw[which(econwmean_1$econw!=econwmean_1[5,32])], na.rm = TRUE),
                     mean(econwmean_1$econw[which(econwmean_1$econw!=econwmean_1[6,32])], na.rm = TRUE),
                     mean(econwmean_1$econw[which(econwmean_1$econw!=econwmean_1[7,32])], na.rm = TRUE))
econwmean_cal_2 <- c(mean(econwmean_2$econw[which(econwmean_2$econw!=econwmean_2[1,32])], na.rm = TRUE),
                     mean(econwmean_2$econw[which(econwmean_2$econw!=econwmean_2[2,32])], na.rm = TRUE),
                     mean(econwmean_2$econw[which(econwmean_2$econw!=econwmean_2[3,32])], na.rm = TRUE),
                     mean(econwmean_2$econw[which(econwmean_2$econw!=econwmean_2[4,32])], na.rm = TRUE),
                     mean(econwmean_2$econw[which(econwmean_2$econw!=econwmean_2[5,32])], na.rm = TRUE),
                     mean(econwmean_2$econw[which(econwmean_2$econw!=econwmean_2[6,32])], na.rm = TRUE),
                     mean(econwmean_2$econw[which(econwmean_2$econw!=econwmean_2[7,32])], na.rm = TRUE))

以下提供三种批量处理的实现方式，覆盖不同使用场景：

方法1：dplyr分组窗口函数（高效推荐） #

利用分组求和与计数的逻辑，避免逐行循环，计算效率最高：

library(dplyr)

mydata_processed <- mydata %>%
  group_by(edate) %>%
  mutate(
    # 计算分组总和减去当前行值（NA替换为0避免出错）
    sum_without = sum(econw, na.rm = TRUE) - replace_na(econw, 0),
    # 计算分组有效观测数减去当前行是否有效（非NA则减1，否则减0）
    count_without = sum(!is.na(econw)) - as.integer(!is.na(econw)),
    # 计算排除当前行后的均值，处理除数为0的情况
    econw_other_mean = ifelse(count_without == 0, NA, sum_without / count_without)
  ) %>%
  select(-sum_without, -count_without) %>%
  ungroup()

方法2：purrr遍历分组（灵活可控） #

适合需要对分组进行更多自定义操作的场景：

library(purrr)
library(dplyr)

# 按edate拆分数据为分组列表
grouped_list <- split(mydata, mydata$edate)

# 遍历每个分组，计算排除当前行的均值
processed_list <- map(grouped_list, function(df) {
  df$econw_other_mean <- map_dbl(1:nrow(df), function(i) {
    mean(df$econw[-i], na.rm = TRUE)
  })
  df
})

# 合并分组结果为完整数据框
mydata_processed <- bind_rows(processed_list)

方法3：基础R实现（无需额外包） #

不依赖第三方包，用基础R循环完成：

# 获取所有唯一选举日期
unique_dates <- unique(mydata$edate)

# 初始化结果列
mydata$econw_other_mean <- NA

# 遍历每个选举日期分组
for (dt in unique_dates) {
  group_rows <- mydata$edate == dt
  group_data <- mydata[group_rows, ]
  group_n <- nrow(group_data)
  
  # 遍历分组内每一行，计算排除当前行的均值
  for (i in 1:group_n) {
    mydata$econw_other_mean[group_rows][i] <- mean(group_data$econw[-i], na.rm = TRUE)
  }
}

内容的提问来源于stack exchange，提问作者Fırat EFE