tests/testthat/test-week-year-week-day.R

# ------------------------------------------------------------------------------
# year_week_day()

test_that("helper can create different precisions", {
  x <- year_week_day(2019, 1:2)
  expect_identical(get_year(x), c(2019L, 2019L))
  expect_identical(get_week(x), 1:2)

  x <- year_week_day(2019, 1:2, 3)
  expect_identical(get_day(x), c(3L, 3L))
})

test_that("can create subsecond precision calendars", {
  x <- year_week_day(2019, 1, 1, 0, 0, 0, 1, subsecond_precision = "millisecond")
  expect_identical(get_millisecond(x), 1L)

  x <- year_week_day(2019, 1, 1, 0, 0, 0, 1, subsecond_precision = "microsecond")
  expect_identical(get_microsecond(x), 1L)

  x <- year_week_day(2019, 1, 1, 0, 0, 0, 1, subsecond_precision = "nanosecond")
  expect_identical(get_nanosecond(x), 1L)
})

test_that("validates value ranges", {
  expect_snapshot(error = TRUE, year_week_day(50000))
  expect_snapshot(error = TRUE, year_week_day(2020, 54))
  expect_snapshot(error = TRUE, year_week_day(2020, 1, 8))
  expect_snapshot(error = TRUE, year_week_day(2020, 1, 1, 24))
  expect_snapshot(error = TRUE, year_week_day(2020, 1, 1, 1, 60))
  expect_snapshot(error = TRUE, year_week_day(2020, 1, 1, 1, 1, 60))
  expect_snapshot(error = TRUE, year_week_day(2020, 1, 1, 1, 1, 1, 1000, subsecond_precision = "millisecond"))
  expect_snapshot(error = TRUE, year_week_day(2020, 1, 1, 1, 1, 1, 1000000, subsecond_precision = "microsecond"))
  expect_snapshot(error = TRUE, year_week_day(2020, 1, 1, 1, 1, 1, 1000000000, subsecond_precision = "nanosecond"))
})

test_that("can get the last week of the year", {
  x <- year_week_day(2024:2026, "last")
  expect_identical(get_week(x), c(52L, 53L, 52L))

  x <- year_week_day(2024:2026, "last", start = clock_weekdays$monday)
  expect_identical(get_week(x), c(52L, 52L, 53L))
})

test_that("`NA` propagates through 'last'", {
  x <- year_week_day(c(2019, NA))
  x <- set_week(x, "last")
  expect_identical(get_week(x), c(52L, NA))
})

test_that("ignores values past first `NULL`", {
  expect_identical(year_week_day(2019, day = 2), year_week_day(2019))
})

test_that("NA values propagate", {
  x <- year_week_day(2019, 1:3, c(NA, 2, 3), c(3, 4, NA))
  expect_identical(is.na(x), c(TRUE, FALSE, TRUE))
})

# ------------------------------------------------------------------------------
# vec_ptype()

test_that("ptype is correct", {
  base <- year_week_day(1)
  ptype <- year_week_day(integer())

  for (precision in precision_names()) {
    if (precision == "quarter" || precision == "month") {
      next
    }

    x <- calendar_widen(base, precision)
    expect <- calendar_widen(ptype, precision)

    expect_identical(vec_ptype(x), expect)
  }
})

# ------------------------------------------------------------------------------
# vec_proxy() / vec_restore()

test_that("proxy is a data frame", {
  expect_identical(vec_proxy(year_week_day(2019)), data_frame(year = 2019L))
  expect_identical(vec_proxy(year_week_day(2019, 1)), data_frame(year = 2019L, week = 1L))
})

test_that("proxy has names on `year`", {
  x <- set_names(year_week_day(2019, 1), "nm")
  year <- vec_proxy(x)$year
  expect_named(year, "nm")
})

test_that("restore works", {
  to <- year_week_day(2019, 1:5)
  proxy <- vec_slice(vec_proxy(to), 1:2)
  expect_identical(vec_restore(proxy, to), year_week_day(2019, 1:2))
})

# ------------------------------------------------------------------------------
# vec_ptype_full()

test_that("full ptype is correct", {
  expect_snapshot_output(vec_ptype_full(year_week_day(2019)))
  expect_snapshot_output(vec_ptype_full(year_week_day(2019, start = 2)))
  expect_snapshot_output(vec_ptype_full(year_week_day(2019, 1, 1)))
  expect_snapshot_output(vec_ptype_full(year_week_day(2019, 1, 1, 1, 1, 1, 1, subsecond_precision = "nanosecond")))
  expect_snapshot_output(vec_ptype_full(year_week_day(2019, 53)))
})

# ------------------------------------------------------------------------------
# vec_ptype_abbr()

test_that("abbreviated ptype is correct", {
  expect_snapshot_output(vec_ptype_abbr(year_week_day(2019)))
  expect_snapshot_output(vec_ptype_abbr(year_week_day(2019, start = 2)))
  expect_snapshot_output(vec_ptype_abbr(year_week_day(2019, 1, 1)))
  expect_snapshot_output(vec_ptype_abbr(year_week_day(2019, 1, 1, 1, 1, 1, 1, subsecond_precision = "nanosecond")))
  expect_snapshot_output(vec_ptype_abbr(year_week_day(2019, 53)))
})

# ------------------------------------------------------------------------------
# set_*()

test_that("setters work", {
  x <- year_week_day(1L)

  x <- set_year(x, 2L)
  expect_identical(get_year(x), 2L)

  x <- set_week(x, 1L)
  expect_identical(get_week(x), 1L)

  x <- set_day(x, 2L)
  expect_identical(get_day(x), 2L)

  x <- set_hour(x, 3L)
  expect_identical(get_hour(x), 3L)

  x <- set_minute(x, 4L)
  expect_identical(get_minute(x), 4L)

  x <- set_second(x, 5L)
  expect_identical(get_second(x), 5L)

  ms <- set_millisecond(x, 6L)
  expect_identical(get_millisecond(ms), 6L)

  us <- set_microsecond(x, 7L)
  expect_identical(get_microsecond(us), 7L)

  ns <- set_nanosecond(x, 8L)
  expect_identical(get_nanosecond(ns), 8L)
})

test_that("setters propagate all missings", {
  x <- year_week_day(2019, c(1, NA, 3))
  x <- set_day(x, c(NA, 2, 4))
  expect_identical(vec_detect_missing(x), c(TRUE, TRUE, FALSE))
})

test_that("setters recycling works both ways", {
  x <- year_week_day(2019)

  x <- set_week(x, 1:2)
  expect_identical(x, year_week_day(2019, 1:2))

  x <- set_day(x, 1)
  expect_identical(x, year_week_day(2019, 1:2, 1))

  expect_snapshot(error = TRUE, {
    x <- year_week_day(1:2)
    y <- 1:3
    set_week(x, y)
  })
})

test_that("setters require integer `value`", {
  x <- year_week_day(2019, 1, 2, 3, 4, 5)

  expect_snapshot(error = TRUE, {
    set_year(x, 1.5)
  })
  expect_snapshot(error = TRUE, {
    set_week(x, 1.5)
  })
  expect_snapshot(error = TRUE, {
    set_day(x, 1.5)
  })
  expect_snapshot(error = TRUE, {
    set_hour(x, 1.5)
  })
  expect_snapshot(error = TRUE, {
    set_minute(x, 1.5)
  })
  expect_snapshot(error = TRUE, {
    set_second(x, 1.5)
  })
  expect_snapshot(error = TRUE, {
    set_millisecond(x, 1.5)
  })
  expect_snapshot(error = TRUE, {
    set_microsecond(x, 1.5)
  })
  expect_snapshot(error = TRUE, {
    set_nanosecond(x, 1.5)
  })
})

test_that("setters check `value` range", {
  x <- year_week_day(2019, 1, 2, 3, 4, 5)

  expect_snapshot(error = TRUE, {
    set_year(x, 100000)
  })
  expect_snapshot(error = TRUE, {
    set_week(x, 54)
  })
  expect_snapshot(error = TRUE, {
    set_day(x, 8)
  })
  expect_snapshot(error = TRUE, {
    set_hour(x, 24)
  })
  expect_snapshot(error = TRUE, {
    set_minute(x, 60)
  })
  expect_snapshot(error = TRUE, {
    set_second(x, 60)
  })
  expect_snapshot(error = TRUE, {
    set_millisecond(x, -1)
  })
  expect_snapshot(error = TRUE, {
    set_microsecond(x, -1)
  })
  expect_snapshot(error = TRUE, {
    set_nanosecond(x, -1)
  })
})

test_that("setters require minimum precision", {
  expect_snapshot(error = TRUE, {
    set_day(year_week_day(year = 1), 1)
  })
  expect_snapshot(error = TRUE, {
    set_hour(year_week_day(year = 1, week = 2), 1)
  })
  expect_snapshot(error = TRUE, {
    set_minute(year_week_day(year = 1, week = 2, day = 3), 1)
  })
  expect_snapshot(error = TRUE, {
    set_second(year_week_day(year = 1, week = 2, day = 3, hour = 4), 1)
  })
  expect_snapshot(error = TRUE, {
    set_millisecond(year_week_day(year = 1, week = 2, day = 3, hour = 4, minute = 5), 1)
  })
  expect_snapshot(error = TRUE, {
    set_microsecond(year_week_day(year = 1, week = 2, day = 3, hour = 4, minute = 5), 1)
  })
  expect_snapshot(error = TRUE, {
    set_nanosecond(year_week_day(year = 1, week = 2, day = 3, hour = 4, minute = 5), 1)
  })
})

test_that("setters require correct subsecond precision", {
  expect_snapshot(error = TRUE, {
    set_millisecond(year_week_day(year = 1, week = 2, day = 3, hour = 4, minute = 5, second = 6, subsecond = 7, subsecond_precision = "microsecond"), 1)
  })
  expect_snapshot(error = TRUE, {
    set_millisecond(year_week_day(year = 1, week = 2, day = 3, hour = 4, minute = 5, second = 6, subsecond = 7, subsecond_precision = "nanosecond"), 1)
  })

  expect_snapshot(error = TRUE, {
    set_microsecond(year_week_day(year = 1, week = 2, day = 3, hour = 4, minute = 5, second = 6, subsecond = 7, subsecond_precision = "millisecond"), 1)
  })
  expect_snapshot(error = TRUE, {
    set_microsecond(year_week_day(year = 1, week = 2, day = 3, hour = 4, minute = 5, second = 6, subsecond = 7, subsecond_precision = "nanosecond"), 1)
  })

  expect_snapshot(error = TRUE, {
    set_nanosecond(year_week_day(year = 1, week = 2, day = 3, hour = 4, minute = 5, second = 6, subsecond = 7, subsecond_precision = "millisecond"), 1)
  })
  expect_snapshot(error = TRUE, {
    set_nanosecond(year_week_day(year = 1, week = 2, day = 3, hour = 4, minute = 5, second = 6, subsecond = 7, subsecond_precision = "microsecond"), 1)
  })
})

test_that("setters retain names", {
  x <- year_week_day(2019)
  x <- set_names(x, "foo")
  expect_named(set_week(x, 2), "foo")
})

test_that("setting with named `value` strips its names", {
  x <- year_week_day(2019)
  x <- set_week(x, set_names(1L, "x"))
  expect_named(field(x, "week"), NULL)
})

# ------------------------------------------------------------------------------
# format()

test_that("default formats are correct", {
  expect_snapshot(format(year_week_day(2019)))
  expect_snapshot(format(year_week_day(2019, 1)))
  expect_snapshot(format(year_week_day(2019, 1, 1, 1)))
  expect_snapshot(format(year_week_day(2019, 1, 1, 1, 2, 3, 50, subsecond_precision = "microsecond")))
})

# ------------------------------------------------------------------------------
# as.character()

test_that("as.character() works", {
  x <- year_week_day(2019, 1)
  y <- year_week_day(2019, 1, 2)

  expect_identical(as.character(x), format(x))
  expect_identical(as.character(y), format(y))
})

# ------------------------------------------------------------------------------
# calendar_narrow()

test_that("can narrow to week", {
  x_expect <- year_week_day(2019, 2)
  x <- set_day(x_expect, 1)
  expect_identical(calendar_narrow(x, "week"), x_expect)
  expect_identical(calendar_narrow(x_expect, "week"), x_expect)
})

test_that("can narrow to day", {
  x_expect <- year_week_day(2019, 2, 3)
  x <- set_hour(x_expect, 5)
  expect_identical(calendar_narrow(x, "day"), x_expect)
  expect_identical(calendar_narrow(x_expect, "day"), x_expect)
})

# ------------------------------------------------------------------------------
# calendar_widen()

test_that("can widen to week", {
  x <- year_week_day(2019)
  expect_identical(calendar_widen(x, "week"), set_week(x, 1))
})

test_that("can widen to day", {
  x <- year_week_day(2019)
  y <- year_week_day(2019, 02)
  expect_identical(calendar_widen(x, "day"), set_day(set_week(x, 1), 1))
  expect_identical(calendar_widen(y, "day"), set_day(y, 1))
})

# ------------------------------------------------------------------------------
# calendar_start()

test_that("can compute year start", {
  x <- year_week_day(2019)
  expect_identical(calendar_start(x, "year"), x)

  x <- year_week_day(2019, 2, 2, 2, 2, 2, 2, subsecond_precision = "millisecond")
  expect <- year_week_day(2019, 1, 1, 0, 0, 0, 0, subsecond_precision = "millisecond")
  expect_identical(calendar_start(x, "year"), expect)
})

test_that("can compute week start", {
  x <- year_week_day(2019, 2)
  expect_identical(calendar_start(x, "week"), x)

  x <- year_week_day(2019, 2, 2, 2, 2, 2, 2, subsecond_precision = "millisecond")
  expect <- year_week_day(2019, 2, 1, 0, 0, 0, 0, subsecond_precision = "millisecond")
  expect_identical(calendar_start(x, "week"), expect)
})

# ------------------------------------------------------------------------------
# calendar_end()

test_that("can compute year end", {
  x <- year_week_day(2019)
  expect_identical(calendar_end(x, "year"), x)

  x <- year_week_day(2019:2020, 2, 2, 2, 2, 2, 2, subsecond_precision = "millisecond")
  expect <- year_week_day(2019:2020, 52:53, 7, 23, 59, 59, 999L, subsecond_precision = "millisecond")
  expect_identical(calendar_end(x, "year"), expect)
})

test_that("can compute week end", {
  x <- year_week_day(2019, 2)
  expect_identical(calendar_end(x, "week"), x)

  x <- year_week_day(2019, 2, 2, 2, 2, 2, 2, subsecond_precision = "millisecond")
  expect <- year_week_day(2019, 2, 7, 23, 59, 59, 999L, subsecond_precision = "millisecond")
  expect_identical(calendar_end(x, "week"), expect)
})

# ------------------------------------------------------------------------------
# calendar_count_between()

test_that("can compute year counts", {
  x <- year_week_day(2019, 1, 1)
  y <- year_week_day(2020, 3, 4)

  expect_identical(calendar_count_between(x, y, "year"), 1L)
})

test_that("can't compute a unsupported count precision", {
  x <- year_week_day(2019, 1, 1)
  expect_snapshot((expect_error(calendar_count_between(x, x, "week"))))
})

test_that("positive / negative counts are correct", {
  start <- year_week_day(1972, 03, 04)


  end <- year_week_day(1973, 03, 03)
  expect_identical(calendar_count_between(start, end, "year"), 0L)

  end <- year_week_day(1973, 03, 04)
  expect_identical(calendar_count_between(start, end, "year"), 1L)

  end <- year_week_day(1973, 03, 05)
  expect_identical(calendar_count_between(start, end, "year"), 1L)


  end <- year_week_day(1971, 03, 03)
  expect_identical(calendar_count_between(start, end, "year"), -1L)

  end <- year_week_day(1971, 03, 04)
  expect_identical(calendar_count_between(start, end, "year"), -1L)

  end <- year_week_day(1971, 03, 05)
  expect_identical(calendar_count_between(start, end, "year"), 0L)
})

# ------------------------------------------------------------------------------
# seq()

test_that("only year precision is allowed", {
  expect_snapshot(error = TRUE, seq(year_week_day(2019, 1), by = 1, length.out = 2))
})

test_that("seq(to, by) works", {
  expect_identical(seq(year_week_day(2019), to = year_week_day(2024), by = 2), year_week_day(c(2019, 2021, 2023)))
  expect_identical(seq(year_week_day(2019), to = year_week_day(2023), by = 2), year_week_day(c(2019, 2021, 2023)))
})

test_that("seq(to, length.out) works", {
  expect_identical(seq(year_week_day(2019), to = year_week_day(2024), length.out = 2), year_week_day(c(2019, 2024)))
  expect_identical(seq(year_week_day(2019), to = year_week_day(2024), length.out = 6), year_week_day(2019:2024))

  expect_identical(seq(year_week_day(2019), to = year_week_day(2024), along.with = 1:2), year_week_day(c(2019, 2024)))
})

test_that("seq(by, length.out) works", {
  expect_identical(seq(year_week_day(2019), by = 2, length.out = 3), year_week_day(c(2019, 2021, 2023)))

  expect_identical(seq(year_week_day(2019), by = 2, along.with = 1:3), year_week_day(c(2019, 2021, 2023)))
})

# ------------------------------------------------------------------------------
# miscellaneous

test_that("can roundtrip to naive-time with any `start`", {
  x <- seq(
    as_naive_time(year_month_day(-9999, 1, 1)),
    as_naive_time(year_month_day(9999, 12, 31)),
    by = 1
  )

  for (start in seq_len(7)) {
    expect_identical(x, as_naive_time(as_year_week_day(x, start = start)))
  }
})

test_that("can generate correct last week of the year with any `start`", {
  start <- 1L

  expect_identical(
    as.Date(year_week_day(2019:2023, "last", 7, start = 1)),
    as.Date(year_month_day(
      c(2019, 2021, 2022, 2022, 2023),
      c(12, 1, 1, 12, 12),
      c(28, 2, 1, 31, 30)
    ))
  )
  expect_identical(
    as.Date(year_week_day(2019:2023, "last", 7, start = 2)),
    as.Date(year_month_day(
      c(2019, 2021, 2022, 2023, 2023),
      c(12, 1, 1, 1, 12),
      c(29, 3, 2, 1, 31)
    ))
  )
  expect_identical(
    as.Date(year_week_day(2019:2023, "last", 7, start = 3)),
    as.Date(year_month_day(
      c(2019, 2020, 2022, 2023, 2024),
      c(12, 12, 1, 1, 1),
      c(30,28, 3, 2, 1)
    ))
  )
  # ..., 4, 5, ...
  expect_identical(
    as.Date(year_week_day(2019:2023, "last", 7, start = 6)),
    as.Date(year_month_day(
      c(2020, 2020, 2021, 2022, 2023),
      c(1, 12, 12, 12, 12),
      c(2, 31, 30, 29, 28)
    ))
  )
  expect_identical(
    as.Date(year_week_day(2019:2023, "last", 7, start = 7)),
    as.Date(year_month_day(
      c(2020, 2021, 2021, 2022, 2023),
      c(1, 1, 12, 12, 12),
      c(3, 1, 31, 30, 29)
    ))
  )
})

# ------------------------------------------------------------------------------
# invalid_detect()

test_that("`invalid_detect()` works", {
  # Not possible to be invalid
  x <- year_week_day(2019:2020)
  expect_identical(invalid_detect(x), c(FALSE, FALSE))

  # Now possible
  x <- year_week_day(2019, c(1, 52, 53, NA))
  expect_identical(invalid_detect(x), c(FALSE, FALSE, TRUE, FALSE))

  # Possible after that too
  x <- year_week_day(2019, c(1, 52, 53, NA), 1)
  expect_identical(invalid_detect(x), c(FALSE, FALSE, TRUE, FALSE))
})

test_that("`invalid_detect()` works with different `start`", {
  x <- year_week_day(2024:2025, 53, start = clock_weekdays$sunday)
  expect_identical(invalid_detect(x), c(TRUE, FALSE))

  x <- year_week_day(2024:2025, 53, start = clock_weekdays$monday)
  expect_identical(invalid_detect(x), c(TRUE, TRUE))
})

# ------------------------------------------------------------------------------
# invalid_any()

test_that("`invalid_any()` works", {
  # Not possible to be invalid
  x <- year_week_day(2019:2020)
  expect_false(invalid_any(x))

  # Now possible
  x <- year_week_day(2019, c(1, 52, 53, NA))
  expect_true(invalid_any(x))

  # Possible after that too
  x <- year_week_day(2019, c(1, 52, 53, NA), 1)
  expect_true(invalid_any(x))
})

test_that("`invalid_any()` works with different `start`", {
  x <- year_week_day(2024:2025, 53, start = clock_weekdays$sunday)
  expect_identical(invalid_any(x), TRUE)

  x <- year_week_day(2024:2025, 53, start = clock_weekdays$monday)
  expect_identical(invalid_any(x), TRUE)
})

# ------------------------------------------------------------------------------
# invalid_count()

test_that("`invalid_count()` works", {
  # Not possible to be invalid
  x <- year_week_day(2019:2020)
  expect_identical(invalid_count(x), 0L)

  # Now possible
  x <- year_week_day(2019, c(1, 52, 53, NA))
  expect_identical(invalid_count(x), 1L)

  # Possible after that too
  x <- year_week_day(2019, c(1, 52, 53, NA), 1)
  expect_identical(invalid_count(x), 1L)
})

test_that("`invalid_count()` works with different `start`", {
  x <- year_week_day(2024:2025, 53, start = clock_weekdays$sunday)
  expect_identical(invalid_count(x), 1L)

  x <- year_week_day(2024:2025, 53, start = clock_weekdays$monday)
  expect_identical(invalid_count(x), 2L)
})

# ------------------------------------------------------------------------------
# invalid_resolve()

test_that("strict mode can be activated", {
  local_options(clock.strict = TRUE)
  expect_snapshot(error = TRUE, invalid_resolve(year_week_day(2019, 1)))
})

test_that("can resolve correctly", {
  x <- year_week_day(2019, 53, 2, 2, 3, 4, 5, subsecond_precision = "millisecond")

  expect_identical(
    invalid_resolve(x, invalid = "previous"),
    year_week_day(2019, 52, 7, 23, 59, 59, 999, subsecond_precision = "millisecond")
  )
  expect_identical(
    invalid_resolve(x, invalid = "previous-day"),
    year_week_day(2019, 52, 7, 2, 3, 4, 5, subsecond_precision = "millisecond")
  )
  expect_identical(
    invalid_resolve(x, invalid = "next"),
    year_week_day(2020, 01, 1, 0, 0, 0, 0, subsecond_precision = "millisecond")
  )
  expect_identical(
    invalid_resolve(x, invalid = "next-day"),
    year_week_day(2020, 01, 1, 2, 3, 4, 5, subsecond_precision = "millisecond")
  )
  expect_identical(
    invalid_resolve(x, invalid = "overflow"),
    year_week_day(2020, 01, 02, 0, 0, 0, 0, subsecond_precision = "millisecond")
  )
  expect_identical(
    invalid_resolve(x, invalid = "overflow-day"),
    year_week_day(2020, 01, 02, 2, 3, 4, 5, subsecond_precision = "millisecond")
  )
  expect_identical(
    invalid_resolve(x, invalid = "NA"),
    year_week_day(NA, NA, NA, NA, NA, NA, NA, subsecond_precision = "millisecond")
  )
})

test_that("throws known classed error", {
  expect_snapshot(error = TRUE, invalid_resolve(year_week_day(2019, 53)))
  expect_error(invalid_resolve(year_week_day(2019, 53)), class = "clock_error_invalid_date")
})

test_that("works with always valid precisions", {
  x <- year_week_day(2019:2020)
  expect_identical(invalid_resolve(x), x)
})

# ------------------------------------------------------------------------------
# vec_math()

test_that("is.nan() works", {
  x <- year_week_day(c(2019, NA))
  expect_identical(is.nan(x), c(FALSE, FALSE))
})

test_that("is.finite() works", {
  x <- year_week_day(c(2019, NA))
  expect_identical(is.finite(x), c(TRUE, FALSE))
})

test_that("is.infinite() works", {
  x <- year_week_day(c(2019, NA))
  expect_identical(is.infinite(x), c(FALSE, FALSE))
})

# ------------------------------------------------------------------------------
# clock_minimum() / clock_maximum()

test_that("minimums are right", {
  expect_snapshot({
    clock_minimum(year_week_day(1))
    clock_minimum(year_week_day(1, 1))
    clock_minimum(year_week_day(1, 1, 1))
    clock_minimum(year_week_day(1, 1, 1, 1))
    clock_minimum(year_week_day(1, 1, 1, 1, 1))
    clock_minimum(year_week_day(1, 1, 1, 1, 1, 1))
    clock_minimum(year_week_day(1, 1, 1, 1, 1, 1, 1, subsecond_precision = "millisecond"))
    clock_minimum(year_week_day(1, 1, 1, 1, 1, 1, 1, subsecond_precision = "microsecond"))
    clock_minimum(year_week_day(1, 1, 1, 1, 1, 1, 1, subsecond_precision = "nanosecond"))
  })
})

test_that("maximums are right", {
  expect_snapshot({
    clock_maximum(year_week_day(1))
    clock_maximum(year_week_day(1, 1))
    clock_maximum(year_week_day(1, 1, 1))
    clock_maximum(year_week_day(1, 1, 1, 1))
    clock_maximum(year_week_day(1, 1, 1, 1, 1))
    clock_maximum(year_week_day(1, 1, 1, 1, 1, 1))
    clock_maximum(year_week_day(1, 1, 1, 1, 1, 1, 1, subsecond_precision = "millisecond"))
    clock_maximum(year_week_day(1, 1, 1, 1, 1, 1, 1, subsecond_precision = "microsecond"))
    clock_maximum(year_week_day(1, 1, 1, 1, 1, 1, 1, subsecond_precision = "nanosecond"))
  })
})

test_that("minimums and maximums respect `start`", {
  expect_snapshot({
    clock_minimum(year_week_day(1, start = clock_weekdays$friday))
    clock_maximum(year_week_day(1, start = clock_weekdays$friday))
  })
})

# ------------------------------------------------------------------------------
# min() / max() / range()

test_that("min() / max() / range() works", {
  x <- year_week_day(c(1, 3, 2, 1, -1))

  expect_identical(min(x), year_week_day(-1))
  expect_identical(max(x), year_week_day(3))
  expect_identical(range(x), year_week_day(c(-1, 3)))
})

test_that("min() / max() / range() works with `NA`", {
  x <- year_week_day(c(1, NA, 2, 0))

  expect_identical(min(x), year_week_day(NA))
  expect_identical(max(x), year_week_day(NA))
  expect_identical(range(x), year_week_day(c(NA, NA)))

  expect_identical(min(x, na.rm = TRUE), year_week_day(0))
  expect_identical(max(x, na.rm = TRUE), year_week_day(2))
  expect_identical(range(x, na.rm = TRUE), year_week_day(c(0, 2)))
})

test_that("min() / max() / range() works when empty", {
  x <- year_week_day(integer())

  expect_identical(min(x), clock_maximum(x))
  expect_identical(max(x), clock_minimum(x))
  expect_identical(range(x), c(clock_maximum(x), clock_minimum(x)))

  x <- year_week_day(c(NA, NA))

  expect_identical(min(x, na.rm = TRUE), clock_maximum(x))
  expect_identical(max(x, na.rm = TRUE), clock_minimum(x))
  expect_identical(range(x, na.rm = TRUE), c(clock_maximum(x), clock_minimum(x)))
})

# ------------------------------------------------------------------------------
# add_*()

test_that("add_years() works", {
  x <- year_week_day(2019, 1, 2, 3:4)

  expect_identical(
    add_years(x, 1:2),
    year_week_day(c(2020, 2021), 1, 2, 3:4)
  )
  expect_identical(
    add_years(x, NA),
    vec_init(x, 2L)
  )
})

test_that("add_*() respect recycling rules", {
  expect_length(add_years(year_week_day(1), 1:2), 2L)
  expect_length(add_years(year_week_day(1:2), 1), 2L)

  expect_length(add_years(year_week_day(1), integer()), 0L)
  expect_length(add_years(year_week_day(integer()), 1), 0L)

  expect_snapshot(error = TRUE, {
    add_years(year_week_day(1:2), 1:3)
  })
})

test_that("add_*() retains names", {
  x <- set_names(year_week_day(1), "x")
  y <- year_week_day(1)

  n <- set_names(1, "n")

  expect_named(add_years(x, n), "x")
  expect_named(add_years(y, n), "n")
})

test_that("`start` value is retained", {
  expect_identical(year_week_day(2019, 1, 1) + duration_years(1), year_week_day(2020, 1, 1))
  expect_identical(year_week_day(2019, 1, 1) + duration_years(5), year_week_day(2024, 1, 1))

  # Ensure that the `start` is retained
  expect_identical(
    year_week_day(2019, 1, 1, start = 2) + duration_years(5),
    year_week_day(2024, 1, 1, start = 2)
  )
})

Try the clock package in your browser

Any scripts or data that you put into this service are public.

clock documentation built on Sept. 11, 2024, 8:39 p.m.