test_that("default settings is the same as map()", { expect_equal(slide(1:5, identity), as.list(1:5)) }) # ------------------------------------------------------------------------------ # .before / .after test_that("can use .before for right alignment", { expect_equal( slide(1:7, identity, .before = 1), list( 1L, 1:2, 2:3, 3:4, 4:5, 5:6, 6:7 ) ) expect_equal( slide(1:7, identity, .before = 2), list( 1L, 1:2, 1:3, 2:4, 3:5, 4:6, 5:7 ) ) }) test_that("can use .after for left alignment", { expect_equal( slide(1:7, identity, .after = 1), list( 1:2, 2:3, 3:4, 4:5, 5:6, 6:7, 7L ) ) expect_equal( slide(1:7, identity, .after = 2), list( 1:3, 2:4, 3:5, 4:6, 5:7, 6:7, 7L ) ) }) test_that("can use .before / .after for center alignment", { expect_equal( slide(1:7, identity, .before = 1, .after = 1), list( 1:2, 1:3, 2:4, 3:5, 4:6, 5:7, 6:7 ) ) expect_equal( slide(1:7, identity, .before = 2, .after = 2), list( 1:3, 1:4, 1:5, 2:6, 3:7, 4:7, 5:7 ) ) }) test_that("can use .before / .after for center-left alignment", { expect_equal( slide(1:7, identity, .before = 2, .after = 1), list( 1:2, 1:3, 1:4, 2:5, 3:6, 4:7, 5:7 ) ) }) test_that("can use .before / .after for center-right alignment", { expect_equal( slide(1:7, identity, .before = 1, .after = 2), list( 1:3, 1:4, 2:5, 3:6, 4:7, 5:7, 6:7 ) ) }) # ------------------------------------------------------------------------------ # negative before test_that("can use a negative before to 'look forward'", { expect_equal( slide(1:5, identity, .before = -1, .after = 1), list( 2L, 3L, 4L, 5L, integer() ) ) expect_equal( slide(1:5, identity, .before = -1, .after = Inf), list( 2:5, 3:5, 4:5, 5L, integer() ) ) }) test_that("error if negative .before's abs() is > .after", { expect_snapshot(error = TRUE, { slide(1:5, identity, .before = -1) }) }) test_that("both .before and .after cannot be negative", { expect_snapshot(error = TRUE, { slide(1:5, identity, .before = -1, .after = -1) }) }) # ------------------------------------------------------------------------------ # negative after test_that("can use a negative .after to 'look backward'", { expect_equal( slide(1:5, identity, .before = 1, .after = -1), list( integer(), 1L, 2L, 3L, 4L ) ) expect_equal( slide(1:5, identity, .before = Inf, .after = -1), list( integer(), 1L, 1:2, 1:3, 1:4 ) ) }) test_that("error if negative .after's abs() is > .before", { expect_snapshot(error = TRUE, slide(1:5, identity, .after = -1)) }) # ------------------------------------------------------------------------------ # .step test_that("can step to skip over function calls", { expect_equal( slide(1:7, identity, .step = 2), list( 1, NULL, 3, NULL, 5, NULL, 7 ) ) expect_equal( slide(1:7, identity, .step = 3), list( 1, NULL, NULL, 4, NULL, NULL, 7 ) ) expect_equal( slide(1:6, identity, .before = 1, .step = 2), list( 1, NULL, 2:3, NULL, 4:5, NULL ) ) }) # ------------------------------------------------------------------------------ # .complete test_that(".complete doesn't change the result if not required", { expect_equal( slide(1:7, identity, .complete = TRUE), slide(1:7, identity) ) expect_equal( slide(1:7, identity, .complete = TRUE, .step = 2L), slide(1:7, identity, .step = 2L) ) }) test_that(".complete works when the size shrinks over the last iterations", { expect_equal( slide(1:7, identity, .complete = TRUE, .after = 2L), list( 1:3, 2:4, 3:5, 4:6, 5:7, NULL, NULL ) ) }) test_that(".complete works when doing center alignment", { expect_equal( slide(1:5, identity, .complete = TRUE, .before = 1, .after = 1), list( NULL, 1:3, 2:4, 3:5, NULL ) ) }) test_that(".complete works with negative .before", { expect_equal( slide(1:5, ~.x, .before = -1, .after = 2, .complete = TRUE), list( 2:3, 3:4, 4:5, NULL, NULL ) ) }) # ------------------------------------------------------------------------------ # unbounded test_that("can use Inf in .before for cumulative sliding", { expect_equal( slide(1:5, identity, .before = Inf), list( 1L, 1:2, 1:3, 1:4, 1:5 ) ) }) test_that("can use Inf in .before + set .after", { expect_equal( slide(1:5, identity, .before = Inf, .after = 1L), list( 1:2, 1:3, 1:4, 1:5, 1:5 ) ) expect_equal( slide(1:5, identity, .before = Inf, .after = -1L), list( integer(), 1L, 1:2, 1:3, 1:4 ) ) }) test_that("can use Inf in .after for cumulative sliding", { expect_equal( slide(1:5, identity, .after = Inf), list( 1:5, 2:5, 3:5, 4:5, 5L ) ) }) test_that("can use Inf in .after + set .before", { expect_equal( slide(1:5, identity, .after = Inf, .before = 1L), list( 1:5, 1:5, 2:5, 3:5, 4:5 ) ) expect_equal( slide(1:5, identity, .after = Inf, .before = 1L, .complete = TRUE), list( NULL, 1:5, 2:5, 3:5, 4:5 ) ) expect_equal( slide(1:5, identity, .after = Inf, .before = -1L), list( 2:5, 3:5, 4:5, 5L, integer() ) ) }) test_that("can be doubly unbounded", { expect_equal( slide(1:5, identity, .before = Inf, .after = Inf), list( 1:5, 1:5, 1:5, 1:5, 1:5 ) ) expect_equal( slide(1:5, identity, .before = Inf, .after = Inf, .complete = TRUE), list( 1:5, 1:5, 1:5, 1:5, 1:5 ) ) }) # ------------------------------------------------------------------------------ # data frames test_that("slide() is a rowwise iterator", { x <- data.frame(x = 1:3, y = 2:4) expect_equal( slide(x, identity), list( vec_slice(x, 1), vec_slice(x, 2), vec_slice(x, 3) ) ) expect_equal( slide(x, identity, .before = 1L), list( vec_slice(x, 1L), vec_slice(x, 1:2), vec_slice(x, 2:3) ) ) expect_equal( slide(x, identity, .before = 1L, .complete = TRUE), list( NULL, vec_slice(x, 1:2), vec_slice(x, 2:3) ) ) }) # ------------------------------------------------------------------------------ # type / size relaxed-ness test_that("slide() doesn't require `size = 1`", { expect_equal( slide(1:2, ~c(.x, 1)), list( c(1L, 1L), c(2L, 1L) ) ) }) test_that("`slide()` doesn't require a common inner type", { expect_equal( slide(1:2, ~if (.x == 1L) {1} else {"hi"}), list(1, "hi") ) }) # ------------------------------------------------------------------------------ # input names test_that("input names are retained with atomics", { names <- letters[1:5] x <- set_names(1:5, names) expect_equal(names(slide(x, ~.x)), names) }) test_that("input names are retained from proxied objects", { names <- letters[1:5] x <- as.POSIXlt(new_datetime(0:4 + 0)) x <- set_names(x, names) expect_equal(names(slide(x, ~.x)), names) }) test_that("row names are extracted from data frames", { x <- data.frame(x = 1:5, row.names = letters[1:5]) expect_equal(names(slide(x, ~.x)), letters[1:5]) }) test_that("row names are extracted from arrays", { x <- array(1:4, c(2, 2), dimnames = list(c("r1", "r2"), c("c1", "c2"))) expect_equal(names(slide(x, ~.x)), c("r1", "r2")) }) test_that("names are retained on inner sliced object", { names <- letters[1:5] x <- set_names(1:5, names) exp <- set_names(as.list(names), names) expect_equal(slide(x, ~names(.x)), exp) names <- letters[1:5] x <- data.frame(x = 1:5, row.names = names) expect <- set_names(as.list(names), names) expect_equal(slide(x, ~rownames(.x)), expect) names <- c("r1", "r2") x <- array(1:4, c(2, 2), dimnames = list(names, c("c1", "c2"))) exp <- set_names(as.list(names), names) expect_equal(slide(x, ~rownames(.x)), exp) }) # ------------------------------------------------------------------------------ # validation test_that("cannot use invalid .before", { expect_snapshot(error = TRUE, slide(1, identity, .before = c(1, 2))) expect_snapshot({ (expect_error(slide(1, identity, .before = "x"), class = "vctrs_error_incompatible_type")) }) }) test_that("cannot use invalid .after", { expect_snapshot(error = TRUE, slide(1, identity, .after = c(1, 2))) expect_snapshot({ (expect_error(slide(1, identity, .after = "x"), class = "vctrs_error_incompatible_type")) }) }) test_that("cannot use invalid .step", { expect_snapshot(error = TRUE, slide(1, identity, .step = -1)) expect_snapshot(error = TRUE, slide(1, identity, .step = 0)) expect_snapshot(error = TRUE, slide(1, identity, .step = c(1, 2))) expect_snapshot({ (expect_error(slide(1, identity, .step = "x"), class = "vctrs_error_incompatible_type")) }) }) test_that("cannot use invalid .complete", { expect_snapshot(error = TRUE, slide(1, identity, .complete = c(TRUE, TRUE))) expect_snapshot({ (expect_error(slide(1, identity, .complete = "hi"), class = "vctrs_error_incompatible_type")) }) }) # ------------------------------------------------------------------------------ # misc test_that("slide() forces arguments in the same way as base R / map()", { f_slide <- slide(1:2, function(i) function(x) x + i) f_base <- lapply(1:2, function(i) function(x) x + i) expect_equal(f_slide[[1]](0), f_base[[1]](0)) expect_equal(f_slide[[2]](0), f_base[[2]](0)) }) test_that(paste0( "proof that the `window_stop < window_start` check is required for ", "cases where the window is completely OOB" ), { expect_equal( slide(1:3, identity, .before = 4, .after = -4), list(integer(), integer(), integer()) ) }) test_that("`error_call` and `.error_call` args aren't swallowed", { fn <- function(x, error_call) { abort("hi", call = error_call) } fn_dot <- function(x, .error_call) { abort("hi", call = .error_call) } expect_snapshot(error = TRUE, { slide(1, fn, error_call = call("foo")) }) expect_snapshot(error = TRUE, { slide(1, fn_dot, .error_call = call("foo")) }) })