r - 使用时间序列交叉验证模仿 createFolds

Question

R 包 caret 提供了一个方便的函数 createFolds ，它返回用于交叉验证的训练集的索引列表:

set.seed(1)
require(caret)
x <- rnorm(10)
createFolds(x,k=5,returnTrain=TRUE)

$Fold1
[1]  1  2  5  6  7  8  9 10

$Fold2
[1]  1  3  4  5  6  8  9 10

$Fold3
[1]  1  2  3  4  5  7  8 10

$Fold4
[1] 1 2 3 4 6 7 8 9

$Fold5
[1]  2  3  4  5  6  7  9 10

我想创建一个类似的函数，但我想返回要在 time-series cross validation 中使用的索引列表.我找到了一些 example code in R ，但我想对事物进行更多的概括和功能化。这是我最初想到的:

createTSfolds <- function(y, Min=max(frequency(y),3)) {
    i <- seq(along=y)
    stops <- i[Min:(length(i)-1)]
    starts <- rep(1,length(stops))
    out <- mapply(seq,starts,stops)
    names(out) <- paste("Fold", gsub(" ", "0", format(seq(along = out))), sep = "")
    out
}
createTSfolds(x)

$Fold1
[1] 1 2 3

$Fold2
[1] 1 2 3 4

$Fold3
[1] 1 2 3 4 5

$Fold4
[1] 1 2 3 4 5 6

$Fold5
[1] 1 2 3 4 5 6 7

$Fold6
[1] 1 2 3 4 5 6 7 8

$Fold7
[1] 1 2 3 4 5 6 7 8 9

(Min 是拟合模型所需的最少观察次数)

这个函数现在工作得很好，但我想添加 2 个函数， Rob Hyndman discusses :

加窗:而不是将训练集扩展回第一个
观察，它向回延伸 n 个观察。

可变预测范围:不是每次折叠向训练集添加 1 个索引，而是每次折叠向训练集添加 k。

这是我实现窗口的方式:

createTSfolds <- function(y, Min=max(frequency(y),3), lookback=NA) {
    i <- seq(along=y)
    stops <- i[Min:(length(i)-1)]
    if (is.na(lookback)) { 
        starts <- as.list(rep(1,length(stops)))
        out <- mapply(seq,starts,stops)
    } else {
        starts <- stops-Min+1
        out <- mapply(seq,starts,stops)
        out <- split(t(out),1:nrow(t(out)))
    }
    names(out) <- paste("Fold", gsub(" ", "0", format(seq(along = out))), sep = "")
    out
}
createTSfolds(x,Min=4,lookback=4)

我不知道如何实现可变预测范围，它看起来像这样:
例如，如果 k=3:

$Fold1
[1] 1 2 3

$Fold2
[1] 1 2 3 4 5 6

$Fold3
[1] 1 2 3 4 5 6 7 8 9

我正在寻找改进现有代码的方法，以及在每次折叠时向训练集添加变量增量的方法。

谢谢

Answer 1

这是一种方法。它并不完全可靠，因为我不确定您在 lookback 时寻求的输出和 k存在。如果这就是您要找的，请告诉我。

 createTSfolds2 <- function(y, Min = max(frequency(y), 3), lookback = NA, k = NA){
   out = llply(Min:(length(y) - 1), seq)
   if (!is.na(k)) {out = out[seq(1, length(out), k)]}
   if (!is.na(lookback)) {
     out = plyr::llply(out, function(z) z[(length(z) - lookback + 1):length(z)])
   }
   names(out) <- paste("Fold", gsub(" ", "0", format(seq(along = out))), sep = "")
   return(out)
 }

createTSfolds2(x, Min = 3, lookback = NA, k = 3)

$Fold1
[1] 1 2 3

$Fold2
[1] 1 2 3 4 5 6

$Fold3
[1] 1 2 3 4 5 6 7 8 9

createTSfolds2(x, Min = 3, lookback = 3, k = 3)

$Fold1
[1] 1 2 3

$Fold2
[1] 4 5 6

$Fold3
[1] 7 8 9