R语言分组线性回归拟合值与预测结果合并到单一数据框

核心思路 #

• 按country和Area两个字段对原始数据分组
• 每组单独拟合amount ~ week的线性回归模型
• 每组生成包含1-6周的预测数据集，计算拟合值、预测值及95%预测区间
• 所有组的结果合并为同一个数据框

方案1：tidyverse生态实现（推荐，代码简洁易维护） #

需要先加载tidyverse包：

library(tidyverse)

# 原始示例数据
data <- data.frame(country = c("US","US","US","US","US","US","US","US","US","US","UK","UK","UK","UK","UK"),
               Area = c("G","G","G","G","G","I","I","I","I","I","A","A","A","A","A"),
               week = c(1,2,3,4,5,1,2,3,4,5,1,2,3,4,5),amount = c(12,23,34,32,12,12,34,45,65,45,45,34,23,43,43))

# 分组计算
result <- data %>%
  # 按国家和区域分组
  group_by(country, Area) %>%
  # 每组数据嵌套为单独的子数据框
  nest() %>%
  mutate(
    # 每组拟合线性模型
    model = map(data, ~ lm(amount ~ week, data = .x)),
    # 生成每组1-6周的预测用数据
    pred_data = map(data, ~ bind_rows(.x, data.frame(week = 6, amount = NA))),
    # 计算预测结果+95%预测区间
    pred_result = map2(model, pred_data, ~ predict(.x, newdata = .y, interval = "prediction", level = 0.95) %>% as.data.frame())
  ) %>%
  # 把预测数据和预测结果合并，解嵌套为总表
  unnest(c(pred_data, pred_result)) %>%
  # 保留需要的字段，调整顺序
  select(country, Area, week, amount, fit, lwr, upr)

# 查看最终结果
print(result, n = Inf)

输出字段说明：

• fit：前5周为拟合值，第6周为预测值
• lwr/upr：95%预测区间的上下限

方案2：base R 循环实现（无需额外依赖包） #

# 原始示例数据
data <- data.frame(country = c("US","US","US","US","US","US","US","US","US","US","UK","UK","UK","UK","UK"),
               Area = c("G","G","G","G","G","I","I","I","I","I","A","A","A","A","A"),
               week = c(1,2,3,4,5,1,2,3,4,5,1,2,3,4,5),amount = c(12,23,34,32,12,12,34,45,65,45,45,34,23,43,43))

# 提取所有唯一的国家-区域组合
group_df <- unique(data[, c("country", "Area")])
result <- data.frame()

# 循环遍历每个组合
for (i in 1:nrow(group_df)) {
  cty <- group_df$country[i]
  area <- group_df$Area[i]
  # 筛选当前组数据
  sub_data <- data[data$country == cty & data$Area == area, ]
  # 拟合模型
  model <- lm(amount ~ week, data = sub_data)
  # 生成1-6周预测数据
  pred_data <- rbind(sub_data, data.frame(country = cty, Area = area, week = 6, amount = NA))
  # 计算预测结果
  pre <- predict(model, newdata = pred_data, interval = "prediction", level = 0.95)
  # 合并到总结果
  res_df <- cbind(pred_data, pre)
  result <- rbind(result, res_df)
}

# 查看最终结果
print(result, row.names = FALSE)

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