tests/testthat/test-rset.R

In almanac: Tools for Working with Recurrence Rules

# ------------------------------------------------------------------------------
# new_rset()

test_that("validates rschedules", {
  expect_snapshot(error = TRUE, {
    new_rset(1)
  })
})

test_that("validates rdates", {
  expect_snapshot({
    (expect_error(new_rset(rdates = 1)))
    (expect_error(new_rset(rdates = almanac_global_inf_date)))
    (expect_error(new_rset(rdates = almanac_global_neg_inf_date)))
    (expect_error(new_rset(rdates = almanac_global_na_date)))
  })
})

test_that("validates exdates", {
  expect_snapshot({
    (expect_error(new_rset(exdates = 1)))
    (expect_error(new_rset(exdates = almanac_global_inf_date)))
    (expect_error(new_rset(exdates = almanac_global_neg_inf_date)))
    (expect_error(new_rset(exdates = almanac_global_na_date)))
  })
})

test_that("validates date bounds", {
  expect_snapshot({
    (expect_error(new_rset(rdates = almanac_global_min_date - 1), class = "almanac_error_date_below_minimum"))
    (expect_error(new_rset(rdates = almanac_global_max_date + 1), class = "almanac_error_date_above_maximum"))

    (expect_error(new_rset(exdates = almanac_global_min_date - 1), class = "almanac_error_date_below_minimum"))
    (expect_error(new_rset(exdates = almanac_global_max_date + 1), class = "almanac_error_date_above_maximum"))
  })
})

test_that("`...` must be named", {
  expect_snapshot(error = TRUE, {
    new_rset(rschedules = list(), rdates = new_date(), exdates = new_date(), 1)
  })
})

# ------------------------------------------------------------------------------
# runion()

test_that("can create an empty runion()", {
  x <- runion()
  expect_s3_class(x, "almanac_runion")
  expect_identical(x$rschedules, list())
  expect_identical(x$rdates, new_date())
  expect_identical(x$exdates, new_date())
})

test_that("can add rschedules directly into an runion()", {
  x <- yearly()
  y <- daily()
  z <- runion(x, y)
  expect_identical(z$rschedules, list(x, y))
})

test_that("runion() generates informative output", {
  expect_snapshot({
    "# Empty runion"
    runion()

    "# With rschedules"
    runion(daily(), yearly())
  })
})

test_that("can get the event set with no rschedules", {
  expect_identical(alma_events(runion()), almanac_global_empty_date)
})

test_that("runion works with non-rrules in the set", {
  rrule1 <- daily(since = "1970-01-01", until = "1970-01-02")
  rrule2 <- daily(since = "1970-01-03", until = "1970-01-04")

  rb <- runion(rrule1)

  rb2 <- runion(rb, rrule2)

  expect_identical(alma_events(rb2), new_date(c(0, 1, 2, 3)))
})

test_that("can add an rrule to an runion", {
  a <- daily()
  b <- weekly()

  x <- runion(a, b)

  expect_identical(x$rschedules, list(a, b))
})

test_that("can add an runion to an runion", {
  rrule <- daily()
  runion <- runion()

  x <- runion(rrule, runion)

  expect_equal(x$rschedules, list(rrule, runion))
})

# ------------------------------------------------------------------------------
# new_runion()

test_that("can construct a new runion", {
  expect_s3_class(new_runion(), c("almanac_runion", "almanac_rset", "almanac_rschedule"))
})

test_that("can subclass runion", {
  x <- new_runion(foo = 1, class = "rsubclass")
  expect_s3_class(x, c("rsubclass", "almanac_runion", "almanac_rset", "almanac_rschedule"), exact = TRUE)
  expect_identical(x$foo, 1)
})

# ------------------------------------------------------------------------------
# rintersect()

test_that("can create an empty rintersect()", {
  x <- rintersect()
  expect_s3_class(x, "almanac_rintersect")
  expect_identical(x$rschedules, list())
  expect_identical(x$rdates, new_date())
  expect_identical(x$exdates, new_date())
})

test_that("can add rschedules directly into an rintersect()", {
  x <- yearly()
  y <- daily()
  z <- rintersect(x, y)
  expect_identical(z$rschedules, list(x, y))
})

test_that("rintersect() generates informative output", {
  expect_snapshot({
    "# Empty rintersect"
    rintersect()

    "# With rschedules"
    rintersect(daily(), yearly())
  })
})

test_that("can get the event set with no rschedules", {
  expect_identical(alma_events(rintersect()), almanac_global_empty_date)
})

test_that("rintersect takes the intersection", {
  rrule1 <- daily(since = "1970-01-01", until = "1970-01-02")
  rrule2 <- daily(since = "1970-01-02", until = "1970-01-04")

  rb <- rintersect(rrule1, rrule2)

  expect_identical(alma_events(rb), new_date(1))
})

# ------------------------------------------------------------------------------
# new_rintersect()

test_that("can construct a new rintersect", {
  expect_s3_class(new_rintersect(), c("almanac_rintersect", "almanac_rset", "almanac_rschedule"))
})

test_that("can subclass rintersect", {
  x <- new_rintersect(foo = 1, class = "rsubclass")
  expect_s3_class(x, c("rsubclass", "almanac_rintersect", "almanac_rset", "almanac_rschedule"), exact = TRUE)
  expect_identical(x$foo, 1)
})

# ------------------------------------------------------------------------------
# rsetdiff()

test_that("can create an empty rsetdiff()", {
  x <- rsetdiff()
  expect_s3_class(x, "almanac_rsetdiff")
  expect_identical(x$rschedules, list())
  expect_identical(x$rdates, new_date())
  expect_identical(x$exdates, new_date())
})

test_that("can add rschedules directly into an rsetdiff()", {
  x <- yearly()
  y <- daily()
  z <- rsetdiff(x, y)
  expect_identical(z$rschedules, list(x, y))
})

test_that("rsetdiff() generates informative output", {
  expect_snapshot({
    "# Empty rsetdiff"
    rsetdiff()

    "# With rschedules"
    rsetdiff(daily(), yearly())
  })
})

test_that("can get the event set with no rschedules", {
  expect_identical(alma_events(rsetdiff()), almanac_global_empty_date)
})

test_that("rsetdiff takes the set difference from left to right", {
  rrule1 <- daily(since = "1970-01-01", until = "1970-01-02")
  rrule2 <- daily(since = "1970-01-02", until = "1970-01-03")

  rb1 <- rsetdiff(rrule1, rrule2)

  rb2 <- rsetdiff(rrule2, rrule1)

  expect_identical(alma_events(rb1), new_date(0))
  expect_identical(alma_events(rb2), new_date(2))
})

# ------------------------------------------------------------------------------
# new_rsetdiff()

test_that("can construct a new rsetdiff", {
  expect_s3_class(new_rsetdiff(), c("almanac_rsetdiff", "almanac_rset", "almanac_rschedule"))
})

test_that("can subclass rsetdiff", {
  x <- new_rsetdiff(foo = 1, class = "rsubclass")
  expect_s3_class(x, c("rsubclass", "almanac_rsetdiff", "almanac_rset", "almanac_rschedule"), exact = TRUE)
  expect_identical(x$foo, 1)
})