test-Date-DateTime.R
In santoku: A Versatile Cutting Tool

d1 <- seq(as.Date("1975-10-27"), as.Date("1975-11-27"), by = "day")

db1 <- as.Date(c("1975-11-01", "1975-11-15"))

dt1 <- seq(as.POSIXct("2000-01-01 15:00"), length = 20, by = "1 min")

dtb1 <- dt1[c(5, 15)]

table_vals <- function (x) unclass(table(x))


test_that("Basic chop", {
  expect_silent(chop(d1, db1))
  expect_silent(chop(dt1, dtb1))
})


test_that("Chop with conversion", {
  lb <- lbl_seq()
  withr::with_timezone("UTC", {
    expect_equivalent(chop(d1, db1, lb), chop(as.POSIXct(d1), db1, lb))
    expect_equivalent(chop(d1, db1, lb), chop(d1, as.POSIXct(db1), lb))
  })
})


test_that("Basic breaks", {
  expect_silent(brk_res(brk_default(db1), d1, extend = FALSE))
  expect_silent(brk_res(brk_default(db1), d1, extend = NULL))
  expect_silent(brk_res(brk_default(db1), d1, extend = TRUE))

  expect_silent(brk_res(brk_default(db1), d1, left = FALSE))
  expect_silent(brk_res(brk_default(db1), d1, close_end = TRUE))
  expect_silent(brk_res(brk_default(db1), d1, left = FALSE, close_end = TRUE))
})


test_that("chop_equally", {
  expect_silent(res <- chop_equally(d1, groups = 4))
  expect_equivalent(table_vals(res), rep(8, 4))

  expect_silent(res2 <- chop_equally(dt1, groups = 4))
  expect_equivalent(table_vals(res2), rep(5, 4))
})


test_that("chop_n", {
  expect_silent(res <- chop_n(d1, 4))
  expect_equivalent(table_vals(res), rep(4, 8))

  expect_silent(res2 <- chop_n(dt1, 5))
  expect_equivalent(table_vals(res2), rep(5, 4))
})


test_that("chop_quantiles", {
  # `left = FALSE` works better with type 1 quantiles, which round down.
  expect_silent(res1 <- chop_quantiles(d1, 0:4/4, left = FALSE))
  expect_equivalent(table_vals(res1), rep(8, 4))

  expect_silent(res2 <- chop_quantiles(dt1, 0:5/5, left = FALSE))
  expect_equivalent(table_vals(res2), rep(4, 5))
})


test_that("chop_mean_sd", {
  expect_silent(res <- chop_mean_sd(d1))
  cmp <- cut(d1, mean(d1) + (-2:2) * sd(d1), right = FALSE)
  expect_equivalent(table_vals(res), table_vals(cmp))

  expect_silent(res2 <- chop_mean_sd(dt1))
  cmp2 <- cut(dt1, mean(dt1) + (-2:2) * sd(dt1), right = FALSE)
  expect_equivalent(table_vals(res2), table_vals(cmp2))

  expect_silent(res3 <- chop_mean_sd(d1, c(1, 1.4)))
  # the -10 and 10 capture values outside 1.4 sds:
  cmp3 <- cut(d1,  mean(d1) + c(-10, -1.4, -1, 0, 1, 1.4, 10) * sd(d1), right = FALSE)
  expect_equivalent(table_vals(res3), table_vals(cmp3))
})


test_that("chop_pretty", {
  expect_silent(res <- chop_pretty(d1))
  cmp <- chop(d1, base::pretty(d1))
  expect_equivalent(
    table_vals(res),
    table_vals(cmp)
  )
})


test_that("chop_width: difftime", {
  difftime_w1 <- as.difftime(4, units = "days")

  expect_silent(res1 <- chop_width(d1, width = difftime_w1))
  expect_equivalent(table_vals(res1), rep(4, 8))

  expect_silent(
    res2 <- chop_width(d1, width = difftime_w1, start = as.Date("1975-11-01"))
  )
  tv <- table_vals(res2)
  expect_true(all(tv[c(-1, -length(tv))] == 4))

  difftime_w2 <- as.difftime(5, units = "mins")

  expect_silent(res3 <- chop_width(dt1, width = difftime_w2))
  expect_equivalent(table_vals(res3), rep(5, 4))

  expect_silent(
    res4 <- chop_width(dt1, width = difftime_w2,
          start = as.POSIXct("2000-01-01 15:10"))
  )
  expect_equivalent(table_vals(res4), c(10, 5, 5))

  expect_silent(
    res5 <- chop_width(d1, width = as.difftime(-4, units = "days"))
  )
  expect_equivalent(table_vals(res5), rep(4, 8))

  expect_silent(
    res6 <- chop_width(d1, width = as.difftime(-4, units = "days"),
          start = as.Date("1975-11-25"))
  )
  tv <- table_vals(res6)
  expect_true(all(tv[c(-1, -length(tv))] == 4))

  expect_silent(
    res7 <- chop_width(dt1, width = as.difftime(-5, units = "mins"))
  )
  expect_equivalent(table_vals(res7), rep(5, 4))

  expect_silent(chop_width(d1, as.difftime(7, units = "days")))
  expect_silent(chop_width(dt1, as.difftime(7, units = "mins")))
})


test_that("chop_width: Duration", {
  skip_if_not_installed("lubridate")
  library(lubridate)

  duration_w1 <- ddays(4)

  expect_silent(res1 <- chop_width(d1, width = duration_w1))
  expect_equivalent(table_vals(res1), rep(4, 8))

  expect_silent(
    res2 <- chop_width(d1, width = duration_w1, start = as.Date("1975-11-16"))
  )
  expect_equivalent(table_vals(res2), c(20, 4, 4, 4))

  duration_w2 <- dminutes(5)

  expect_silent(res3 <- chop_width(dt1, width = duration_w2))
  expect_equivalent(table_vals(res3), rep(5, 4))

  expect_silent(
    res4 <- chop_width(dt1, duration_w2, start = as.POSIXct("2000-01-01 15:10"))
  )
  expect_equivalent(table_vals(res4), c(10, 5, 5))

  expect_silent(chop_width(d1, ddays(7)))
  expect_silent(chop_width(dt1, dminutes(7)))
})


test_that("chop_width: Period", {
  skip_if_not_installed("lubridate")
  library(lubridate)

  period_w1 <- days(8)

  expect_silent(res1 <- chop_width(d1, width = period_w1))
  expect_equivalent(table_vals(res1), rep(8, 4))

  expect_silent(
    res2 <- chop_width(d1, period_w1, start = as.Date("1975-11-12"))
  )
  expect_equivalent(table_vals(res2), c(16, 8, 8))

  period_w2 <- minutes(5)

  expect_silent(res3 <- chop_width(dt1, width = period_w2))
  expect_equivalent(table_vals(res3), rep(5, 4))

  expect_silent(
    res4 <- chop_width(dt1, period_w2, start = as.POSIXct("2000-01-01 15:07"))
  )
  expect_equivalent(table_vals(res4), c(7, 5, 5, 3))

  expect_silent(chop_width(d1, days(7)))
  expect_silent(chop_width(dt1, minutes(7)))

  # TODO: include tests that Period deals with quirks
})


test_that("chop_width: Period quirks", {
  skip_if_not_installed("lubridate")
  library(lubridate)

  noughties <- seq(as.Date("2000-01-01"), as.Date("2009-12-31"), by = "day")

  res1 <- chop_width(noughties, years(1))
  expect_equivalent(
    table_vals(res1),
    c(366, 365, 365, 365, 366, 365, 365, 365, 366, 365)
  )

  y2k <- seq(as.Date("2000-01-01"), as.Date("2000-12-31"), by = "day")
  res2 <- chop_width(y2k, months(1))
  expect_equivalent(
    table_vals(res2),
    c(31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
  )
})


test_that("chop_evenly", {
  expect_silent(res1 <- chop_evenly(d1, 8))
  expect_equivalent(table_vals(res1), rep(4, 8))

  expect_silent(res2 <- chop_evenly(dt1, 4))
  expect_equivalent(table_vals(res2), rep(5, 4))

  expect_silent(chop_evenly(d1, 7))
  expect_silent(chop_evenly(dt1, 7))
})


test_that("chop timezones", {
  dt_z1 <- seq(as.POSIXct("2000-01-01 09:00:00", tz = "GMT"),
        by = "hour", length.out = 24)
  # 8 hours behind. Hi Tom and Dan!
  dtb_z2 <- as.POSIXct("2000-01-01 12:30:00", tz = "America/Los_Angeles")

  res1 <- chop(dt_z1, dtb_z2)
  expect_equivalent(table_vals(res1), c(12, 12))
  # we convert breaks to the timezone of x
  expect_match(levels(res1), "20:30", fixed = TRUE)
})


test_that("Date labels", {
  li <- lbl_intervals()
  b <- brk_res(brk_default(db1))
  expect_equivalent(
    li(b), "[1975-11-01, 1975-11-15)"
  )

  b2 <- brk_res(brk_default(db1), x = as.Date("1975-01-01"), extend = TRUE)
  expect_equivalent(
    li(b2), c("[-Inf, 1975-11-01)", "[1975-11-01, 1975-11-15)", "[1975-11-15, Inf]")
  )

  expect_equivalent(
    lbl_intervals(fmt = "%y %m %d")(b),
    "[75 11 01, 75 11 15)"
  )

  expect_equivalent(
    lbl_dash(" to ")(b),
    "1975-11-01 to 1975-11-15"
  )

  expect_equivalent(
    lbl_dash(" to ", fmt = "%d/%m")(b),
    "01/11 to 15/11"
  )
})


test_that("POSIXct labels", {
  li <- lbl_intervals()
  b <- brk_res(brk_default(dtb1))
  expect_equivalent(
    li(b), "[2000-01-01 15:04:00, 2000-01-01 15:14:00)"
  )

  b2 <- brk_res(brk_default(dtb1), x = as.POSIXct("2000-01-01 15:00:00"), extend = TRUE)
  expect_equivalent(
    li(b2), c("[-Inf, 2000-01-01 15:04:00)",
              "[2000-01-01 15:04:00, 2000-01-01 15:14:00)",
              "[2000-01-01 15:14:00, Inf]")
  )

  expect_equivalent(
    lbl_intervals(fmt = "%H:%M")(b),
    "[15:04, 15:14)"
  )

  expect_equivalent(
    lbl_dash(" to ")(b),
    "2000-01-01 15:04:00 to 2000-01-01 15:14:00"
  )

  expect_equivalent(
    lbl_dash(" to ", fmt = "%H.%M")(b),
    "15.04 to 15.14"
  )
})