test_that("default param", { rs1 <- rolling_origin(dat1) sizes1 <- dim_rset(rs1) expect_true(all(sizes1$assessment == 1)) expect_true(all(sizes1$analysis == 5:19)) same_data <- purrr::map_lgl(rs1$splits, function(x) { all.equal(x$data, dat1) }) expect_true(all(same_data)) for (i in 1:nrow(rs1)) { expect_equal( rs1$splits[[i]]$in_id, 1:(i + attr(rs1, "initial") - 1) ) expect_equal( rs1$splits[[i]]$out_id, i + attr(rs1, "initial") ) } }) test_that("larger holdout", { rs2 <- rolling_origin(dat1, assess = 3) sizes2 <- dim_rset(rs2) expect_true(all(sizes2$assessment == 3)) expect_true(all(sizes2$analysis == 5:17)) for (i in 1:nrow(rs2)) { expect_equal( rs2$splits[[i]]$in_id, 1:(i + attr(rs2, "initial") - 1) ) expect_equal( rs2$splits[[i]]$out_id, (i + attr(rs2, "initial")): (i + attr(rs2, "initial") + attr(rs2, "assess") - 1) ) } }) test_that("fixed analysis size", { rs3 <- rolling_origin(dat1, cumulative = FALSE) sizes3 <- dim_rset(rs3) expect_true(all(sizes3$assessment == 1)) expect_true(all(sizes3$analysis == 5)) for (i in 1:nrow(rs3)) { expect_equal( rs3$splits[[i]]$in_id, i:(i + attr(rs3, "initial") - 1) ) expect_equal( rs3$splits[[i]]$out_id, i + attr(rs3, "initial") ) } }) test_that("skipping", { rs4 <- rolling_origin(dat1, cumulative = FALSE, skip = 2) sizes4 <- dim_rset(rs4) expect_true(all(sizes4$assessment == 1)) expect_true(all(sizes4$analysis == 5)) for (i in 1:nrow(rs4)) { expect_equal( rs4$splits[[i]]$in_id, (i + attr(rs4, "skip") * (i - 1)): (i + attr(rs4, "skip") * (i - 1) + attr(rs4, "initial") - 1) ) expect_equal( rs4$splits[[i]]$out_id, i + attr(rs4, "skip") * (i - 1) + attr(rs4, "initial") ) } }) test_that("lag", { rs5 <- rolling_origin(dat1, initial = 5, assess = 1, cumulative = FALSE, skip = 0, lag = 3) sizes5 <- dim_rset(rs5) expect_true(all(sizes5$assessment == attr(rs5, "assess") + attr(rs5, "lag"))) expect_true(all(sizes5$analysis == attr(rs5, "initial"))) for (i in 1:nrow(rs5)) { expect_equal( rs5$splits[[i]]$in_id, i:(i + attr(rs5, "initial") - 1) ) expect_equal( rs5$splits[[i]]$out_id, (i + attr(rs5, "initial") - attr(rs5, "lag")):(i + attr(rs5, "initial") + attr(rs5, "assess") - 1) ) } expect_error(rolling_origin(drinks, initial = 5, lag = 6)) # lag must be less than training observations expect_error(olling_origin(drinks, lag = 2.1)) # lag must be whole number }) test_that("rsplit labels", { rs <- rolling_origin(dat1) all_labs <- purrr::map(rs$splits, labels) %>% list_rbind() original_id <- rs[, grepl("^id", names(rs))] expect_equal(all_labs, original_id) })