test_that("default param", { set.seed(11) rs1 <- clustering_cv(dat1, c, v = 2) same_data <- purrr::map_lgl(rs1$splits, function(x) { all.equal(x$data, dat1) }) expect_true(all(same_data)) good_holdout <- purrr::map_lgl( rs1$splits, function(x) { length(intersect(x$in_ind, x$out_id)) == 0 } ) expect_true(all(good_holdout)) }) test_that("repeated", { set.seed(11) rs2 <- clustering_cv(dat1, c, v = 2, repeats = 4) sizes2 <- dim_rset(rs2) same_data <- purrr::map_lgl(rs2$splits, function(x) { all.equal(x$data, dat1) }) expect_true(all(same_data)) good_holdout <- purrr::map_lgl( rs2$splits, function(x) { length(intersect(x$in_ind, x$out_id)) == 0 } ) expect_true(all(good_holdout)) }) test_that("bad args", { expect_snapshot(error = TRUE, { clustering_cv(dat1) }) expect_snapshot(error = TRUE, { clustering_cv(iris, Sepal.Length, v = -500) }) expect_snapshot(error = TRUE, { clustering_cv(iris, Sepal.Length, v = 500) }) expect_snapshot(error = TRUE, { clustering_cv(iris, Sepal.Length, cluster_function = "not an option") }) expect_snapshot(error = TRUE, { clustering_cv(Orange, v = 1, vars = "Tree") }) expect_snapshot(error = TRUE, { clustering_cv(Orange, repeats = 0) }) expect_snapshot(error = TRUE, { clustering_cv(Orange, repeats = NULL) }) expect_snapshot(error = TRUE, { clustering_cv(mtcars, mpg, v = nrow(mtcars)) }) }) test_that("printing", { set.seed(11) expect_snapshot(clustering_cv(dat1, c, v = 2)) }) test_that("rsplit labels", { rs <- clustering_cv(dat1, c, v = 2) all_labs <- purrr::map(rs$splits, labels) %>% list_rbind() original_id <- rs[, grepl("^id", names(rs))] expect_equal(all_labs, original_id) })