如何在R中用apply函数对按因子拆分的数据集批量拟合lm()回归？

嘿，这个需求太实用了！不用重复写lm()，用Base R里的split() + lapply()组合就能轻松搞定，我给你一步步说明：

步骤1：按County拆分数据集 #

首先把你的住房数据按county因子分割成一个列表，每个列表元素对应一个County的子数据集：

# 替换your_data为你的实际数据集名称
data_by_county <- split(your_data, your_data$county)

这样data_by_county就是一个长度为9的列表（因为你的county有9个水平），每个元素是对应County的所有行数据。

步骤2：用lapply批量拟合回归模型 #

接下来用lapply()遍历这个列表，对每个子数据集拟合price ~ bsqft的回归模型：

# 批量拟合模型
county_models <- lapply(data_by_county, function(sub_df) {
  lm(price ~ bsqft, data = sub_df)
})

现在county_models就是一个模型列表，每个元素的名称对应County的水平，比如你可以用county_models$Orange（假设Orange是其中一个County）查看对应模型。

进阶：查看结果与处理异常 #

查看单个模型的详细结果 #

要查看某个County的回归结果，直接用summary()：

# 查看第一个County的模型摘要
summary(county_models[[1]])
# 或者按County名称查看
summary(county_models$LosAngeles)

批量提取模型系数 #

如果想快速对比所有County的回归系数，可以用sapply()提取：

# 提取所有模型的截距和斜率
coefficients <- sapply(county_models, coef)
# 转置后更易读
t(coefficients)

处理异常情况 #

如果某个County的bsqft没有变异（比如所有房屋面积都一样），lm()会报错。可以在拟合前加个判断避免这种情况：

county_models_safe <- lapply(data_by_county, function(sub_df) {
  # 检查bsqft是否有足够变异（避免浮点误差用1e-6）
  if (var(sub_df$bsqft) > 1e-6) {
    lm(price ~ bsqft, data = sub_df)
  } else {
    warning(paste("County", unique(sub_df$county), "无bsqft变异，跳过拟合"))
    NULL
  }
})

这样就完美实现了批量拟合，不用重复写9次lm()啦！

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