tests/testthat/test-split_cv.R

In mintyr: Grouped and Nested Data Pipelines Built on 'data.table'

# WARNING - Generated by {fusen} from dev/flat_cross_validation.Rmd: do not edit by hand # nolint: line_length_linter.

test_that("split_cv creates complete, disjoint and balanced folds", {
  res <- split_cv(list(a = iris), v = 4, seed = 1)$a
  expect_identical(res$id, paste0("Fold", 1:4))
  v_idx <- res$validate_idx
  expect_identical(sort(unlist(v_idx)), 1:150)
  expect_true(max(lengths(v_idx)) - min(lengths(v_idx)) <= 1)
  for (k in 1:4) {
    expect_length(intersect(res$train_idx[[k]], v_idx[[k]]), 0)
    expect_identical(nrow(res$validate[[k]]), length(v_idx[[k]]))
  }
})

test_that("split_cv labels repeats and pads fold numbers", {
  res <- split_cv(list(iris), v = 10, repeats = 2, seed = 1)[[1]]
  expect_identical(names(res)[1:2], c("id", "id2"))
  expect_identical(unique(res$id), c("Repeat1", "Repeat2"))
  expect_identical(res$id2[1:2], c("Fold01", "Fold02"))
})

test_that("split_cv stratifies categorical and numeric variables", {
  res <- split_cv(list(iris), v = 5, strata = "Species", seed = 2)[[1]]
  counts <- vapply(res$validate, function(d) as.integer(table(d$Species)), integer(3))
  expect_true(all(counts == 10L))
  expect_silent(split_cv(list(mtcars), v = 4, strata = "mpg", breaks = 3))
})

test_that("split_cv seed is reproducible and does not disturb the RNG", {
  set.seed(9); ref <- runif(1)
  set.seed(9)
  a <- split_cv(list(iris), v = 3, seed = 1, materialize = FALSE)
  expect_identical(runif(1), ref)
  expect_identical(a, split_cv(list(iris), v = 3, seed = 1, materialize = FALSE))
})

test_that("split_cv out_type = 'df' returns plain data.frames with full factor levels", {
  res <- split_cv(list(iris), v = 3, seed = 1, out_type = "df")[[1]]
  expect_s3_class(res, "data.table")                       # fold table itself
  for (d in c(res$train, res$validate)) {
    expect_s3_class(d, "data.frame", exact = TRUE)
    expect_identical(levels(d$Species), levels(iris$Species))
  }
  ref <- iris[res$validate_idx[[1]], ]
  rownames(ref) <- NULL
  expect_equal(res$validate[[1]], ref)
  expect_error(split_cv(list(iris), v = 3, out_type = "tibble"), "out_type")
})

test_that("split_cv out_type does not change the folds", {
  a <- split_cv(list(iris), v = 3, seed = 5, out_type = "dt")[[1]]
  b <- split_cv(list(iris), v = 3, seed = 5, out_type = "df")[[1]]
  expect_identical(a$validate_idx, b$validate_idx)
  expect_equal(as.data.frame(a$train[[2]]), b$train[[2]])
})

test_that("split_cv validates its input", {
  expect_error(split_cv(iris), "wrap it in list")
  expect_error(split_cv(list()), "empty")
  expect_error(split_cv(list(iris[1:3, ]), v = 5), "fewer rows")
  expect_error(split_cv(list(iris), strata = "nope"), "absent")
  expect_error(split_cv(list(iris), v = 1), "`v`")
})