分组线性回归beta值全为NA，截距正常，求修复方案

问题现象 #

使用group_by分组后拟合线性回归，所有子组的beta列均显示为NA，仅截距能正常获取数值。

问题原因 #

1. 位置索引不可靠：原代码用lr$coefficients[2]获取price的系数，若模型因数据问题（如price无变异）导致price系数为NA，或系数顺序意外变化，会直接返回NA。
2. 判断条件不全：原代码仅过滤系数长度小于2的情况，但无法处理price系数本身为NA的场景（比如分组内price值完全相同，无法估计斜率）。

修复方案 #

方案1：优化原函数，增加数据校验与命名索引

修改fit_lm函数，提前过滤无效分组，并用命名索引替代位置索引：

fit_lm <- function(df) {
  # 过滤样本量不足或price无变异的分组
  if(nrow(df) < 2 || var(df$price, na.rm = TRUE) == 0) {
    return(c(beta = NA, intercept = NA))
  }
  
  lr <- lm(num_transactions ~ price, data = df)
  
  # 用命名索引获取系数，避免位置错误
  beta <- as.numeric(lr$coefficients["price"])
  intercept <- as.numeric(lr$coefficients["(Intercept)"])
  
  # 处理系数为NA的极端情况
  if(is.na(beta)) {
    return(c(beta = NA, intercept = intercept))
  }
  
  return(c(beta = beta, intercept = intercept))
}

# 原调用逻辑保持不变
pred_sales_by_col <- machine_info %>%
  group_by(product_name, small_machine, column) %>%
  summarize(model_results = list(fit_lm(cur_data())), .groups = "drop") %>%
  mutate(beta = sapply(model_results, function(x) x["beta"]),
         intercept = sapply(model_results, function(x) x["intercept"])) %>%
  select(-model_results)

方案2：使用dplyr嵌套语法（更简洁）

用nest_by替代传统分组+列表存储的方式，代码更简洁易维护：

pred_sales_by_col <- machine_info %>%
  # 按指定列分组并嵌套数据
  nest_by(product_name, small_machine, column) %>%
  # 拟合模型并提取系数
  mutate(
    model = list(lm(num_transactions ~ price, data = data)),
    beta = coef(model)[["price"]],
    intercept = coef(model)[["(Intercept)"]]
  ) %>%
  # 移除不需要的列并取消分组
  select(-data, -model) %>%
  ungroup()

额外检查建议 #

如果修复后仍有大量NA，建议先检查分组数据的price变异情况：

machine_info %>%
  group_by(product_name, small_machine, column) %>%
  summarize(
    sample_count = n(),
    price_variance = var(price, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  filter(sample_count < 2 || price_variance == 0)

上述代码会找出所有无法估计有效beta的分组，方便针对性处理数据。

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