context("calendrical computations") # ################################################################### # time zones for tests tzs <- intersect(OlsonNames(), c("Asia/Tokyo", "Europe/Warsaw", "UTC", "Etc/GMT+1", "Europe/London", "America/New_York")) # test sample size NN <- 100L # test samples y <- sample(1990L:2020L, NN, replace = TRUE) m <- sample.int(12L, size = NN, replace = TRUE) d <- pmin(sample.int(31L, size = NN, replace = TRUE), .days_in_month(.validate_ym(y, m))) tt <- round(as.numeric(Sys.time()) + runif(NN, -3e7, 3e7), digits = 1) dd <- suppressWarnings(tind(y = y, m = m, d = d)) DD <- as.Date(dd) yy <- as.year(dd) qq <- as.quarter(dd) mm <- as.month(dd) ww <- as.week(dd) tz <- sample(tzs, 1L) tt <- as.date_time(tt, tz = tz) hh <- as.time(tt) ii <- as.tind(as.integer(runif(NN, )), type = "i") nn <- as.tind(runif(NN, -3e7, 3e7), type = "n") # error message - invalid casts errcast <- paste0("^cast from time index type ", dQuote("[a-z]"), " \\([- a-z]+\\) to type ", dQuote("[a-z]"), " \\([- a-z]+\\) in ", sQuote("[\\._a-z]+"), " not possible$") # error message - invalid types errtype <- paste0("^invalid time index type in ", sQuote("[_a-z]+") ,": ", dQuote("[a-z]"), " \\([- a-z]+\\); expected one of the following: ", dQuote("[a-z]"), " \\([- a-z]+\\)(, ", dQuote("[a-z]"), " \\([- a-z]+\\))+$") # warning NAs introduced warnna <- paste0("^NAs introduced; first occurrence: ([a-z]+\\[[0-9]+\\] = [-0-9]+)", "(, [a-z]+\\[[0-9]+\\] = [-0-9]+)+$") test_that("'today' and 'now' work correctly", { nw <- now() td <- today() expect_true(is.tind(nw)) expect_identical(.get.type(nw), "t") expect_identical(length(nw), 1L) expect_identical(.get.tz(nw), Sys.timezone()) expect_true(is.tind(td)) expect_identical(.get.type(td), "d") expect_identical(length(td), 1L) for (tz in tzs) { td <- today(tz) nw <- now(tz) expect_true(is.tind(nw)) expect_identical(.get.type(nw), "t") expect_identical(length(nw), 1L) expect_identical(.get.tz(nw), tz) expect_true(is.tind(td)) expect_identical(.get.type(td), "d") expect_identical(length(td), 1L) } }) test_that("'month_names', 'weekday_names', and 'ampm_indicators' work correctly", { expect_silent(mn <- month_names()) expect_true(is.character(mn)) expect_identical(length(mn), 12L) expect_silent(mn <- month_names(abbreviate = FALSE)) expect_true(is.character(mn)) expect_identical(length(mn), 12L) expect_silent(wn <- weekday_names()) expect_true(is.character(wn)) expect_identical(length(wn), 7L) expect_silent(wn <- weekday_names(abbreviate = FALSE)) expect_true(is.character(wn)) expect_identical(length(wn), 7L) ap <- suppressWarnings(ampm_indicators()) expect_true(is.character(ap)) expect_identical(length(ap), 2L) skip_on_cran() cl <- Sys.getlocale("LC_TIME") if (is.null(cl)) skip("locale information not available") en_locales <- c("C", "en_US", "en_GB", "English_United States", "English_United Kingdom") for (lc in en_locales) { suppressWarnings(en_locale <- Sys.setlocale("LC_TIME", lc)) if (en_locale != "") break } Sys.setlocale("LC_TIME", cl) if (en_locale != "") { mn_ena <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") mn_enf <- c("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December") wn_ena <- c("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun") wn_enf <- c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday") ap_en <- c("am", "pm") expect_silent(mn <- month_names(locale = en_locale)) expect_identical(mn, mn_ena) expect_silent(mn <- month_names(locale = en_locale, abbreviate = FALSE)) expect_identical(mn, mn_enf) expect_silent(wn <- weekday_names(locale = en_locale)) expect_identical(wn, wn_ena) expect_silent(wn <- weekday_names(locale = en_locale, abbreviate = FALSE)) expect_identical(wn, wn_enf) expect_identical(wn, wn_enf) expect_silent(ap <- suppressWarnings(ampm_indicators(locale = en_locale))) expect_identical(tolower(ap), ap_en) } pl_locales <- c("pl", "pl_PL", "Polish", "Polish_Poland") for (lc in pl_locales) { suppressWarnings(pl_locale <- Sys.setlocale("LC_TIME", lc)) if (pl_locale != "") break } Sys.setlocale("LC_TIME", cl) if (pl_locale != "") { mn_pla <- c("sty", "lut", "mar", "kwi", "maj", "cze", "lip", "sie", "wrz", "paź", "lis", "gru") mn_plf <- c("styczeń", "luty", "marzec", "kwiecień", "maj", "czerwiec", "lipiec", "sierpień", "wrzesień", "październik", "listopad", "grudzień") wn_pla <- c("pon", "wto", "śro", "czw", "pią", "sob", "nie") wn_plf <- c("poniedziałek", "wtorek", "środa", "czwartek", "piątek", "sobota", "niedziela") expect_silent(mn <- month_names(locale = pl_locale)) # limit check to names with ASCII-only characters allascii <- c(1L:9L, 11:12L) expect_identical(mn[allascii], mn_pla[allascii]) expect_silent(mn <- month_names(locale = pl_locale, abbreviate = FALSE)) allascii <- c(2L:3L, 5L:7L, 11L) # subtr to handle different gramatical forms expect_identical(substr(mn[allascii], 0L, 3L), substr(mn_plf[allascii], 0L, 3L)) expect_silent(wn <- weekday_names(locale = pl_locale)) allascii <- c(1L:2L, 4L, 6L:7L) expect_identical(wn[allascii], wn_pla[allascii]) expect_silent(wn <- weekday_names(locale = pl_locale, abbreviate = FALSE)) allascii <- c(2L, 4L, 6L:7L) expect_identical(wn[allascii], wn_plf[allascii]) warn <- "AM/PM indicators not available in the selected / current locale" expect_warning(ap <- ampm_indicators(locale = pl_locale), warn, fixed = TRUE) expect_true(is.character(ap) && (length(ap) == 2L) && all(is.na(ap))) } }) test_that("'year', 'quarter', 'month', 'week', 'day', 'day_of_week', and 'day_of_year' work correctly", { expect_identical(year(dd), as.integer(format(DD, "%Y"))) expect_identical(year(tind(type = "t")), integer()) expect_identical(year(tind(type = "d")), integer()) expect_identical(year(as.tind(NA_integer_, type = "d")), NA_integer_) expect_identical(year(ww), as.integer(format(DD, "%G"))) expect_identical(year(tind(type = "w")), integer()) expect_identical(year(mm), as.integer(format(DD, "%Y"))) expect_identical(year(tind(type = "m")), integer()) expect_identical(year(qq), as.integer(format(DD, "%Y"))) expect_identical(year(tind(type = "q")), integer()) expect_identical(year(yy), as.integer(format(DD, "%Y"))) expect_identical(year(tind(type = "y")), integer()) expect_error(year(tind(type = "n")), errcast) expect_error(year(tind(type = "h")), errcast) expect_identical(quarter(dd), 1L + (as.integer(format(DD, "%m")) - 1L) %/% 3L) expect_identical(quarter(tind(type = "t")), integer()) expect_identical(quarter(tind(type = "d")), integer()) expect_identical(quarter(as.tind(NA_integer_, type = "d")), NA_integer_) expect_error(quarter(ww), errcast) expect_identical(quarter(mm), 1L + (as.integer(format(DD, "%m")) - 1L) %/% 3L) expect_identical(quarter(tind(type = "m")), integer()) expect_identical(quarter(qq), 1L + (as.integer(format(DD, "%m")) - 1L) %/% 3L) expect_identical(quarter(tind(type = "q")), integer()) expect_error(quarter(yy), errcast) expect_error(quarter(tind(type = "n")), errcast) expect_error(quarter(tind(type = "h")), errcast) expect_identical(month(dd), as.integer(format(DD, "%m"))) expect_identical(month(tind(type = "t")), integer()) expect_identical(month(tind(type = "d")), integer()) expect_identical(month(as.tind(NA_integer_, type = "d")), NA_integer_) expect_identical(month(mm), as.integer(format(DD, "%m"))) expect_identical(as.character(month(mm, labels = TRUE, abbreviate = TRUE)), format(DD, "%b")) expect_identical(as.character(month(mm, labels = TRUE, abbreviate = FALSE)), format(DD, "%B")) expect_identical(month(tind(type = "m")), integer()) expect_error(month(ww), errcast) expect_error(month(qq), errcast) expect_error(month(yy), errcast) expect_error(month(tind(type = "n")), errcast) expect_error(month(tind(type = "h")), errcast) expect_identical(week(dd), as.integer(format(DD, "%V"))) expect_identical(week(tind(type = "t")), integer()) expect_identical(week(tind(type = "d")), integer()) expect_identical(week(as.tind(NA_integer_, type = "d")), NA_integer_) expect_identical(week(ww), as.integer(format(DD, "%V"))) expect_identical(week(tind(type = "w")), integer()) expect_error(week(mm), errcast) expect_error(week(qq), errcast) expect_error(week(yy), errcast) expect_error(week(tind(type = "n")), errcast) expect_error(week(tind(type = "h")), errcast) expect_identical(day(dd), as.integer(format(DD, "%d"))) expect_identical(day(tind(type = "t")), integer()) expect_identical(day(tind(type = "d")), integer()) expect_identical(day(as.tind(NA_integer_, type = "d")), NA_integer_) expect_error(day(ww), errcast) expect_error(day(mm), errcast) expect_error(day(qq), errcast) expect_error(day(yy), errcast) expect_error(day(tind(type = "n")), errcast) expect_error(day(tind(type = "h")), errcast) expect_identical(day_of_week(dd), as.integer(format(DD, "%u"))) expect_identical(as.character(day_of_week(dd, labels = TRUE, abbreviate = TRUE)), format(DD, "%a")) expect_identical(as.character(day_of_week(dd, labels = TRUE, abbreviate = FALSE)), format(DD, "%A")) expect_identical(day_of_week(tind(type = "t")), integer()) expect_identical(day_of_week(tind(type = "d")), integer()) expect_identical(day_of_week(as.tind(NA_integer_, type = "d")), NA_integer_) expect_error(day_of_week(ww), errcast) expect_error(day_of_week(mm), errcast) expect_error(day_of_week(qq), errcast) expect_error(day_of_week(yy), errcast) expect_error(day_of_week(tind(type = "n")), errcast) expect_error(day_of_week(tind(type = "h")), errcast) expect_identical(day_of_year(dd), as.integer(format(DD, "%j"))) expect_identical(day_of_year(tind(type = "t")), integer()) expect_identical(day_of_year(tind(type = "d")), integer()) expect_identical(day_of_year(as.tind(NA_integer_, type = "d")), NA_integer_) expect_error(day_of_year(ww), errcast) expect_error(day_of_year(mm), errcast) expect_error(day_of_year(qq), errcast) expect_error(day_of_year(yy), errcast) expect_error(day_of_year(tind(type = "n")), errcast) expect_error(day_of_year(tind(type = "h")), errcast) for (tz in tzs) { plt <- as.POSIXlt(tt, origin = "1970-01-01 00:00:00", tz = tz) tit <- as.tind(tt, tz = tz) expect_identical(year(tit), as.integer(format(plt, "%Y"))) expect_identical(quarter(tit), 1L + (as.integer(format(plt, "%m")) - 1L) %/% 3L) expect_identical(month(tit), as.integer(format(plt, "%m"))) expect_identical(as.character(month(tit, labels = TRUE, abbreviate = TRUE)), format(plt, "%b")) expect_identical(as.character(month(tit, labels = TRUE, abbreviate = FALSE)), format(plt, "%B")) expect_identical(week(tit), as.integer(format(plt, "%V"))) expect_identical(day(tit), as.integer(format(plt, "%d"))) expect_identical(day_of_week(tit), as.integer(format(plt, "%u"))) expect_identical(as.character(day_of_week(tit, labels = TRUE, abbreviate = TRUE)), format(plt, "%a")) expect_identical(as.character(day_of_week(tit, labels = TRUE, abbreviate = FALSE)), format(plt, "%A")) expect_identical(day_of_year(tit), as.integer(format(plt, "%j"))) } }) test_that("methods 'weekdays', 'months', 'quarters' from base work correctly", { DD[1L] <- NA dd[1L] <- NA expect_identical(weekdays(dd), weekdays(DD)) expect_identical(weekdays(dd, TRUE), weekdays(DD, TRUE)) expect_identical(weekdays(dd, FALSE), weekdays(DD, FALSE)) expect_identical(months(dd), months(DD)) expect_identical(months(dd, TRUE), months(DD, TRUE)) expect_identical(months(dd, FALSE), months(DD, FALSE)) expect_identical(quarters(dd), quarters(DD)) }) test_that("'hour', 'am', 'pm', 'minute', and 'second' work correctly", { for (tp in c("d", "w", "m", "q", "y", "n")) { expect_error(hour(tind(type = tp)), errtype) expect_error(minute(tind(type = tp)), errtype) expect_error(second(tind(type = tp)), errtype) } for (tz in tzs) { tit <- as.tind(tt, tz = tz) plt <- as.POSIXlt(tit) expect_true(is.integer(hour(tit))) expect_identical(hour(tit), plt$hour) expect_identical(hour(tit), hour(plt)) expect_true(is.logical(am(tit))) expect_true(is.logical(pm(tit))) expect_identical(am(tit), plt$hour < 12) expect_identical(pm(tit), plt$hour >= 12) expect_identical(am(tit), !pm(tit)) expect_true(is.integer(minute(tit))) expect_identical(minute(tit), plt$min) expect_identical(minute(tit), minute(plt)) expect_true(is.double(second(tit))) expect_equal(second(tit), round(plt$sec, 6L)) expect_equal(second(tit), second(plt)) expect_identical(hour(tind(type = "t", tz = tz)), integer()) expect_identical(minute(tind(type = "t", tz = tz)), integer()) expect_identical(second(tind(type = "t", tz = tz)), numeric()) expect_identical(am(tind(type = "t", tz = tz)), logical()) expect_identical(pm(tind(type = "t", tz = tz)), logical()) tih <- as.time(tit) expect_identical(hour(tih), as.integer(plt$hour)) expect_identical(am(tih), plt$hour < 12) expect_identical(pm(tih), plt$hour >= 12) expect_identical(am(tih), !pm(tih)) expect_identical(minute(tih), as.integer(plt$min)) expect_equal(second(tih), plt$sec) expect_identical(hour(tind(type = "h")), integer()) expect_identical(minute(tind(type = "h")), integer()) expect_identical(second(tind(type = "h")), numeric()) } }) test_that("'is.leap_year' and 'days_in_year' work correctly", { yy <- c(1900L, 2000L:2019) dy <- c(365L, rep(c(366L, 365L, 365L, 365L), 5L)) ly <- dy == 366L expect_identical(is.leap_year(yy), ly) expect_identical(days_in_year(yy), dy) expect_error(is.leap_year(tind(type = "n")), errcast) expect_error(days_in_year(tind(type = "n")), errcast) }) test_that("'weeks_in_year' works correctly", { yy <- c(1900L, 2000L:2019) wy <- rep(52L, 21L) names(wy) <- yy wy[c("2004", "2009", "2015")] <- 53L names(wy) <- NULL expect_identical(weeks_in_year(as.tind(yy, type = "y")), wy) expect_error(weeks_in_year(tind(type = "n")), errcast) }) test_that("'days_in_quarter' and 'days_in_month' work correctly", { ymd1 <- tind(y = 2000, m = (1L:12L), d = sample.int(28L, size = 12L, replace = TRUE)) ymd2 <- tind(y = 2019, m = (1L:12L), d = sample.int(28L, size = 12L, replace = TRUE)) ymd3 <- tind(y = 1900, m = (1L:12L), d = sample.int(28L, size = 12L, replace = TRUE)) dm1 <- c(31L, 29L, 31L, 30L, 31L, 30L, 31L, 31L, 30L, 31L, 30L, 31L) dm2 <- c(31L, 28L, 31L, 30L, 31L, 30L, 31L, 31L, 30L, 31L, 30L, 31L) dm3 <- dm2 dq1 <- as.integer(kronecker(tapply(dm1, kronecker(1:4, rep(1, 3)), sum), rep(1, 3))) dq2 <- as.integer(kronecker(tapply(dm2, kronecker(1:4, rep(1, 3)), sum), rep(1, 3))) dq3 <- dq2 expect_identical(days_in_quarter(as.tind(ymd1, type = "q")), dq1) expect_identical(days_in_quarter(as.tind(ymd1, type = "d")), dq1) expect_identical(days_in_quarter(as.tind(ymd2, type = "q")), dq2) expect_identical(days_in_quarter(as.tind(ymd2, type = "d")), dq2) expect_identical(days_in_quarter(as.tind(ymd3, type = "q")), dq3) expect_identical(days_in_quarter(as.tind(ymd3, type = "d")), dq3) expect_identical(days_in_month(as.tind(ymd1, type = "m")), dm1) expect_identical(days_in_month(ymd1), dm1) expect_identical(days_in_month(as.tind(ymd2, type = "m")), dm2) expect_identical(days_in_month(ymd2), dm2) expect_identical(days_in_month(as.tind(ymd3, type = "m")), dm3) expect_identical(days_in_month(ymd3), dm3) for (tp in c("y", "q", "w", "i", "n")) { expect_error(days_in_month(tind(type = tp)), errcast) } for (tp in c("y", "w", "i", "n")) { expect_error(days_in_quarter(tind(type = tp)), errcast) } }) test_that("'hours_in_day' and 'is.dst' work correctly", { dd <- as.tind(c(20190310, 20190331, 20191027, 20191103)) expect_identical(hours_in_day(dd, "UTC"), rep(24., 4)) tt <- rep(date_time(dd, tz = "UTC"), each = 25L) + c(0:23, NA) * 3600 expect_identical(is.dst(tt), rep(c(rep(FALSE, 24L), NA), 4L)) expect_identical(is.dst(tt), is.dst(as.POSIXlt(tt))) if ((tz <- "Europe/Warsaw") %in% OlsonNames()) { hd <- c(24., 23, 25, 24) expect_identical(hours_in_day(dd, tz), hd) expect_identical(hours_in_day(as.tind(dd, tz = tz)), hd) expect_identical(hours_in_day(as.tind(dd, tz = tz), tz), hd) tt <- rep(date_time(dd, tz = tz), each = 25L) + c(0:23, NA) * 3600 expect_identical(is.dst(tt), c(rep(FALSE, 24L), NA, rep(FALSE, 2L), rep(TRUE, 22L), NA, rep(TRUE, 3L), rep(FALSE, 21L), NA, rep(FALSE, 24L), NA)) expect_identical(is.dst(tt), is.dst(as.POSIXlt(tt))) } if ((tz <- "America/New_York") %in% OlsonNames()) { hd <- c(23., 24, 24, 25) expect_identical(hours_in_day(dd, tz), hd) expect_identical(hours_in_day(as.tind(dd, tz = tz)), hd) expect_identical(hours_in_day(as.tind(dd, tz = tz), tz), hd) tt <- rep(date_time(dd, tz = tz), each = 25L) + c(0:23, NA) * 3600 expect_identical(is.dst(tt), is.dst(as.POSIXlt(tt))) } expect_error(hours_in_day(tind(type = "y")), errtype) expect_error(hours_in_day(tind(type = "q")), errtype) expect_error(hours_in_day(tind(type = "w")), errtype) expect_error(hours_in_day(tind(type = "n")), errtype) }) test_that("'nth_day_of_year' works correctly", { expect_error(nth_day_of_year(1, tind(type = "n")), errcast) expect_identical(nth_day_of_year(366, 2020), as.tind(20201231)) expect_warning(nth_day_of_year(366, 2019), warnna) expect_warning(nth_day_of_year(0, 2019), warnna) }) test_that("'last_day_in_month' and 'last_day_in_quarter' work correctly", { expect_error(last_day_in_month(tind(type = "y")), errcast) expect_error(last_day_in_month(tind(type = "q")), errcast) expect_error(last_day_in_month(tind(type = "n")), errcast) expect_identical(last_day_in_month(201902), as.tind(20190228)) expect_identical(last_day_in_month(202002), as.tind(20200229)) expect_identical(last_day_in_month(202003), as.tind(20200331)) expect_error(last_day_in_quarter(tind(type = "y")), errcast) expect_error(last_day_in_quarter(tind(type = "n")), errcast) mmti <- as.month(mm) ddti <- as.date(dd) expect_identical(last_day_in_quarter(mmti), last_day_in_month(as.month(as.quarter(mmti) + 1) - 1)) expect_identical(last_day_in_quarter(mmti), last_day_in_quarter(ddti)) }) test_that("'nth_dw_in_month' works correctly", { expect_error(nth_dw_in_month(1, 1, tind(type = "y")), errcast) expect_error(nth_dw_in_month(1, 1, tind(type = "q")), errcast) expect_error(nth_dw_in_month(1, 1, tind(type = "n")), errcast) expect_identical(nth_dw_in_month(1, c(5, 6, 7), 202005), as.tind(20200501 + 0:2)) expect_identical(nth_dw_in_month(2, 1:4, 202005), as.tind(20200511 + 0:3)) expect_warning(nth_dw_in_month(1, 8, 202005), warnna) expect_warning(nth_dw_in_month(1, 0, 202005), warnna) expect_warning(nth_dw_in_month(0, 1, 202005), warnna) expect_warning(nth_dw_in_month(5, 1, 202005), warnna) }) test_that("'last_dw_in_month' works correctly", { expect_error(last_dw_in_month(1, tind(type = "y")), errcast) expect_error(last_dw_in_month(1, tind(type = "q")), errcast) expect_error(last_dw_in_month(1, tind(type = "n")), errcast) expect_identical(last_dw_in_month(1:7, 202005), as.tind(20200524 + 1:7)) expect_warning(last_dw_in_month(8, 202005), warnna) expect_warning(last_dw_in_month(0, 202005), warnna) }) test_that("'easter' works correctly", { expect_error(easter(tind(type = "n")), errcast) eas <- c(20180401L, 20190421L, 20200412L, 20210404L, 20220417L, 20230409L) expect_identical(easter(eas %/% 10000L), as.tind(eas)) }) test_that("'date_time' and 'date_time_split' work correctly", { if ((tz <- "Europe/Warsaw") %in% tzs) { wrn24 <- paste0("NAs introduced; first occurrence: d[1] = 2021-03-27, H[1] = 24, M[1] = 30, S[1] = 0") expect_warning(date_time(20210327, c(24, 1:3), 30, 0, tz, FALSE), wrn24, fixed = TRUE) wrn2 <- paste0("NAs introduced; first occurrence: d[1] = 2021-03-28, H[2] = 2, M[1] = 30; time zone: Europe/Warsaw") expect_warning(date_time(20210328, c(1:3), 30, tz = tz), wrn2, fixed = TRUE) } y <- 2020 mon <- c(11, 3) d <- c(1, 29) ymdc <- c("2020-11-01", "2020-03-29") ymd <- as.tind(ymdc) h <- 20 m <- 4 s <- c(44, 19.66) hmsc <- c("20:04:44", "20:04:19.66") hms <- as.tind(hmsc) for (tz in tzs) { dt0 <- date_time(ymd, hms, tz = tz) dt1 <- date_time(ymdc, hmsc, tz = tz) dt2 <- date_time(ymd, h, m, s, tz = tz) dt3 <- date_time(ymdc, h, m, s, tz = tz) expect_true(identical(dt0, dt1) && identical(dt1, dt2) && identical(dt2, dt3)) expect_true(all(year(dt0) == y) && all(month(dt0) == mon) && all(day(dt0) == d) && all(hour(dt0) == h) && all(minute(dt0) == m) && all(second(dt0) == s)) expect_equal(date_time(ymd, h, tz = tz) + 60 * m + s, date_time(ymd, h, m, s, tz = tz)) expect_equal(date_time(ymd, h, m, tz = tz) + s, date_time(ymd, h, m, s, tz = tz)) expect_identical(date_time(ymd, tz = tz), as.date_time(as.date(ymd), tz = tz)) dtsplt <- date_time_split(dt0) expect_identical(dtsplt$date, ymd) expect_identical(dtsplt$time, hms) } errmish <- paste0(sQuote("M"), " or ", sQuote("S"), " argument provided without ", sQuote("H")) errmism <- paste0(sQuote("S"), " argument provided without ", sQuote("M")) expect_error(date_time(ymd, M = m, S = s), errmish, fixed = TRUE) expect_error(date_time(ymd, M = m), errmish, fixed = TRUE) expect_error(date_time(ymd, S = s), errmish, fixed = TRUE) expect_error(date_time(ymd, H = h, S = s), errmism, fixed = TRUE) errnonnumh <- paste0(sQuote("M"), " or ", sQuote("S"), " argument provided with nonnumeric ", sQuote("H")) expect_error(date_time(ymd, H = hms, M = m, S = s), errnonnumh, fixed = TRUE) expect_error(date_time(ymd, H = hms, M = m), errnonnumh, fixed = TRUE) expect_error(date_time(ymd, H = hms, S = s), errnonnumh, fixed = TRUE) warn <- "longer object length is not a multiple of shorter object length" ymd <- tind(y = 2023, m = 3, d = 26) + -3:1 h <- tind(H = 0:23) tz <- "UTC" expect_warning(date_time(ymd, h, tz = tz), warn, fixed = TRUE) expect_warning(date_time(ymd, h, tz = tz, grid = FALSE), warn, fixed = TRUE) expect_warning(date_time(ymd[1L:3L], h[1L:2L], tz = tz), warn, fixed = TRUE) expect_silent(dt <- date_time(ymd, h, tz = tz, grid = TRUE)) expect_identical(diff(dt), as.tdiff(rep(1, 119), "h")) if ((tz <- "Europe/Warsaw") %in% tzs) { expect_warning(date_time(ymd, h, tz = tz), warn, fixed = TRUE) expect_warning(date_time(ymd, h, tz = tz, grid = FALSE), warn, fixed = TRUE) warn <- "NAs introduced; first occurrence: d[4] = 2023-03-26, H[3] = 02:00; time zone: Europe/Warsaw" expect_warning(date_time(ymd, h, tz = tz, grid = TRUE), warn, fixed = TRUE) } for (tz in tzs) expect_identical(date_time(ymd, H = 24, tz = tz), date_time(ymd + 1, H = 0, tz = tz)) }) test_that("'year_frac' and 'yf2tind' work correctly", { types <- .ti_type(long = FALSE) for (tp in types) { x <- get(paste0(tp, tp)) if (tp %in% c("h", "i", "n")) { expect_error(year_frac(x), errtype) } else { x[sample.int(NN, NN %/% 10L)] <- NA yf <- year_frac(x) expect_true(is.numeric(yf)) expect_equal(floor(yf), as.numeric(as.tind(x, type = "y"))) expect_identical(year_frac(tind(type = tp)), numeric()) expect_identical(year_frac(tind(length = NN, type = tp)), rep(NA_real_, NN)) if (tp != "t") { expect_identical(yf2tind(yf, tp), x) } else { expect_equal(yf2tind(yf, tp, tz), x) } yf[] <- NA expect_identical(yf2tind(yf, tp), tind(length = NN, type = tp)) } } yy[1] <- NA expect_identical(year_frac(yy), as.numeric(yy)) # errors errtype <- paste0("^invalid ", sQuote("type"), " argument; expected one of the following: ", dQuote("[a-z]"), " \\([- a-z]+\\)(, ", dQuote("[a-z]"), " \\([- a-z]+\\))+$") for (tp in c("h", "i", "n")) expect_error(yf2tind(numeric(), tp), errtype) expect_error(yf2tind(numeric()), "type not provided", fixed = TRUE) errx <- paste0("invalid ", sQuote("x"), " argument; expected a numeric vector") expect_error(yf2tind(dd, tp), errx, fixed = TRUE) }) test_that("'jdn' and 'jdn2tind' work correctly", { expect_error(jdn(tind(type = "y")), errtype) expect_error(jdn(tind(type = "q")), errtype) expect_error(jdn(tind(type = "w")), errtype) expect_error(jdn(tind(type = "n")), errtype) expect_identical(jdn(as.tind("2000-01-01")), 2451545L) expect_equal(jdn(as.tind("2013-01-01 00:30Z")), 2456293.520833) expect_identical(jdn2tind(c(2451545L, NA)), as.tind(c("2000-01-01", NA))) expect_identical(jdn2tind(c(2451545., NA)), as.tind(c("2000-01-01", NA))) expect_equal(jdn2tind(2456293.520833333, "UTC"), as.tind("2013-01-01 00:30Z", tz = "UTC")) expect_equal(jdn2tind(2456293.520833333), as.tind("2013-01-01 00:30Z")) err <- paste0("invalid ", sQuote("x"), " argument; expected a numeric vector") expect_error(jdn2tind(tind(type = "d")), err) expect_identical(jdn2tind(integer()), tind(type = "d")) expect_identical(jdn2tind(numeric()), tind(type = "t")) expect_identical(jdn2tind(numeric(), tz = "UTC"), tind(tz = "UTC")) # test name preservation y2k <- as.date(c(y2k = "2000-01-01")) expect_equal(jdn2tind(jdn(y2k)), y2k) })