tests/testthat/test-slide-period.R

In DavisVaughan/slurrr: Sliding Window Functions

test_that("basic call works", {
  expect_equal(
    slide_period(1, as.Date("2019-01-01"), "year", identity),
    list(1)
  )
})

test_that("`.x` must be a vector", {
  expect_snapshot({
    (expect_error(slide_period(call("fn")), class = "vctrs_error_scalar_type"))
  })
})

test_that(".x must be the same size as .i", {
  expect_snapshot({
    (expect_error(slide_period(1, new_date(c(1, 2)), "year", identity), class = "slider_error_index_incompatible_size"))
  })
})

test_that(".i must be ascending", {
  expect_snapshot({
    (expect_error(slide_period(1:2, new_date(c(2, 1)), "year", identity), class = "slider_error_index_must_be_ascending"))
  })
})

test_that("empty input returns a list, but after the index size check", {
  expect_equal(slide_period(integer(), new_date(), "year", ~.x), list())
  expect_snapshot({
    (expect_error(slide_period(integer(), new_date(0), "year", ~.x), class = "slider_error_index_incompatible_size"))
  })
})

test_that("empty input works with `.complete = TRUE` (#111)", {
  expect_equal(slide_period(integer(), new_date(), "year", ~.x, .complete = TRUE), list())
})

test_that(".i must not contain NA values", {
  expect_snapshot({
    (expect_error(slide_period(1:2, new_date(c(1, NA)), "year", identity), class = "slider_error_index_cannot_be_na"))
    (expect_error(slide_period(1:2, new_date(c(NA, 1)), "year", identity), class = "slider_error_index_cannot_be_na"))
  })
})

# ------------------------------------------------------------------------------
# .before

test_that("`.before` works", {
  expect_equal(
    slide_period(1:2, new_date(c(30, 31)), "month", identity, .before = 1),
    list(1, c(1, 2))
  )
})

test_that("`.before` skips over irregular period gaps", {
  i <- as.Date(c("2019-01-01", "2019-02-01", "2019-04-01"))

  expect_equal(
    slide_period(1:3, i, "month", identity, .before = 1),
    list(1, 1:2, 3)
  )

  expect_equal(
    slide_period(1:3, i, "month", identity, .before = 2),
    list(1, 1:2, 2:3)
  )
})

test_that("`.before` set to Inf works", {
  i <- as.Date(c("2019-01-01", "2019-02-01", "2019-04-01"))

  expect_equal(
    slide_period(1:3, i, "month", identity, .before = Inf),
    list(1, 1:2, 1:3)
  )
})

test_that("can use negative `.before`", {
  i <- as.Date(c("2019-01-01", "2019-02-01", "2019-04-01"))

  expect_equal(
    slide_period(1:3, i, "month", identity, .before = -1, .after = 1),
    list(2, integer(), integer())
  )
})

test_that("`.before` range cannot be after `.after` range", {
  i <- as.Date(c("2019-01-01", "2019-02-01", "2019-04-01"))

  expect_snapshot(error = TRUE, {
    slide_period(1:3, i, "month", identity, .before = -1)
  })
})

test_that("`.before` cannot be NA", {
  expect_snapshot(error = TRUE, {
    slide_period(1, new_date(0), "year", identity, .before = NA_integer_)
  })
})

test_that("`.before` cannot be -Inf", {
  expect_snapshot({
    (expect_error(
      slide_period(1, new_date(0), "year", identity, .before = -Inf),
      class = "vctrs_error_cast_lossy"
    ))
  })
})

test_that(".before must be size 1", {
  expect_snapshot({
    expect_error(
      slide_period(1, new_date(0), "year", identity, .before = c(1L, 2L)),
      class = "vctrs_error_assert_size"
    )
  })
})

test_that("error if .before is NULL", {
  expect_snapshot({
    expect_error(
      slide_period(1, new_date(0), "year", identity, .before = NULL),
      class = "vctrs_error_scalar_type"
    )
  })
})

# ------------------------------------------------------------------------------
# .after

test_that("`.after` works", {
  expect_equal(
    slide_period(1:2, new_date(c(30, 31)), "month", identity, .after = 1),
    list(1:2, 2)
  )
})

test_that("`.after` skips over irregular period gaps", {
  i <- as.Date(c("2019-01-01", "2019-02-01", "2019-04-01"))

  expect_equal(
    slide_period(1:3, i, "month", identity, .after = 1),
    list(1:2, 2, 3)
  )

  expect_equal(
    slide_period(1:3, i, "month", identity, .after = 2),
    list(1:2, 2:3, 3)
  )
})

test_that("`.after` set to Inf works", {
  i <- as.Date(c("2019-01-01", "2019-02-01", "2019-04-01"))

  expect_equal(
    slide_period(1:3, i, "month", identity, .after = Inf),
    list(1:3, 2:3, 3)
  )
})

test_that("can use negative `.after`", {
  i <- as.Date(c("2019-01-01", "2019-02-01", "2019-04-01"))

  expect_equal(
    slide_period(1:3, i, "month", identity, .after = -1, .before = 1),
    list(integer(), 1, integer())
  )
})

test_that("`.after` range cannot be before `.before` range", {
  i <- as.Date(c("2019-01-01", "2019-02-01", "2019-04-01"))

  expect_snapshot(error = TRUE, {
    slide_period(1:3, i, "month", identity, .after = -1)
  })
})

test_that("`.after` cannot be NA", {
  expect_snapshot(error = TRUE, {
    slide_period(1, new_date(0), "year", identity, .after = NA_integer_)
  })
})

test_that("`.after` cannot be -Inf", {
  expect_snapshot({
    (expect_error(
      slide_period(1, new_date(0), "year", identity, .after = -Inf),
      class = "vctrs_error_cast_lossy"
    ))
  })
})

test_that(".after must be size 1", {
  expect_snapshot({
    (expect_error(
      slide_period(1, new_date(0), "year", identity, .after = c(1L, 2L)),
      class = "vctrs_error_assert_size"
    ))
  })
})

test_that("error if .after is NULL", {
  expect_snapshot({
    (expect_error(
      slide_period(1, new_date(0), "year", identity, .after = NULL),
      class = "vctrs_error_scalar_type"
    ))
  })
})


# ------------------------------------------------------------------------------
# .complete

test_that("`.complete` works", {
  expect_equal(
    slide_period(1:2, new_date(c(30, 31)), "month", identity, .before = 1, .complete = TRUE),
    list(NULL, 1:2)
  )

  expect_equal(
    slide_period(1:2, new_date(c(30, 31)), "month", identity, .after = 1, .complete = TRUE),
    list(1:2, NULL)
  )
})

test_that(paste0(
            "proof that we need to be careful about slicing `starts` and `stops` ",
            "when `.complete = TRUE` if we are completely OOB"
          ), {

  expect_equal(
    slide_period(1:3, new_date(c(0, 2, 3)), "day", identity, .before = 4, .after = -4, .complete = TRUE),
    list(NULL, NULL, NULL)
  )
})

test_that("works when the window is between values and `.complete = TRUE`", {
  expect_equal(
    slide_period(1:3, new_date(c(0, 2, 3)), "day", identity, .before = 1, .after = -1, .complete = TRUE),
    list(NULL, integer(), 2)
  )
})

test_that("`.complete` cannot be NA", {
  expect_snapshot(error = TRUE, {
    slide_period(1, new_date(0), "year", identity, .complete = NA)
  })
})

test_that(".complete must be size 1", {
  expect_snapshot({
    expect_error(
      slide_period(1, new_date(0), "year", identity, .complete = c(TRUE, FALSE)),
      class = "vctrs_error_assert_size"
    )
  })
})

test_that("error if .complete is NULL", {
  expect_snapshot({
    expect_error(
      slide_period(1, new_date(0), "year", identity, .complete = NULL),
      class = "vctrs_error_scalar_type"
    )
  })
})

# ------------------------------------------------------------------------------
# misc

test_that("being completely OOB returns 0-slices of `x`", {
  expect_equal(
    slide_period(1:3, new_date(c(0, 2, 3)), "day", identity, .before = 4, .after = -4),
    list(integer(), integer(), integer())
  )
})

test_that("having a window completely between values returns 0-slices of `x`", {
  expect_equal(
    slide_period(1:3, new_date(c(0, 2, 3)), "day", identity, .before = 1, .after = -1),
    list(integer(), integer(), 2)
  )
})