嵌套数据下map2与rstandard获取标准化残差的报错解决及拆嵌套方法

问题背景 #

你通过以下代码生成嵌套数据：

data_nested <- data_model2 %>%  
  group_by(NAPLAN_YEAR, Year_Level, DOMAIN_NAME) %>%  
  nest()

随后尝试拟合线性回归并提取标准化残差，代码如下：

data_nested <- data_nested %>%
  mutate(
    model1 = map(data, ~ lm(
      SCALE_SCORE_0~TWO_YEAR_PRIOR_SCALE_SCORE_0+PV1.Dim1, 
      data=.x, na.action=na.exclude)),
    # 残差计算
    stand_resids1 = map2(data, model1, ~rstandard(data=.x))
)

遇到两个问题：

• 用map调用rstandard时，代码能运行但拆嵌套时R程序冻结
• 用map2时直接报错：Caused by error in UseMethod(): ! no applicable method for 'rstandard' applied to an object of class "c('tbl_df', 'tbl', 'data.frame')"

错误原因 #

1. map2调用错误：rstandard()的输入必须是lm模型对象，但你写的rstandard(data=.x)中，.x对应map2的第一个参数data（即数据框），自然会触发类型不匹配的报错。
2. map调用后的拆嵌套卡顿：因为你用na.action=na.exclude拟合模型，rstandard()返回的残差数量会小于原数据行数（缺失值行被排除），拆嵌套时因行号无法准确对齐，导致R处理大量不匹配数据时卡顿。

正确解决方案 #

方案一：保留所有原始行（含缺失值对应NA） #

这个方案会将残差与原数据精准对齐，缺失值对应的残差位置填充NA，避免拆嵌套时的行不匹配问题：

library(tidyverse)

# 生成嵌套数据
data_nested <- data_model2 %>%  
  group_by(NAPLAN_YEAR, Year_Level, DOMAIN_NAME) %>%  
  nest()

# 拟合模型并合并残差到原数据
data_nested <- data_nested %>%
  mutate(
    # 拟合线性模型
    model1 = map(data, ~ lm(
      SCALE_SCORE_0 ~ TWO_YEAR_PRIOR_SCALE_SCORE_0 + PV1.Dim1, 
      data = .x, na.action = na.exclude
    )),
    # 提取残差并与原数据绑定，对齐行号
    data_with_resids = map2(data, model1, function(df, mod) {
      # 提取带原始行号的残差
      resid_df <- tibble(
        stand_resids = rstandard(mod),
        .row = as.integer(names(rstandard(mod)))
      )
      # 合并到原数据，缺失残差的行填NA
      df %>%
        mutate(.row = row_number()) %>%
        left_join(resid_df, by = ".row") %>%
        select(-.row)
    })
  )

# 安全拆嵌套，保留需要的列
final_data <- data_nested %>%
  select(-data, -model1) %>%
  unnest(data_with_resids)

方案二：仅保留有残差的行（简化版） #

如果不需要保留原数据中被模型排除的缺失值行，可以用更简洁的写法：

data_nested <- data_nested %>%
  mutate(
    model1 = map(data, ~ lm(
      SCALE_SCORE_0 ~ TWO_YEAR_PRIOR_SCALE_SCORE_0 + PV1.Dim1, 
      data = .x, na.action = na.exclude
    )),
    # 直接从模型提取残差并转为 tibble
    stand_resids = map(model1, ~ tibble(stand_resids = rstandard(.x)))
  )

# 拆嵌套，合并原数据与残差
final_data <- data_nested %>%
  unnest(c(data, stand_resids))

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