如何在强制预测与真实值1:1线性回归时实现k折交叉验证

我正在训练一个以x为自变量的y的多项式函数，要求预测y值与真实y值的线性回归结果落在1:1线上（示意图中右图用geom_smooth(method="lm")展示，但实际通过lmodel2()的SMA方法得到的回归线是1:1线）。我是统计新手，知道这种做法可能有问题，但不强制这个约束的话，模型会出现高估低值、低估高值的情况。

我的核心问题：

• 如何用caret或cvms这类现成工具包实现k折交叉验证？
• 这类工具包似乎要求返回模型对象，但我不知道怎么把我的问题编码成符合要求的形式。
• 有没有办法在最小化自定义指标的同时训练模型，还能返回包含预测值ypred的模型对象，用于k折交叉验证？

data <- data.frame(
        x = c(1.514, 1.514, 1.825, 1.281, 1.118, 1.279, 1.835, 1.819, 0.462, 1.53, 1.004, 1.19, 1.275, 0.428, 0.313, 0.909, 0.995, 0.995, 0.706, 0.563, 0.827, 0.65, 0.747, 1.013, 1.013, 1.163, 1.091, 1.163, 1.091, 0.955, 0.955, 2.044, 2.044, 1.777, 1.777, 1.434, 1.393, 1.324, 0.981, 0.845, 1.595, 1.595, 1.517, 1.517, 1.403, 1.403, 0.793, 0.793, 1.016, 0.901, 0.847, 1.054, 0.877, 1.639, 1.639, 1.268, 1.268, 0.842, 0.842, 0.827, 0.777, 1.024, 1.238, 1.238, 1.702, 1.702, 0.673, 0.673, 1.256, 1.256, 0.898, 0.898, 0.66, 0.933, 0.827, 0.836, 1.122, 1.5, 1.5, 1.44, 1.44, 0.671, 0.671, 0.486, 0.486, 1.051, 1.051, 0.971, 0.538, 0.971, 0.538, 1.012, 1.012, 0.776, 0.776, 0.854, 0.854, 0.74, 0.989, 0.989),
        y = c(0.19, 0.18, 0.816, 2.568, 0.885, 0.521, 0.268, 0.885, 4.781, 1.648, 0.989, 1.614, 1.492, 0.679, 2.256, 3.17, 1.926, 1.631, 0.462, 2.48, 0.658, 0.355, 0.373, 2.31, 3.263, 1.374, 1.374, 2.637, 2.637, 2.073, 2.298, 0.257, 0.292, 0.359, 0.329, 1.329, 1.272, 3.752, 1.784, 0.76, 0.458, 0.488, 0.387, 0.387, 3.401, 1.458, 8.945, 9.12, 0.308, 0.386, 0.405, 6.444, 3.17, 0.458, 0.47, 0.572, 0.589, 1.961, 1.909, 0.636, 0.32, 1.664, 0.756, 0.851, 0.403, 0.232, 23.112, 22.042, 0.745, 0.477, 2.349, 3.01, 0.39, 0.246, 0.43, 1.407, 1.358, 0.235, 0.215, 0.595, 0.685, 2.539, 2.128, 8.097, 5.372, 0.644, 0.626, 17.715, 17.715, 6.851, 6.851, 2.146, 1.842, 3.147, 2.95, 1.127, 1.019, 8.954, 0.796, 0.758),
        stringsAsFactors = FALSE)
optim_results <- optim(par = c(a0 = 0.3, a1 = -3.8, a2 = -1, a3 = 1, a4 = 1),
                       fn = function (params, x, y) {
                                params <- as.list(params)
                                ypred <- with(params, (a0 + (a1*x) + (a2*x^2) + (a3*x^3) + (a4*x^4)))
                                mod <- suppressMessages(lmodel2::lmodel2(ypred ~ y))$regression.results[3,]
                                line <- mod$Slope * y + mod$Intercept
                                return(sum((y - line)^2))}, 
                       x = log10(data$x),
                       y = log10(data$y))
cf <- as.numeric(optim_results$par)
data <- data %>% dplyr::mutate(ypred = 10^(cf[1] + cf[2]*log10(x) + cf[3]*log10(x)^2 + cf[4]*log10(x)^3 + cf[5]*log10(x)^4))
str(data)

核心思路 #

你的需求是带自定义损失约束的多项式回归+ k折交叉验证，需要将optim的优化逻辑封装成caret/cvms可识别的训练接口，同时保留返回模型对象（含系数、预测能力）的特性。

方法1：基于caret实现k折交叉验证 #

caret支持自定义模型，只需将你的优化逻辑包装成训练函数，并实现对应的预测方法。

1. 封装自定义训练与预测逻辑 #

library(caret)
library(lmodel2)
library(dplyr)

# 自定义训练函数：输入特征、目标变量，返回带预测能力的模型对象
custom_poly_train <- function(x, y, params) {
  x_log <- x[,1]
  y_log <- y
  
  # 执行参数优化
  optim_res <- optim(
    par = unlist(params),
    fn = function(p) {
      ypred_log <- p[1] + p[2]*x_log + p[3]*x_log^2 + p[4]*x_log^3 + p[5]*x_log^4
      sma_mod <- suppressMessages(lmodel2::lmodel2(ypred_log ~ y_log))$regression.results[3,]
      line <- sma_mod$Slope * y_log + sma_mod$Intercept
      sum((y_log - line)^2)
    }
  )
  
  # 构造模型对象，包含系数和预测函数
  model <- list(
    coefficients = optim_res$par,
    predict = function(newdata) {
      new_x_log <- log10(newdata$x)
      10^(model$coefficients[1] + 
            model$coefficients[2]*new_x_log + 
            model$coefficients[3]*new_x_log^2 + 
            model$coefficients[4]*new_x_log^3 + 
            model$coefficients[5]*new_x_log^4)
    }
  )
  class(model) <- "custom_poly"
  model
}

# 为自定义模型类实现predict方法
predict.custom_poly <- function(object, newdata, ...) {
  object$predict(newdata)
}

2. 配置交叉验证参数 #

# 预处理数据：添加log转换特征
data$x_log <- log10(data$x)
data$y_log <- log10(data$y)

# 设置10折交叉验证控制
train_control <- trainControl(
  method = "cv",
  number = 10,
  savePredictions = "final",  # 保存所有折的预测结果
  verboseIter = TRUE
)

# 定义参数初始值网格（可扩展多组初始值优化稳定性）
param_grid <- data.frame(
  a0 = 0.3,
  a1 = -3.8,
  a2 = -1,
  a3 = 1,
  a4 = 1
)

3. 执行交叉验证 #

# 启动训练
cv_model <- train(
  x = data[, "x_log", drop = FALSE],
  y = data$y_log,
  method = custom_poly_train,
  trControl = train_control,
  tuneGrid = param_grid
)

# 查看交叉验证结果
print(cv_model$results)
head(cv_model$pred)  # 查看各折的预测值与真实值

# 用训练好的模型预测新数据
new_data <- data.frame(x = c(1.0, 1.5))
predict(cv_model, newdata = new_data)

方法2：基于cvms实现k折交叉验证 #

cvms更简洁，直接传入自定义训练/预测函数即可完成交叉验证。

1. 定义训练与预测函数 #

library(cvms)
library(lmodel2)
library(dplyr)

# 自定义训练函数：返回优化后的系数
custom_train_fn <- function(data, target_col, predictor_cols, ...) {
  x_log <- log10(data[[predictor_cols]])
  y_log <- log10(data[[target_col]])
  
  optim_res <- optim(
    par = c(a0=0.3, a1=-3.8, a2=-1, a3=1, a4=1),
    fn = function(p) {
      ypred_log <- p[1] + p[2]*x_log + p[3]*x_log^2 + p[4]*x_log^3 + p[5]*x_log^4
      sma_mod <- suppressMessages(lmodel2::lmodel2(ypred_log ~ y_log))$regression.results[3,]
      line <- sma_mod$Slope * y_log + sma_mod$Intercept
      sum((y_log - line)^2)
    }
  )
  optim_res$par
}

# 自定义预测函数：输入系数和新数据，返回预测值
custom_pred_fn <- function(model, data, predictor_cols, ...) {
  x_log <- log10(data[[predictor_cols]])
  10^(model[1] + model[2]*x_log + model[3]*x_log^2 + model[4]*x_log^3 + model[5]*x_log^4)
}

2. 执行交叉验证 #

# 10折交叉验证
cv_results <- cross_validate(
  data = data,
  target_col = "y",
  predictor_cols = "x",
  train_fn = custom_train_fn,
  predict_fn = custom_pred_fn,
  folds = 10,
  type = "regression"
)

# 查看结果与可视化
print(cv_results)
plot(cv_results)  # 直观查看预测值与真实值的拟合情况

注意事项 #

• 逻辑一致性：交叉验证的每一轮训练都使用你定义的损失函数，确保和单模型训练的约束一致。
• 模型稳定性：可尝试多组初始参数，避免optim陷入局部最优。
• 结果验证：交叉验证后，检查各折的预测值与真实值是否符合1:1线的要求。

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