caret: combine createResample and groupKFold

Question

I want to do a custom sampling with caret. My specifications are the following: I have 1 observation per day, and my grouping factor is the month (12 values); so in the first step I create 12 resamples with 11 months in the training (11*30 points) and 1 in the testing (30 points). This way I get 12 resamples in total.

But that's not enough to me and I would like to make it a little more complex, by adding some bootstrapping of the training points of each partition. So, instead of having 11*30 points in Resample01, I would have several bootstrapped resamples of these 330 points. So in the end, I want a lot of resamples, but with one of the months NEVER in the training set.

How to specify this in a call to train? What I tried:

library(caret)
x = rep(1:12, each=30)
folds = groupKFold(x, k=12)
folds2 = lapply(folds, createResample, times=10)

but this is wrong because 1/ i get a nested list, 2/ the initial indices are lost at the second step.

Thanks for your help (and don't hesitate to tell me if you think it's a XY pb)

Answer 1

I trust this will solve your problem

library(caret)
x <- rep(1:12, each = 30)
folds <- groupKFold(x, k = 12)

provide 10 bootstrap replicates in a nested list for each of the groups in folds - this solves the lost indexes problem.

folds2 <- lapply(folds, function(x) lapply(1:10, function(i) sample(x, size = length(x), replace = TRUE)))

convert nested list to a one dimensional list - this solves the nested list problem.

folds2 <- unlist(folds2 , recursive = FALSE, use.names = TRUE)

does it work?

df <- data.frame(y = rnorm(360), x = rnorm(360))

lm_formula <- train(
  y ~ ., df,
  method = "lm",
  trControl = trainControl(method = "boot" , index = folds2)
)

looks like it does.

The only issue is perhaps in the intended indexOut for each resample, in the example all indexes not present in the fold were used as test. If I understood you would like to test on the held out months and not on all the held out samples. To solve this:

folds_out <- lapply(folds, function(x) setdiff(1:360, x))
folds_out <- rep(folds_out, each = 10)
names(folds_out) <- names(folds2)

lm_formula <- train(
  y ~ ., df,
  method = "lm",
  trControl = trainControl(method = "boot" , index = folds2, indexOut = folds_out)
)