feat: allow no of obs in holdout resampling

m-muecke · m-muecke · commit a528a4791e06 · 2024-12-22T23:15:07.000+01:00
diff --git a/R/ResamplingForecastHoldout.R b/R/ResamplingForecastHoldout.R
@@ -39,8 +39,10 @@ ResamplingForecastHoldout = R6Class("ResamplingForecastHoldout",
     #' @description
     #' Creates a new instance of this [R6][R6::R6Class] class.
     initialize = function() {
-      param_set = ps(ratio = p_dbl(0, 1, tags = "required"))
-      param_set$set_values(ratio = 0.8)
+      param_set = ps(
+        ratio = p_dbl(0, 1),
+        n = p_int()
+      )
 
       super$initialize(
         id = "forecast_holdout",
@@ -63,7 +65,17 @@ ResamplingForecastHoldout = R6Class("ResamplingForecastHoldout",
     .sample = function(ids, ...) {
       pars = self$param_set$get_values()
       n = length(ids)
-      nr = round(n * pars$ratio)
+      has_ratio = !is.null(pars$ratio)
+      if (!xor(!has_ratio, is.null(pars$n))) {
+        stopf("Either parameter `ratio` (x)or `n` must be provided.")
+      }
+      if (has_ratio) {
+        nr = round(n * pars$ratio)
+      } else if (pars$n > 0L) {
+        nr = min(n, pars$n)
+      } else {
+        nr = max(n + pars$n, 0L)
+      }
       ii = ids[1:nr]
       list(train = ii, test = ids[(nr + 1L):n])
     },
diff --git a/tests/testthat/test_ResamplingForecastHoldout.R b/tests/testthat/test_ResamplingForecastHoldout.R
@@ -9,14 +9,26 @@ test_that("forecast_holdout basic properties", {
   expect_error(resampling$train_set(2L))
   expect_error(resampling$test_set(2L))
   expect_false(resampling$duplicated_ids)
+
+  resampling = rsmp("forecast_holdout", ratio = 0.5)$instantiate(task)
+  expect_length(resampling$train_set(1L), task$nrow / 2)
+  expect_length(resampling$test_set(1L), task$nrow / 2)
+
+  resampling = rsmp("forecast_holdout", n = 10L)$instantiate(task)
+  expect_length(resampling$train_set(1L), 10L)
+  expect_length(resampling$test_set(1L), task$nrow - 10L)
+
+  resampling = rsmp("forecast_holdout", n = -10L)$instantiate(task)
+  expect_length(resampling$train_set(1L), task$nrow - 10L)
+  expect_length(resampling$test_set(1L), 10L)
 })
 
 test_that("forecast_holdout works", {
   skip_if_not_installed("tsbox")
   dt = tsbox::ts_dt(AirPassengers)
   dt[, time := NULL]
   task = as_task_regr(dt, target = "value")
-  resampling = rsmp("forecast_holdout")
+  resampling = rsmp("forecast_holdout", ratio = 0.8)
   resampling$instantiate(task)
   expect_identical(resampling$train_set(1L), 1:115)
   expect_identical(resampling$test_set(1L), 116:144)
