如何基于数据框列组合为受试者批量计算线性模型并预测？

场景说明 #

我有如下结构的数据框，包含受试者ID列subject、预测列xpred以及三个响应列y1、y2、y3。为了拟合线性模型，已对xpred到y3的所有列做了对数转换（后缀为_log）。

suppressWarnings(library(tidyverse))

# 创建示例数据
set.seed(10)
df <- data.frame(
  subject = rep(paste("Subject", LETTERS[1:5]), each = 10),
  xpred = rep(1:10, 5),
  y1 = sort(runif(10, min = 130, max = 220), decreasing = TRUE),
  y2 = sort(runif(10, min = 10, max = 90), decreasing = TRUE),
  y3 = sort(runif(10, min = 2, max = 5), decreasing = TRUE)
)

# 对xpred到y3列做对数转换
df <- df %>%
  group_by(subject) %>%
  mutate(across(.cols = xpred:y3, .fns = ~log(.x), .names = "{col}_log")) %>%
  ungroup()

head(df)
#> # A tibble: 6 × 9
#>   subject   xpred    y1    y2    y3 xpred_log y1_log y2_log y3_log
#>   <chr>     <int> <dbl> <dbl> <dbl>     <dbl>  <dbl>  <dbl>  <dbl>
#> 1 Subject A     1  192.  76.9  4.59     0       5.26   4.34   1.52
#> 2 Subject A     2  185.  62.1  4.51     0.693   5.22   4.13   1.51
#> 3 Subject A     3  176.  57.7  4.33     1.10    5.17   4.05   1.46
#> 4 Subject A     4  169.  55.4  4.31     1.39    5.13   4.01   1.46
#> 5 Subject A     5  168.  44.3  4.12     1.61    5.13   3.79   1.42
#> 6 Subject A     6  158.  41.9  3.85     1.79    5.06   3.74   1.35

需求描述 #

目前可以单独为某个受试者拟合模型（例如Subject A的y1_log ~ xpred_log），但需要为每个受试者批量拟合三个模型：y1_log ~ xpred_log、y2_log ~ xpred_log、y3_log ~ xpred_log。

单独处理的示例代码：

# 筛选单个受试者数据
df_subset <- df %>% filter(subject == "Subject A")

# 拟合模型
model <- lm(df_subset$y1_log ~ df_subset$xpred_log)

# 提取系数用于预测：c = exp(截距), n = 斜率
c <- unname(exp(model$coefficients["(Intercept)"]))
n <- unname(model$coefficients["df_subset$xpred_log"])

现有数据中xpred范围是1-10，对应的y1:y3值已知。需要将xpred扩展到1-30，用公式c*x^n（x为xpred值）预测11-30对应的y1:y3值，最终输出包含每个受试者xpred1-30的整洁数据框。

解决方案 #

可以通过数据重塑+分组建模的方式批量处理，步骤如下：

• 将数据转换为长格式，整合多列y变量，方便批量处理
• 按受试者和响应变量分组，拟合对数线性模型并提取系数
• 生成每个受试者xpred1-30的序列，结合系数计算预测值
• 合并已知值和预测值，转换回宽格式得到最终结果

完整代码 #

library(tidyverse)

# 1. 转换为长格式，整合y变量
df_long <- df %>%
  pivot_longer(
    cols = starts_with("y"),
    names_to = "y_var",
    values_to = "y_value",
    names_pattern = "(y\\d)"
  ) %>%
  pivot_longer(
    cols = ends_with("_log"),
    names_to = c(".value", "transform"),
    names_sep = "_"
  ) %>%
  select(subject, xpred, y_var, y_value, xpred_log, y_log)

# 2. 分组拟合模型，提取系数c和n
model_coeffs <- df_long %>%
  group_by(subject, y_var) %>%
  summarise(
    model = list(lm(y_log ~ xpred_log)),
    .groups = "drop"
  ) %>%
  mutate(
    intercept = map_dbl(model, ~coef(.)["(Intercept)"]),
    slope = map_dbl(model, ~coef(.)["xpred_log"]),
    c = exp(intercept),
    n = slope
  ) %>%
  select(subject, y_var, c, n)

# 3. 生成xpred 1-30的序列，计算预测值
pred_data <- model_coeffs %>%
  crossing(xpred = 1:30) %>%
  mutate(pred_y = c * (xpred ^ n))

# 4. 合并原始已知值和预测值，转换为宽格式
final_df <- pred_data %>%
  left_join(
    df %>% select(subject, xpred, y1, y2, y3) %>% pivot_longer(starts_with("y"), names_to = "y_var", values_to = "y_value"),
    by = c("subject", "xpred", "y_var")
  ) %>%
  mutate(y_value = ifelse(xpred <= 10, y_value, pred_y)) %>%
  select(-pred_y, -c, -n) %>%
  pivot_wider(
    names_from = y_var,
    values_from = y_value
  ) %>%
  arrange(subject, xpred)

# 查看结果示例
head(final_df, 12)

代码说明 #

• 数据重塑：两次pivot_longer将多列y变量转为行格式，避免重复代码处理不同y列
• 分组建模：用group_by(subject, y_var)实现批量分组，list(lm(...))保存每个模型，再提取截距和斜率计算c、n
• 生成预测：crossing函数快速生成每个受试者的xpred全序列，结合系数公式计算预测值
• 合并数据：将原始已知值（xpred1-10）和预测值（xpred11-30）合并，转换回宽格式得到整洁的最终数据框

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