test_that("month constructor and coercion to date works", { dates <- seq.Date(from = as.Date("1970-01-01"), length.out = 6L, by = "2 months") storage.mode(dates) <- "double" # needed for R <= 4.1.3 dat <- new_month(0:5, n=2L) dates5 <- seq.Date(from = as.Date("1970-01-01"), length.out = 6L, by = "5 months") storage.mode(dates5) <- "double" # needed for R <= 4.1.3 dat5 <- new_month(0:5, n=5L) expect_identical(as.Date(dat), dates) expect_identical(as.Date(dat5), dates5) # formatting -------------------------------------------------------------- dates2 <- seq.Date(from = as.Date("1970-01-01"), length.out = 7L, by = "2 months") storage.mode(dates2) <- "double" # needed for R <= 4.1.3 dates2 <- dates2[-1L] expect_identical( format(dat), sprintf("%s to %s", format(dates, "%Y-%b"), format(dates2-1, "%Y-%b")) ) expect_identical(format(new_month(n=2L)), character()) }) test_that("month, pre-epoch dates work", { dates <- seq.Date(from = as.Date("1900-01-01"), length.out = 3L, by = "2 months") storage.mode(dates) <- "double" # needed for R <= 4.1.3 expect_identical(as.Date(as_month(dates, n = 2L)), dates) }) test_that("month, POSIXlt coercion works", { nz <- as.POSIXlt("2021-01-04 02:00:00", tz = "NZ") utc <- as.POSIXlt("2021-01-01 00:00:00", tz = "UTC") result <- as.POSIXlt(as_month(nz, n = 3L)) expect_identical(result, utc) dat <- "2021-01-01" pos <- as.POSIXlt("2021-01-04", tz = "UTC") res1 <- as_month(pos, n = 3L) expect_identical(as.Date(res1), as.Date(dat)) dat <- "2021-01-01" res <- as.POSIXlt(as_month(dat, n = 3L)) expect_s3_class(res, "POSIXlt") expect_identical(julian(res), julian(as.POSIXlt(dat, tz = "UTC"))) expect_error( as.POSIXlt(as_month(dat, n = 3L), tz = "GMT"), " objects can only be converted to UTC. If other timezones are required, first convert to and then proceed as desired.", fixed = TRUE ) }) test_that("month, accessor works", { dat <- as.Date("2021-01-01") expect_identical(get_n(as_month(dat, n = 5L)), 5L) }) test_that("month, POSIXct coercion works", { nz <- as.POSIXct(as.POSIXlt("2021-01-04", tz = "NZ")) dat <- as_month(nz, n = 2L) result <- as.POSIXct(dat) expect_identical(result, as.POSIXct(as.POSIXlt("2021-01-01", tz = "UTC"))) pos <- as.POSIXct(as.POSIXlt("2021-01-04", tz = "UTC")) res1 <- as_month(pos, n = 2L) expect_identical(as.Date(res1), as.Date("2021-01-01")) dat <- "2021-01-01" res <- as.POSIXct(as_month(dat, n = 2L)) expect_identical(res, as.POSIXct(as.POSIXlt(dat), tz = "UTC")) expect_error( as.POSIXct(as_month(dat, n = 2L), tz = "GMT"), " objects can only be converted to UTC. If other timezones are required, first convert to and then proceed as desired.", fixed = TRUE ) }) test_that("month, character coercion works", { dat <- "2021-01-04" res <- as_month(dat, n = 6L) expect_identical(as.Date(res), as.Date("2021-01-01")) dat <- as.factor("2021-01-04") res <- as_month(dat, n = 3L) expect_identical(as.Date(res), as.Date("2021-01-01")) x <- "2020-12-28" dat <- as_month("2020-12-28", n = 2L) res <- as.character(dat) expect_identical( res, sprintf("%s to %s", format(as.Date(x)-30L, "%Y-%b"), format(as.Date(x), "%Y-%b")) ) }) test_that("as_month, misc errors and warnings", { expect_error( as_month(TRUE), "Not implemented for class [logical].", fixed = TRUE ) expect_error( as_month(Sys.Date(), n = 1L), "`n` must be greater than 1. If single month groupings are required please use `as_yearmonth()`.", fixed = TRUE ) expect_error(as_month("bob", n = 2L)) }) test_that("month, as.list works", { dat <- as_month(c("2020-12-28", "2021-01-04"), n = 7L) res <- list(as_month("2020-12-28", n = 7L), as_month("2021-01-04", n = 7L)) expect_identical(res, as.list(dat)) }) test_that("month, is_month works", { dat <- as_month(Sys.Date(), n = 2L) expect_true(is_month(dat)) expect_false(is_month("bob")) }) test_that("month, subsetting works", { x <- as.Date("2023-02-15") dat <- as_month(x, n = 5L) + 0:1 dat <- setNames(dat, c("a", "b")) dat2 <- as.Date(dat) expect_identical(dat[1], c(a=as_month(x, n = 5L))) expect_identical(dat[[2]], as_month(dat2[[2]], n = 5L)) dat[1] <- as_month(x+33, n = 5L) expect_identical(dat[1], c(a=as_month(x + 33, n = 5L))) dat[[2]] <- dat[[1]] expect_identical(dat[[2]], dat[[1]]) expect_error( dat[1] <- "bob", "Can only assign objects in to an object.", fixed = TRUE ) }) test_that("month, combine works", { x <- Sys.Date() dat <- as_month(x, n = 2L) expect_identical(c(dat, dat), as_month(c(x, x), n = 2L)) expect_error( c(dat, "bob"), "Unable to combine objects with other classes.", fixed = TRUE ) }) test_that("month operators and math work", { # comparison operators ---------------------------------------------------- x <- Sys.Date() dat <- as_month(x, n = 7L) expect_true(dat == dat) expect_false(dat != dat) expect_true(dat == dat) expect_true(dat <= dat + 1) expect_true(dat >= dat - 1) expect_true(dat < dat + 1) expect_true(dat > dat - 1) expect_true(dat != dat + 1) expect_error( dat == TRUE, "Can only compare objects with objects.", fixed = TRUE ) # addition ---------------------------------------------------------------- x <- as.Date("2021-01-05") y <- as.Date("2021-01-04") dat1 <- as_month(x, n = 2L) dat2 <- dat1 + 0:1 expect_identical(as.Date(dat2), as.Date(c("2021-01-01", "2021-03-01"))) expect_identical(dat2, 0:1 + dat1) expect_identical(+dat1, dat1) expect_error( dat1 + 1.5, "Can only add integers to objects.", fixed = TRUE ) expect_error( dat1 + dat1, "Cannot add objects to each other.", fixed = TRUE ) # subtraction ------------------------------------------------------------- x <- as.Date("2021-01-05") y <- as.Date("2021-01-04") dat1 <- as_month(x, n = 2L) dat2 <- dat1 - 0:1 expect_identical(as.Date(dat2), as.Date(c("2021-01-01", "2020-11-01"))) expect_identical(as.integer(dat2 - dat1), c(0L, -1L)) expect_error( 1 - dat1, "Can only subtract from a object, not vice-versa.", fixed = TRUE ) expect_error( -dat1, "Cannot negate a object.", fixed = TRUE ) expect_error( dat1 - 1.5, "Can only subtract whole numbers and other objects from objects.", fixed = TRUE ) # Other operations error x <- as_month(as.Date("2021-01-05"), n = 2L) expect_error(dat * 3) expect_error(dat / 3) expect_error(dat ^ 3) expect_error(dat %% 3) expect_error(dat %/% 3) expect_error(dat & 3) expect_error(dat | 3) expect_error(!dat) # Math x <- as_month(as.Date("2021-01-05"), n = 2L) dat <- c(x + 0:1, new_month(NA_integer_, n = 2L)) expect_identical(is.na(dat), c(FALSE, FALSE, TRUE)) expect_identical(is.nan(dat), c(FALSE, FALSE, FALSE)) expect_identical(is.finite(dat), c(TRUE, TRUE, FALSE)) expect_identical(is.infinite(dat), c(FALSE, FALSE, FALSE)) expect_error(abs(dat)) }) test_that("month, miscellaneous work", { expect_identical(new_month(-1.5, n = 2L), new_month(-2L, n = 2L)) expect_error(new_month("bob", n = 2L), "`x` must be integer.", fixed = TRUE) expect_error( as_month(NA_character_, n = 2L), "Unable to parse any entries of `x` as Dates.", fixed = TRUE ) dat <- Sys.Date() dat <- c(dat, dat - 90L) dat <- as_month(dat, 2L) expect_identical(rep(dat, 2L), c(dat, dat)) expect_identical(rep(dat, each = 2L), c(dat[[1]], dat[[1]], dat[[2]], dat[[2]])) expect_identical(unique(c(dat, dat)), dat) dat <- as_month(as.Date("1970-01-01"), n = 3L) expect_identical( seq(dat, dat + 11, by = 2L), new_month(c(0L, 2L, 4L, 6L, 8L, 10L), n = 3L) ) expect_error( seq(dat, dat + 11, by = 2.5), "`by` must be an integer of length 1.", fixed = TRUE ) expect_error( seq(dat, as.integer(dat + 11), by = 2.5), "`to` must be a object of length 1.", fixed = TRUE ) expect_identical(as.integer(new_month(100L, n = 5L)), 100L) expect_identical(as.double(new_month(100L, n = 2L)), 100) expect_identical(min(c(dat, dat+11)), dat) expect_identical(max(c(dat, dat+11)), dat+11) expect_identical(range(seq(dat, dat + 12, by = 2L)), c(dat, dat+12)) expect_error( any(dat), "`any()` is not supported for objects.", fixed = TRUE ) expect_error( new_month(1L, n = 1.5), "`n` must be an integer of length 1.", fixed = TRUE ) expect_error( new_month(1L, n = 1:2), "`n` must be an integer of length 1.", fixed = TRUE ) expect_error( new_month(1L, n = 1L), "`n` must be greater than 1. If single month groupings are required please use `yearmonth()`.", fixed = TRUE ) expect_error( c(as_month(Sys.Date(), n = 2L), as_month(Sys.Date(), n = 3L)), "Unable to combine objects with different groupings.", fixed = TRUE ) expect_false(c(as_month(Sys.Date(), n = 2L) == as_month(Sys.Date(), n = 3L))) expect_true(c(as_month(Sys.Date(), n = 2L) != as_month(Sys.Date(), n = 3L))) dat1 <- as_month(Sys.Date(), n = 2L) dat2 <- dat1 + 1L expect_identical(dat2 - dat1, 1L) expect_error( as_month(Sys.Date(), n = 2L) - as_month(Sys.Date(), n = 3L), " objects must have the same month grouping to perform subtraction.", fixed = TRUE ) }) test_that("month boundary functions work", { dates <- as.Date("2020-01-01") + 0:365 months <- as_month(dates, n = 2) starts <- as.Date(months) ends <- lapply(starts, function(x) seq(x, by = "2 month", length.out = 2L)[2L]) ends <- do.call(c, ends) - 1L expect_identical(date_start(months), starts) expect_identical(date_end(months), ends) })