Enable using fully predefined indices in resampling

NEWS.md

@@ -1,5 +1,8 @@
 # mlr 2.14:
 
+## general
+* add option to use fully predefined indices in resampling (`makeResampleDesc(fixed = TRUE)`)
+
 ## learners - new
 * classif.liquidSVM
 * regr.liquidSVM

R/ResampleDesc.R

@@ -65,6 +65,17 @@
 #'     of the resampling indices will be 20. Default is \dQuote{horizon} which gives mutually exclusive chunks
 #'      of test indices.}
 #'   }
+#' @param fixed (`logical(1)`)\cr
+#'   Whether indices supplied via argument 'blocking' in the task should be used as
+#'   fully pre-defined indices. Default is `FALSE` which means
+#'   they will be used following the 'blocking' approach.
+#'   `fixed` only works with ResampleDesc `CV` and the supplied indices must match
+#'   the number of observations. When `fixed = TRUE`, the `iters` argument will be ignored
+#'   and is interally set to the number of supplied factor levels in `blocking`.
+#' @param blocking.cv (`logical(1)`)\cr
+#'   Should 'blocking' be used in `CV`? Default to `FALSE`.
+#'   This is different to `fixed = TRUE` and cannot be combined. Please check the mlr online tutorial
+#'   for more details.
 #' @param stratify (`logical(1)`)\cr
 #'   Should stratification be done for the target variable?
 #'   For classification tasks, this means that the resampling strategy is applied to all classes
@@ -92,7 +103,8 @@
 #'
 #' # Holdout a.k.a. test sample estimation
 #' makeResampleDesc("Holdout")
-makeResampleDesc = function(method, predict = "test", ..., stratify = FALSE, stratify.cols = NULL) {
+makeResampleDesc = function(method, predict = "test", ..., stratify = FALSE,
+  stratify.cols = NULL, fixed = FALSE, blocking.cv = FALSE) {
   assertChoice(method, choices = c("Holdout", "CV", "LOO",  "RepCV",
                                    "Subsample", "Bootstrap", "SpCV", "SpRepCV",
                                    "GrowingWindowCV", "FixedWindowCV"))
@@ -106,6 +118,8 @@ makeResampleDesc = function(method, predict = "test", ..., stratify = FALSE, str
   d$predict = predict
   d$stratify = stratify
   d$stratify.cols = stratify.cols
+  d$fixed = fixed
+  d$blocking.cv = blocking.cv
   addClasses(d, stri_paste(method, "Desc"))
 }
 
@@ -134,9 +148,10 @@ makeResampleDescHoldout = function(iters, split = 2 / 3) {
   makeResampleDescInternal("holdout", iters = 1L, split = split)
 }
 
-makeResampleDescCV = function(iters = 10L) {
+makeResampleDescCV = function(iters = 10L, fixed = FALSE, blocking.cv = FALSE) {
   iters = asInt(iters, lower = 2L)
-  makeResampleDescInternal("cross-validation", iters = iters)
+  makeResampleDescInternal("cross-validation", iters = iters, fixed = fixed,
+    blocking.cv = blocking.cv)
 }
 
 makeResampleDescSpCV = function(iters = 10L) {
@@ -159,10 +174,11 @@ makeResampleDescBootstrap = function(iters = 30L) {
   makeResampleDescInternal("OOB bootstrapping", iters = iters)
 }
 
-makeResampleDescRepCV = function(reps = 10L, folds = 10L) {
+makeResampleDescRepCV = function(reps = 10L, folds = 10L, fixed = FALSE, blocking.cv = FALSE) {
   reps = asInt(reps, lower = 2L)
   folds = asInt(folds, lower = 2L)
-  makeResampleDescInternal("repeated cross-validation", iters = folds * reps, folds = folds, reps = reps)
+  makeResampleDescInternal("repeated cross-validation", iters = folds * reps, folds = folds, reps = reps,
+    fixed = fixed, blocking.cv = blocking.cv)
 }
 
 makeResampleDescSpRepCV = function(reps = 10L, folds = 10L) {

R/ResampleInstance.R

@@ -11,7 +11,7 @@
 #' \item{train.inds (list of [integer])}{List of of training indices for all iterations.}
 #' \item{test.inds (list of [integer])}{List of of test indices for all iterations.}
 #' \item{group ([factor])}{Optional grouping of resampling iterations. This encodes whether
-#'   specfic iterations 'belong together' (e.g. repeated CV), and it can later be used to
+#'   specific iterations 'belong together' (e.g. repeated CV), and it can later be used to
 #'   aggregate performance values accordingly. Default is 'factor()'.}
 #' }
 #'
@@ -61,7 +61,17 @@ makeResampleInstance = function(desc, task, size, ...) {
   if (length(blocking) && desc$stratify)
     stop("Blocking can currently not be mixed with stratification in resampling!")
 
-  if (length(blocking)) {
+  # 'fixed' only exists by default for 'CV' -> is.null(desc$fixed)
+  # only use this way of blocking if 'fixed = FALSE' -> is.null(desc$fixed)
+
+  fixed = desc$fixed
+  blocking.cv = desc$blocking.cv
+  if (fixed == FALSE) {
+    ### check if blocking should be used or not
+    blocking.cv = desc$blocking.cv
+  }
+
+  if (length(blocking) > 0 && !fixed && blocking.cv) {
     if (is.null(task))
       stop("Blocking always needs the task!")
     levs = levels(blocking)

R/ResampleInstances.R

@@ -8,10 +8,55 @@ instantiateResampleInstance.HoldoutDesc = function(desc, size, task = NULL) {
 }
 
 instantiateResampleInstance.CVDesc = function(desc, size, task = NULL) {
-  if (desc$iters > size)
-    stopf("Cannot use more folds (%i) than size (%i)!", desc$iters, size)
-  test.inds = chunk(seq_len(size), shuffle = TRUE, n.chunks = desc$iters)
-  makeResampleInstanceInternal(desc, size, test.inds = test.inds)
+
+  # Random sampling CV
+  if (!desc$fixed) {
+    if (desc$iters > size) {
+      stopf("Cannot use more folds (%i) than size (%i)!", desc$iters, size)
+    }
+    test.inds = chunk(seq_len(size), shuffle = TRUE, n.chunks = desc$iters)
+    makeResampleInstanceInternal(desc, size, test.inds = test.inds)
+  } else {
+
+    # CV with only predefined indices ("fixed")
+
+    if(is.null(task$blocking)) {
+      stopf("To use blocking in resampling, you need to pass a factor variable when creating the task!")
+    }
+
+    # In the inner call, the implementation is able to adapt by automatically reducing one level (see line if (0 %in% length.test.inds)).
+    # So having always `length(iters) = length(levels(task$blocking)` is the most safe environment for the function to work.
+    if (desc$iters != length(levels(task$blocking))) {
+      desc$iters = length(levels(task$blocking))
+      warningf("Adjusting levels to match number of blocking levels.")
+    }
+    levs = levels(task$blocking)
+    n_levels = length(levs)
+
+    # Why do we need the helper desc? If we would call 'instantiateResampleInstance()' here,
+    # we would call the function within itself and will receive an 'error-c-stack-usage-is-too-close-to-the-limit' error
+    # So we simply change the class name to mimic a new function..
+    attr(desc, "class")[1] = "CVHelperDesc"
+    # create fake ResampleInstance
+    inst = instantiateResampleInstance(desc, n_levels, task)
+    attr(desc, "class")[1] = "CVDesc"
+
+    # now exchange block indices with indices of elements of this block and shuffle
+    test.inds = lapply(inst$test.inds, function(i) which(task$blocking %in% levs[i]))
+
+    # Nested resampling: We need to create a list with length(levels) first.
+    # Then one fold will be length(0) because we are missing one factor level because we are in the inner level
+    # We check for this and remove this fold
+    # There is no other way to do this. If we initially set "desc$iters" to length(levels) - 1, test.inds will not be created correctly
+    length.test.inds = unlist(lapply(test.inds, function(x) length(x)))
+    if (0 %in% length.test.inds) {
+      index = match(0, length.test.inds)
+      test.inds[[index]] = NULL
+      size = length(task$env$data[,1])
+      desc$iters = length(test.inds)
+    }
+    makeResampleInstanceInternal(desc, size, test.inds = test.inds)
+  }
 }
 
 instantiateResampleInstance.SpCVDesc = function(desc, size, task = NULL) {
@@ -52,7 +97,7 @@ instantiateResampleInstance.BootstrapDesc = function(desc, size, task = NULL) {
 
 instantiateResampleInstance.RepCVDesc = function(desc, size, task = NULL) {
   folds = desc$iters / desc$reps
-  d = makeResampleDesc("CV", iters = folds)
+  d = makeResampleDesc("CV", iters = folds, blocking.cv = desc$blocking.cv, fixed = desc$fixed)
   i = replicate(desc$reps, makeResampleInstance(d, size = size), simplify = FALSE)
   train.inds = Reduce(c, lapply(i, function(j) j$train.inds))
   test.inds = Reduce(c, lapply(i, function(j) j$test.inds))
@@ -78,3 +123,10 @@ instantiateResampleInstance.GrowingWindowCVDesc = function(desc, size, task = NU
   makeResamplingWindow(desc, size, task, coords, "GrowingWindowCV")
 }
 
+instantiateResampleInstance.CVHelperDesc = function(desc, size, task = NULL) {
+
+  if (desc$iters > size)
+    stopf("Cannot use more folds (%i) than size (%i)!", desc$iters, size)
+  test.inds = chunk(seq_len(size), shuffle = TRUE, n.chunks = desc$iters)
+  makeResampleInstanceInternal(desc, size, test.inds = test.inds)
+}