Expanding window diffusion index models (with PCA)预测的数据泄露与BIC选参问题

• 最严重的数据泄露点：预测阶段的PCA误用了包含当前预测样本的数据集
  你在生成预测用的t时刻因子时，用prcomp(X[1:t, ])训练PCA，相当于把你要用来做预测的t时刻X也纳入了PCA的训练过程，违反了「预测时只能使用训练集得到的预处理参数」的原则，会导致模型效果被严重高估。
• 代码笔误：你在构造训练集df_train时调用了未定义的变量F_all，实际应该使用前面定义的F_all_s，该问题会导致代码直接运行报错。
• 额外逻辑错误：训练线性模型用的因子和预测用的因子来自两个完全独立的PCA变换，二者的载荷、中心化/缩放参数完全不一致，线性模型学习的是F_all_s的系数，你往里面传入F_all_t的因子做预测完全没有实际意义。

你当前遍历1:rmax计算每个r对应线性模型BIC、保留最小BIC对应r的逻辑是通顺的，只要修正前面的变量名笔误，这部分可以实现你「每次迭代选BIC最小的因子数r」的需求。

你可以按照标准递归窗扩散指数预测的流程调整代码，每个迭代只拟合一次PCA：

forecast_di_bic <- function(y, X, dates, i0, rmax, h) {

  Tn <- length(y)
  origins <- i0:(Tn - h)
  res <- tibble(
    date   = dates[origins + h],
    actual = y[origins + h],
    f_di   = NA_real_,
    r_sel  = NA_integer_
  )
  
  for (k in seq_along(origins)) {
    t <- origins[k]
    # 训练窗口：只能用到t-h及之前的信息
    train_idx <- 1:(t - h)
    Y_train <- y[train_idx + h]
    # 仅用训练窗口的X拟合PCA，避免泄露
    pca_train <- prcomp(X[train_idx, , drop = FALSE], center = TRUE, scale. = TRUE)
    F_all_train <- as.data.frame(pca_train$x[, 1:rmax, drop = FALSE])
    
    # 按BIC选最优r
    best_bic <- Inf; best_fit <- NULL; best_r <- 1L
    for (r in 1:rmax) {
      df_train <- cbind(Y = Y_train, F_all_train[, 1:r, drop = FALSE])     
      fit      <- lm(Y ~ ., data = df_train)
      bic      <- BIC(fit)
      if (bic < best_bic) { best_bic <- bic; best_fit <- fit; best_r <- r }
    }
    
    # 用训练好的PCA转换t时刻的X得到预测用因子，再做预测
    F_t <- predict(pca_train, newdata = X[t, , drop = FALSE])[, 1:best_r, drop = FALSE]
    res$f_di[k]  <- as.numeric(predict(best_fit, newdata = as.data.frame(F_t)))
    res$r_sel[k] <- best_r
  }
  
  res |> mutate(
    e_di     = actual - f_di,
    sse_cum  = cumsum(e_di^2),
    rmse_cum = sqrt(dplyr::cummean(e_di^2))
  )
}

修正后的代码完全规避了数据泄露问题，同时保留了你原有的BIC选因子的逻辑。

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