tests/testthat/test-resolve_cols.R

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

test_that(".resolve_cols handles names, indices, NULL and duplicates", {
  nm <- c("a", "b", "c")
  expect_identical(.resolve_cols(c(3, 1), nm, "x"), c("c", "a"))
  expect_identical(.resolve_cols("b", nm, "x"), "b")
  expect_null(.resolve_cols(NULL, nm, "x", allow_null = TRUE))
  expect_error(.resolve_cols(NULL, nm, "x"), "must not be NULL")
  expect_error(.resolve_cols(4, nm, "x"), "out-of-bounds")
  expect_error(.resolve_cols(1.5, nm, "x"), "whole-number")
  expect_error(.resolve_cols("z", nm, "x"), "not found")
  expect_error(.resolve_cols(NA, nm, "x"), "NA")
  expect_warning(out <- .resolve_cols(c("a", "a"), nm, "x"), "duplicated")
  expect_identical(out, "a")
})

test_that(".strip_ext only touches the final extension", {
  expect_identical(
    .strip_ext(c("v1.2/file", "a.b/c.txt", ".env", "x.", "/h/.bashrc",
                 "f.tar.gz", NA, "")),
    c("v1.2/file", "a.b/c", ".env", "x.", "/h/.bashrc", "f.tar", NA, ""))
})

test_that(".safe_path_segment neutralises dangerous names", {
  expect_identical(.safe_path_segment(c("a/b", "..", "c:d", "CON", NA, " x. ")),
                   c("a_b", "unnamed", "c_d", "_CON", "NA", "x"))
})

test_that(".make_unique is case-insensitive and respects max_len", {
  expect_identical(.make_unique(c("a", "A", "a"), 31L), c("a", "A_2", "a_3"))
  expect_true(all(nchar(.make_unique(rep(strrep("x", 31), 2), 31L)) <= 31))
})

test_that(".with_seed is reproducible and restores the RNG stream", {
  set.seed(42); ref <- runif(1)
  set.seed(42)
  a <- .with_seed(1, runif(3))
  expect_identical(runif(1), ref)                 # stream untouched
  expect_identical(.with_seed(1, runif(3)), a)    # reproducible
})

test_that(".assign_folds balances fold sizes and strata", {
  set.seed(1)
  f <- .assign_folds(103, 5)
  expect_true(max(table(f)) - min(table(f)) <= 1)
  s <- rep(c("a", "b", "c"), c(50, 30, 20))
  f <- .assign_folds(100, 5, s)
  tab <- table(f, s)
  expect_true(all(apply(tab, 2, function(x) max(x) - min(x)) <= 1))
})

test_that(".make_strata bins numerics and pools small strata", {
  s <- .make_strata(1:100, breaks = 4, pool = 0.1)
  expect_length(unique(s), 4)
  s <- .make_strata(c(rep("a", 95), rep("b", 5)), breaks = 4, pool = 0.1)
  expect_length(unique(s), 1)
  expect_error(.make_strata(c(1, NA), 4, 0.1), "NA")
})

Try the mintyr package in your browser

Any scripts or data that you put into this service are public.

mintyr documentation built on Oct. 5, 2026, 5:08 p.m.