如何将lm.augment输出的学生化残差列合并至原始数据集

我在Power Query里用下面的R代码，能成功生成用来标记大数据集异常值的学生化残差，输出的df对象包含group列和augment输出的学生化残差列。现在想直接把这个残差列加到有2000万行的原始数据集中，不想维护两个大表，求帮忙！

原R代码 #

library(tidyverse)
library(broom)

dataset <- as.data.frame(dataset)
dataset$perf <- as.numeric(dataset$perf)
dataset$factor1 <- as.factor(dataset$factor1)
dataset$factor2 <- as.factor(dataset$factor2)

df <- dataset %>%
  group_by(group) %>% 
  mutate(unique_factor1 = n_distinct(factor1), unique_factor2 = n_distinct(factor2), var = var(perf)) %>% 
  filter( unique_factor1 != 1 & unique_factor2 != 1 & var != 0 ) %>%
  do(cbind(group = .$group, lm(perf ~ factor1 + factor2, data = .) %>% augment))

示例数据集 #

优化后的代码（适配2000万行数据） #

原代码用do()处理大数据效率太低，而且会过滤掉不符合条件的组，导致数据拆分。换成nest()+map()的组合，既能保留所有原始行，又能提升运行效率：

library(tidyverse)
library(broom)

# 先做数据预处理，和原代码逻辑一致
dataset <- as.data.frame(dataset) %>%
  mutate(
    perf = as.numeric(perf),
    factor1 = as.factor(factor1),
    factor2 = as.factor(factor2)
  )

# 分组计算残差并合并回原始数据
result <- dataset %>%
  group_by(group) %>%
  # 先判断每组是否符合建模条件
  mutate(
    unique_factor1 = n_distinct(factor1),
    unique_factor2 = n_distinct(factor2),
    var_perf = var(perf, na.rm = TRUE)
  ) %>%
  # 把每组数据嵌套起来，方便批量处理
  nest() %>%
  mutate(
    # 只给符合条件的组计算残差，不符合的设为NA
    residuals = map(data, ~{
      if (.x$unique_factor1[1] != 1 & .x$unique_factor2[1] != 1 & .x$var_perf[1] != 0) {
        lm(perf ~ factor1 + factor2, data = .x) %>%
          augment() %>%
          select(.studentized.resid)
      } else {
        tibble(.studentized.resid = NA_real_)
      }
    })
  ) %>%
  # 展开嵌套数据，把残差列合并回去
  unnest(c(data, residuals)) %>%
  # 删掉临时计算的列
  select(-unique_factor1, -unique_factor2, -var_perf) %>%
  ungroup()

核心优化说明 #

• 用nest()+map()替代do()：避免do()在大数据下的内存瓶颈，运行速度更快
• 保留所有原始行：不会像原代码那样过滤掉不符合条件的组，这些组的残差设为NA，不用维护两个表
• 清理冗余列：自动去掉临时计算的判断列，结果表和原始表结构一致，只多了学生化残差列

Power Query使用提示 #

• 确保已经在Power Query里启用了R脚本功能，且本地R环境装了tidyverse和broom包
• 处理2000万行数据时，建议在R脚本开头加一行memory.limit(size = 64000)（数值根据自己机器内存调整），避免内存不足

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