The R Project SVN
R
(root)/branches/R-more-NS/tests/datetime3.R – Rev 87207
Rev 86501 | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed
## Date-time regression tests for R >= 4.3.0## originally added to reg-tests-1d.R.pt <- proc.time()tryCmsg <- function(expr) tryCatch(expr, error = conditionMessage) # typically == *$messageassertErrV <- function(...) tools::assertError(..., verbose=TRUE)options(warn = max(1, getOption("warn")))if(!nzchar(Sys.getenv("_R_CHECK_DATETIME3_NO_TZ_"))) withAutoprint({## For some inter-platform reproducibility, try to set timezone## even though Sys.setenv(..) does *NOT* always workmyTZ <- "Australia/Melbourne"(TZenvOrig <- Sys.getenv("TZ"))Sys.setenv(TZ = myTZ)Sys.getenv("TZ")TZok <- Sys.getenv("TZ") == myTZif(!TZok) {print(sessionInfo())warning("'TZ' environment variable could *not* be set on this platform")## maybe even: quit("no")}})## 0-length Date and POSIX[cl]t: PR#71290D <- structure(17337, class = "Date") # Sys.Date() of "now"D; D[0]; D[c(1,2,1)] # test printing of NA toostopifnot(identical(capture.output(D[0]), "Date of length 0"))D <- structure(1497973313.62798, class = c("POSIXct", "POSIXt")) # Sys.time()D; D[0]; D[c(1,2,1)] # test printing of NA toostopifnot(identical(capture.output(D[0]), "POSIXct of length 0"))D <- as.POSIXlt(D)D; D[0]; D[c(1,2,1)] # test printing of NA toostopifnot(identical(capture.output(D[0]), "POSIXlt of length 0"))## They printed as '[1] "Date of length 0"' etc in R < 3.5.0## rep.POSIXt(*, by="n DSTdays") - PR#17342x <- seq(as.POSIXct("1982-04-15 05:00", tz="US/Central"),as.POSIXct("1994-10-15", tz="US/Central"), by="360 DSTdays")stopifnot(length(x) == 13, diff((as.numeric(x) - 39600)/86400) == 360)## length(x) was 1802 and ended in many NA's in R <= 3.4.2## print.POSIX[cl]t() - not correctly obeying "max.print" optionop <- options(max.print = 50, width = 85)cc <- capture.output(print(dt <- .POSIXct(154e7 + (0:200)*60)))c2 <- capture.output(print(dt, max = 6))writeLines(tail(cc, 4))writeLines(c2)stopifnot(exprs = {grepl("omitted 151 entries", tail(cc, 1))!anyDuplicated(tail(cc, 2))grepl("omitted 195 entries", tail(c2, 1))}); options(op)## the omission had been reported twice because of a typo in R <= 3.5.1## as.Date() from POSIXct and POSIXlt should retain names(ch <- setNames(paste0("1994-10-", 11:15), letters[1:5]))d1 <- as.Date(ch, tz = "UTC")ct <- as.POSIXct(ch)d2 <- as.Date(ct, tz = "UTC") # fast pathlt <- as.POSIXlt(ch, tz = "UTC")(d3 <- as.Date(lt))stopifnot(identical(names(ch), names(d1)),identical(names(ch), names(d2)),identical(names(ch), names(d3)))## in R <= 4.1.1, names got lost whenever as.Date.POSIXlt() was called## hist() of a single date or date-timedt <- as.POSIXlt("2021-10-13", "UTC")hist(dt, "secs", plot = FALSE)hist(as.Date(dt), "days", plot = FALSE)## failed in R <= 4.1.2 with Error in seq_len(1L + max(which(breaks < maxx)))## format.POSIX[cl]t() after print.POSIXct()dt <- "2012-12-12 12:12:12"x <- as.POSIXct(dt, tz = "GMT")stopifnot(identical(format(x), dt))op <- options(warn=1)# allow(Sys.t <- Sys.timezone()) # may occasionally warn (and work)options(op)someCET <- paste("Europe", c("Berlin", "Brussels", "Copenhagen", "Madrid","Paris", "Rome", "Vienna", "Zurich"), sep="/")if(Sys.t %in% someCET)stopifnot(identical(print(format(x, tz = "")), "2012-12-12 13:12:12"))## had failed for almost a month in R-devel & R-patched## as.Date(<nonfinite_POSIXlt>) :D <- .Date(c(7:20)*1000)D[15:18] <- c(Inf, -Inf, NA, NaN); Dstopifnot( identical(D, as.Date(as.POSIXlt(D))) )## non-finite POSIXlt gave all NA in R <= 4.2.1#### POSIX[cl]t: keeping names, also w/ factors; is.finite() ...(D <- setNames(D, LETTERS[seq_along(D)]))fD <- factor(D)stopifnot(exprs = {identical(fD, as.factor(D))identical(names(D), names(fD))## identical(D, as.Date(fD)) -- FIXMEidentical(D, as.Date(Dct <- as.POSIXct(D))) # also checks names(.) are keptidentical(D, as.Date(Dlt <- as.POSIXlt(D)))identical(as.character(D), as.character(Dlt))identical( format(D), format(Dlt) -> frmD)identical(names(D), names(frmD))(DeD <- Dlt == Dct)[ok <- is.finite(D)]identical(is.na(DeD), is.na(D))identical(as.character(D), unname(frmD))identical(unname(ok), is.finite(as.numeric(D)))identical(ok, is.finite(Dct))identical(ok, is.finite(Dlt)) # now works for POSIXltidentical(is.nan(D), is.nan(Dlt))identical(is.infinite(D), is.infinite(Dlt))identical(D == -Inf, Dlt == -Inf)})## is.finite() now works for POSIXlt## as.POSIX?t(<POSIX?t>, tz=*) now works, too:stopifnot(inherits(Dct, "POSIXct"),inherits(Dlt, "POSIXlt"))Sys.timezone() # "Australia/Melbourne" (set above)mtz <- "Etc/GMT-5" # was UTC-5head(Dct2 <- as.POSIXct(Dct, tz = mtz), 3)head(Dlt2 <- as.POSIXlt(Dlt, tz = mtz), 3) ## these three POSIXlt "are different"head(Dlct2 <- as.POSIXlt(Dct2), 3)head(Dlct <- as.POSIXlt(Dct) , 3)no_tz <- function(.) `attr<-`(., "tzone", NULL)stopifnot(exprs = {identical(mtz, attr(Dct2, "tzone"))identical(mtz, attr(Dlt2, "tzone"))(Dct2 - Dct)[ok] == 0identical(no_tz(Dct2), no_tz(Dct))identical(no_tz(Dlt2), no_tz(Dlt))## However (!!)(Dct2 - Dct)[ok] == 0## Have 2 groups" which are "equal": { Dlt "==" Dlct "==" Dlct2 } and Dlt2 which differs by 5(Dlt2 - Dlt )[ok] == -5L # !!!(Dlct2 - Dlt )[ok] == 0L(Dlct - Dlt )[ok] == 0L(Dlct - Dlt2)[ok] == 5L})## both methods return(x)ed immediately, when class "matched"op <- options(OutDec = ",") # the "infamous default" in some places should *not* have an effect:xf <- as.POSIXlt(chf <- c("2007-07-27 16:11:03.000002","2011-10-01 12:34:56.3","2022-10-02 13:14:15.9876543210123456"))dd <- setNames(, c(0:6, 11:15))t(sapply(dd, as.character.POSIXt, x = xf)) # get at most 13 dits after ".", becauseas.character(xf[3]$sec) # does get these but not more; hence:chf[3] <- sub("3456$", "3", chf[3])stopifnot(exprs = {identical(as.character(xf), chf)identical(as.character(xf, OutDec = ","), sub("[.]", ",", chf))identical(as.character(xf, digits = 5)[-3], sub("[.]00*2$","", chf[-3]))})## failed for ~ 1 day in R-devel(CharleMagne.crowned <- as.POSIXlt(ISOdate(774,7,10)))stopifnot(identical(as.character(CharleMagne.crowned),"774-07-10 12:00:00"))options(op) # reset## as.POSIX[cl]t(<Date>, tz = *)isUTC <- function(tz)switch(tz,"UTC" =, "GMT" = , "Etc/UTC" = , "Etc/GMT" = , "GMT0" = , "GMT+0" = , "GMT-0" = TRUE,FALSE)identical3 <- function(a,b,c) identical(a,b) && identical(b,c)datePOSIXchk <- function(d, tz) {stopifnot(inherits(d, "Date"), is.character(tz))UTC. <- isUTC(tz)## cat(sprintf("\ntz = '%s'%s, Date = '%s':\n ------------",## tz, if(UTC.)"(= UTC)" else "", paste(format(d), collapse=", ")))PCdate <- as.POSIXct(d, tz = tz); PLpc <- as.POSIXlt(PCdate); PLpcz <- as.POSIXlt(PCdate, tz = tz)PLdate <- as.POSIXlt(d, tz = tz); PCpl <- as.POSIXct(PLdate); PCplz <- as.POSIXct(PLdate, tz = tz)m <- rbind(PLdate = format(PLdate, usetz=TRUE), PCdate = format(PCdate, usetz=TRUE), PLpc = format(PLpc, usetz=TRUE), PLpcz = format(PLpcz, usetz=TRUE), PCpl = format(PCpl, usetz=TRUE), PCplz = format(PCplz, usetz=TRUE))colnames(m) <- rep("", ncol(m))print(m[c(1:2,5L), ]) # print() those three which are "typically" different##diffD <- PLdate - PCdatecat("PLdate - PCdate:", capture.output(diffD[1]), "\n")##if(length(delta <- unique(diffD)) != 1L) {cat(sprintf("# {unique diffD values} (typically 1), here %d:\n", length(delta)))attributes(delta) <- attributes(diffD) ## class, unitsprint(delta)}stopifnot(exprs = {PLpc == PCdatePLpc == PLpcz## Not identical3(PCdate, PLpc, PLpcz), but identically formatted:identical3(m["PCdate",], m["PLpc",], m["PLpcz",])##identical(PCpl, PCplz) # and typically *not* identical to PLdate, but still equal:PCpl == PLdate##PLdate - PLpc == diffDPLdate - PLpcz == diffDPCpl - PCdate == diffDPCplz - PCdate == diffD})if(UTC.) ## UTC-equivalent timezonestopifnot(exprs = {delta == 0## and the two groups (of 3 each) are equal, tooPLdate == PCdate})}##d1 <- as.Date(c("2000-02-29", "2001-04-01"))otz <- OlsonNames()## BST is a deliberate unknown: most platforms would use UTC, some warning## (see ?Sys.timezone).## EST5EDT is a legacy non-continent/ocean name## Europe/Dublin is unusual as it has 'winter time' not DST with## 'Irish Standard Time' being used in summer (at least in 2022)## Europe/Kyiv became a primary name in Aug 2022.## 'Time difference quoted here is from UTC aka GMT, in hours.for(tz in c("GMT", "EST5EDT", "BST", "Pacific/Auckland","Africa/Cairo", "Asia/Jerusalem ", "America/Jamaica","Africa/Conakry", "Asia/Calcutta", "Asia/Seoul", "Asia/Shanghai","Asia/Tokyo", "Canada/Newfoundland", "Europe/Dublin","Europe/Vienna", "Europe/Kyiv", "Europe/Moscow")) {cat("\n")if(!(tz %in% otz)) {cat(tz, "is not in this platform's OlsonNames()\n")next}cat("Using", sQuote(tz), "\n")datePOSIXchk(d1, tz)}## several of the identities datePOSIXchk() failed in R <= 4.2.x## unnecessarily passing 'origin'ct <- as.POSIXct(.Date(19000), origin="1970-01-01")stopifnot(identical(as.Date(ct), .Date(19000)))## as.POSIXct.Date() passed on 'origin' raising an error for ~25 hours## as.POSIXct.default() dealing with an *extraneous* origin = ".."(D <- .Date(19000))## NB: The following depends on the timezone, see Sys.timezone() abovecE <- as.POSIXct(D, tz="EST")lE <- as.POSIXlt(D, tz="EST")ct <- as.POSIXct(cE)ct50 <- as.POSIXct(cE, origin="1950-1-1", tz = "NZ") ## <-- failed for 1.5 dayslt50 <- as.POSIXlt(lE, origin="1950-1-1", tz = "NZ") ## (ditto)stopifnot(exprs = {identical(ct, structure(1641600000, class = c("POSIXct", "POSIXt"), tzone = "EST")) # no tzone in R <= 4.2.xidentical(ct, cE)identical(ct50, `attr<-`(ct, "tzone", "NZ")) # ct50 had no "tzone" in R <= 4.2.xidentical(lt50, `attr<-`(lE, "tzone", "NZ")) # lt50 had tzone = "UTC" in R <= 4.2.xidentical(as.character(lE), "2022-01-08")})## worked (but partly differently!) in R <= 4.2.x## as.POSIXct(<numeric>) & as.POSIXlt(*) :for(nr in list(1234, -1:1, -1000, NA, c(NaN, 1, -Inf, Inf),-2^(20:33), 2^(20:33)))for(tz in c("", "GMT", "NZ", "Pacific/Fiji")) {cat("testing in", sQuote(tz),"\n")n <- as.numeric(nr)stopifnot(identical(n, as.numeric(print(as.POSIXct(nr, tz=tz)))),identical(n, as.numeric( as.POSIXlt(nr, tz=tz))))}## did not work without specifying 'origin' in R <= 4.2.x## small options("scipen") producing exponential formatcdt <- "2007-07-27 16:11:00.000000000000006"; (dt <- as.POSIXlt(cdt))op <- options(scipen = 0, OutDec = ",")cbind(ccdt <- c(as.character(dt), as.character(dt, digits=15)))stopifnot(grepl(":00\\.0{13}", ccdt), getOption("OutDec") == ",")cdt == ccdt[2] # TRUE on all platforms?options(op)# reset## accidentally used exponential format (and changed OutDec opt) for a while## as.Date(.) now also takes default origin 1970-1-1:stopifnot(exprs = {identical(D1 <- as.Date(20000), as.Date(20000, origin = "1970-01-01"))inherits(D1, "Date")identical(as.character(D1), "2024-10-04")inherits(D2 <- as.Date(20000, origin="1960-1-1"), "Date")D2 + 3653 == D1identical(c(D2,D1), seq(D2, length.out=2, by = "10 years"))})## 'origin' was not optional in R <= 4.2.x## length(<ragged POSIXlt>)## Ex. of "partially filled" with NA's, *not* evenly recycling, out-of-range, fractional sec## However, isdst is not known and depends on the time zone.## Using -1L says so: 1L failed in time zones without DST on glibc.## NB: this has only 9 elementsdlt <- .POSIXlt(list(sec = c(-999, 10000 + c(1:10,-Inf, NA)) + pi,min = 45L, hour = c(21L, 3L, NA, 4L),mday = 6L, mon = c(0:11, NA, 1:2),year = 116L, wday = 2L, yday = 340L, isdst = -1L))f1 <- format(dlt[1], "%Y-%m-%d %H:%M:%OS3") # PR#18448stopifnot(f1 == "2016-01-06 21:28:24.141") # gave "... 21:28:-995.858" in R <= 4.2.2dct <- as.POSIXct(dlt)dltN <- as.POSIXlt(dct) # "normalized POSIXlt" (with *lost* accuracy), but *added* tz-info:data.frame(unclass(dltN)); str(attributes(dltN)[-1], no.list=TRUE)dltv2 <- local({ x <- dltNlength(x$min ) <- 4; length(x$hour) <- 4; length(x$mday ) <- 2length(x$mon ) <- 9; length(x$year) <- 5; length(x$isdst) <- 1length(x$yday) <- 1; length(x$wday) <- 1; length(x$ zone) <- 1; length(x$gmtoff) <- 1x })dltm3 <- dlt; dltm3$mon <- c(11L, NA, 3L)dltI <- dltm3; dltI$sec <- c(-Inf, 0:2, NaN, NA, Inf)c((n <- length(dlt)), (n2 <- length(dltv2)), (n3 <- length(dltm3)))stopifnot(n == 15L, n2 == 15L, n3 == 13L)## always returned length(*$sec) in R <= 4.2.x## smallest possible lt which shows format.POSIXlt() bug :lt. <- local({ l <- 1L.POSIXlt(list(sec = -Inf, min = l, hour = l, mday = l,mon = l, year = l, wday = l, yday = l, isdst = l))})stopifnot(format(lt.) == "-Inf")# was NA, which is wrong after allowing non-finiteltI <- .POSIXlt(list(sec = c(-Inf, 0, NaN, NA, Inf), min = 45L, hour = 21L, mday = 6L,mon = 0:11, year = 116L, wday = 2L, yday = 340L, isdst = 1L))ctI <- as.POSIXct(ltI) # typically differs fromctIu <- as.POSIXct(ltI, "UTC")stopifnot(identical3(format(ctIu), format(as.POSIXlt(ctIu)), format(balancePOSIXlt(ltI))))#### More dealing with such ragged out-of-range POSIXlt:## (with console output, if only to compare platform dependencies)dctm3 <- as.POSIXct(dltm3)dltNm3 <- as.POSIXlt(dctm3)data.frame(unclass(dltN))##' For a POSIXlt, check if it is "ragged"is.raggedPOSIXlt <- function(x) { stopifnot(inherits(x,"POSIXlt"))n <- lengths(unclass(x)); any(n[[1]] != n) }##' create "normalized" POSIXlt *not* losing fractional seconds accuracy.POSIXltNormalize <- function(x, tz="UTC") { ## for some tz="UTC" is needed, for others tz=""stopifnot(is.numeric(s <- x$sec))tzA <- attr(x, "tzone")n <- length(ct <- as.POSIXct(x, tz=tz))x <- as.POSIXlt(ct) # and restore "tzone" attrib. & the precise seconds (recycling carefully!)ifin <- is.finite(s <- rep_len(s, n)) & is.finite(x$sec)x$sec[ifin] <- s[ifin] %% 60if(!is.null(tzA)) attr(x, "tzone") <- tzAx}dlt2N <- .POSIXltNormalize(dlt, tz="") # normalized POSIXlt - with accuracy keptdlt2Nu <- .POSIXltNormalize(dlt) # (ditto; in "UTC")dlt2Nm3 <- .POSIXltNormalize(dltm3, tz="")all.equal(dlt2N $sec, dltN $sec, tolerance = 0) # .. small (2e-9) differenceall.equal(dlt2Nm3$sec, dltNm3$sec, tolerance = 0) # .. (ditto, slightly different)## new balancePOSIXlt() :## Should be identity when a POSIXlt is already balanced:(lt1 <- as.POSIXlt(ch <- "2001-02-03 04:05")) # "... AEDT" (Southern Summer)stopifnot(identical(lt1, balancePOSIXlt(lt1)))## failed initially## The hard cases from above:dltB <- balancePOSIXlt(dlt)dltv2B <- balancePOSIXlt(dltv2)dltBm3 <- balancePOSIXlt(dltm3)dltL <- unclass(dltB)data.frame(dltL)stopifnot(exprs = {is.list(dltL)lengths(dltL) == nidentical(dltL, balancePOSIXlt(dlt, class=FALSE))is.raggedPOSIXlt(dlt)is.raggedPOSIXlt(dltv2)is.raggedPOSIXlt(dltm3)!is.raggedPOSIXlt(dltN)!is.raggedPOSIXlt(dlt2N)!is.raggedPOSIXlt(dlt2Nm3)!is.raggedPOSIXlt(dltB)!is.raggedPOSIXlt(dltv2B)!is.raggedPOSIXlt(dltBm3)## equal with default tolerance:all.equal(dlt2N, dltN)all.equal(dlt2Nm3, dltNm3)identical(as.POSIXct(dlt2N), as.POSIXct(dltN))identical(as.POSIXct(dlt2Nm3), as.POSIXct(dltNm3))})## First show (in a way it also works for older R), then check :oldR <- getRversion() < "4.2.2"(dd <- data.frame(dlt, dltN, asCT = dct, na = is.na(dlt),fin = if(oldR) rep_len(NA, n3) else is.finite(dlt)))## Look at *all* current "POSIXlt" objects:str(lts <- local({ oG <- as.list(.GlobalEnv)oG[vapply(oG, inherits, TRUE, "POSIXlt")] }))## Check if/when balancePOSIXlt(.) is the identity for "POSIXlt" objectsblts <- lapply(lts, balancePOSIXlt)all.equal(blts, lts) # on Lnx Fedora 36 "ltI", "dlt", "dltI" and "dltm3" have been shifted by one hour - ok (??)## all the others are *deemed* equal by the "tolerant" all.equal.POSIXt()(nmsLT <- setdiff(names(lts), c("ltI", "dlt", "dltI", "dltm3")))at.b <- lapply(blts, attributes)(cNms <- setdiff(names(at.b[[1]]), "balanced"))stopifnot(exprs = {all.equal(lts[nmsLT], blts[nmsLT], tolerance = 0)## now blts are all balanced of course; lts only partlyvapply(at.b, `[[`, TRUE, "balanced")identical(lapply(lapply( lts, attributes), `[`, cNms),lapply(at.b, `[`, cNms))})chlts <- lapply( lts, as.character)cblts <- lapply(blts, as.character)stopifnot(identical(chlts, cblts))## only now that as.char..() uses balanceP..()## Indexing --which(ina <- is.na(dlt))stopifnot(exprs = {all.equal(format(ltI[-1]), format(ltI)[-1]) # ltI[-1] gave an errorall.equal(format(ltI[-2]), format(ltI)[-2])identical(which(ina), c(3L, 7L, 11L, 13L, 15L))!anyNA(dlt[!ina])format(dlt[!ina]) == format(dlt)[!ina] # dlt[!ina] was mostly NA!anyNA(dltm3[!is.na(dltm3)])identical(as.POSIXct(dlt[-3], "UTC"),as.POSIXct(dlt, "UTC")[-3])})## subassigning [<- :tmp <- dlttmp[1] <- tmp[15]stopifnot(exprs = {identical(print(format(tmp)), # had badly failedformat(dlt)[c(15, 2:15)])identical(tmp[1], dlt[15])identical(tmp[-1], dlt[-1])})## badly failed in ragged case, before balancePOSIXlt() was used#### After fixes in as.Date.POSIXlt (and also as.Date.POSIXt) methodsdD <- as.Date(dlt)dDc <- as.Date(dct)dd2 <- data.frame(lt = dltN, ct = dct, dD, dDc, d.D = (dD - dDc), d.POSIX = (dlt - dct))print(width = 101, dd2) ## look at [9,] -- do the date parts correspond ?dDm3 <- as.Date(dltm3)dDcm3 <- as.Date(dctm3)nD <- unclass(dD)nDc <- unclass(dDc)cbind(nD, nDc, diff = nD-nDc)ifi <- is.finite(dct)ifi3 <- is.finite(dctm3)stopifnot(exprs = {all.equal(dD, dDc, tolerance = 1e-4)(dDm3 - dDcm3)[ifi3] %in% 0:1(dD - dDc )[ifi] %in% 0:1(nD - nDc )[ifi] %in% 0:1is.na((dD - dDc )[!ifi])is.na((dDm3 - dDcm3)[!ifi3])})## as.Date.POSIXlt() failed badly for such ragged cases in R <= 4.2.x## ragged, including names(nlt <- c(P = as.POSIXlt("2000-1-2 3:45")))r3n <- rep(nlt, 3)lt2 <- nlt; lt2$min <- 45:49; lt2 # (names print wrongly)names(lt2) # "P" is maybe ok(b2 <- balancePOSIXlt(lt2))# now correctt3 <- lt2; t3$year <- c(P = 100L, Q = 101L)t3 # "works", not printing recycled names (FIXME?)as.POSIXct(t3) # ditto FIXME(b3 <- balancePOSIXlt(t3))t4 <- lt2; names(t4) <- n4 <- c("P", "Q", "", "S", "T"); t4t5 <- lt2; names(t5) <- n4[-5] ; t5 # works; last name is <NA>bare <- function(x) ## drop all attributes but names:`attributes<-`(x, if(!is.null(n <- names(unclass(x)))) list(names=n))stopifnot(exprs = {identical("P", names(nlt))identical(nlt, balancePOSIXlt(nlt))length(r3n) == 3identical(nlt, r3n[3])identical(names(r3n), rep("P", 3))length(lt2) == 5identical(names(b2), rep("P", 5))identical(bare(b2), bare(balancePOSIXlt(lt2, fill.only = TRUE)))# (here)identical(names(b3), rep_len(c("P","Q"), length(b3)))identical(n4, names(t4))identical(n4, names(balancePOSIXlt(t4, fill.only = TRUE)))identical(nn <- c(n4[-5], NA), names(t5))identical(nn, names(b5 <- balancePOSIXlt(t5)))identical(bare(b5), bare(balancePOSIXlt(t5, fill.only = TRUE))) # (here)})## names(.) were not recycled correctly in original balanceP..()## moves from strptime.Rdstopifnot(identical("Inf", format(.POSIXct(Inf)))) # (was NA in R <= 4.1.x)notF <- c(-Inf,Inf,NaN,NA)(fF <- format(tnF <- .POSIXct(notF))) # was all NA, now the last is still NA (not "NA")stopifnot(identical(as.character(notF[-4]), fF[-4])) # [4] may change!#### balancePOSIXlt() *not* fixing {zone, isdst, gmtoff}cht <- "2022-10-20 15:09"sec <- (0:18)*47^3(lt. <- local({ t <- as.POSIXlt(cht ); t$sec <- sec; t }))(lte <- local({ t <- as.POSIXlt(cht, tz="" ); t$sec <- sec; t }))(ltU <- local({ t <- as.POSIXlt(cht, tz="UTC"); t$sec <- sec; t }))(ct.. <- as.POSIXct(lt. )) # good, localtime, switch CEST -> CET(ct.e <- as.POSIXct(lt., tz="" ))(ct.U <- as.POSIXct(lt., tz="UCT")) # *very* bad: all NA but [14] ( = "1969-12-31 .." )(cte. <- as.POSIXct(lte ))(ctee <- as.POSIXct(lte, tz="" ))(cteU <- as.POSIXct(lte, tz="UCT")) # *very* bad: all NA but [14] ( = "1969-12-31 .." )(ctU. <- as.POSIXct(ltU )) # good, all UTC(ctUe <- as.POSIXct(ltU, tz="" )) #"good", localtime, if not-int, shifted by 1 hour(ctUU <- as.POSIXct(ltU, tz="UCT")) # "good", all UTC, but shifted by 1-2 hours (int <-> non-int)table(dUe <- ctUe - ct..) # all 0 for int-tzone, all 1 otherwise !!table(dUU <- ctUU - ct..) # all 11 x '1' and 8 x '2' for int-tzone, all '2' otherwise !stopifnot(exprs = {all.equal(ct.e, ct.., check.tzone=FALSE)identical(cte., ct..)all.equal(ctee, ct.., check.tzone=FALSE)})(b1 <- balancePOSIXlt(lt., fill.only=TRUE))(b2 <- balancePOSIXlt(lt.))stopifnot(b1 == b2)## range(<Date>|<POSIXt>, finite = TRUE) [R-devel mails, Davis Vaughan and MM, April 28, 2023ff]d <- .Date(c(10, Inf, 11, 12, Inf))(dN <- c(d, .Date(c(NA, NaN))))## Just the numbers :str(x <- unclass(d))str(xN <- unclass(dN), vec.len=9)stopifnot(exprs = {identical3(print(range(d)), .Date(range(unclass(d))),# "1970-01-11" "Inf"c(min(d),max(d)))is.na(range(dN))identical3(range(d, finite = TRUE), .Date(range(x, finite=TRUE)),range(dN,finite = TRUE) -> rd)identical(rd, structure(c(10, 12), class = "Date"))})## POSIXct/lt -----ct <- as.POSIXct(d)ctN<- as.POSIXct(dN)lt <- as.POSIXlt(ct)ltN<- as.POSIXlt(ctN)str(y <- unclass(ct))str(yN <- unclass(ctN), vec.len=9)stopifnot(exprs = {identical(print(range(ct)), .POSIXct(range(unclass(ct)), tz="UTC"))identical3(range(ct, finite = TRUE), .POSIXct(range(y, finite=TRUE), tz="UTC"),range(ctN,finite = TRUE) -> rct)is.na(range(ctN))identical(range(ctN, na.rm=TRUE), range(ct))identical(rct, structure(c(10, 12) * 24*60*60,class = c("POSIXct", "POSIXt"), tzone = "UTC"))## POSIXltidentical3(print(range(lt)), as.POSIXlt(range(ct)), # "1970-01-11" "Inf"c(min(lt), max(lt))) # failed for a few daysidentical3(range(lt, finite = TRUE), as.POSIXlt(rct),range(ltN,finite = TRUE))is.na(range(ltN))identical(range(ltN, na.rm=TRUE), range(lt))})## Losing 1 sec in ct -> lt conversion for tzcode=internal (USE_INTERNAL_MKTIME) -- PR#16856ct <- .POSIXct(c(-1.25, -1, 0, 1), tz = "UTC")(d1 <- (lt <- as.POSIXlt(ct)) - ct)(d2 <- as.POSIXlt(as.POSIXct(lt)) - ct)stopifnot(d1 == 0, d2 == 0)## where (1 0 0 0) and (2 0 0 0) {w/ "internal" tz src} in R <= 4.3.1## [[ method uses underlying class names as a backup(pl <- as.POSIXlt(as.POSIXct("2024-04-25 12:34:56") + c(a = 0, mday = 10)))assertErrV(pl[["b"]])stopifnot(exprs = {identical(pl[["a"]], pl[[1L]]) # both as previouslyidentical(pl[["mday"]], pl[[2L]])identical(pl[,"mday"], rep(25L, 2))identical(pl[,"yday"], rep(115L, 2))grepl('x[, "yday"]', print(tryCmsg(pl[["yday"]])))# new error msg})## keep at endrbind(last = proc.time() - .pt,total = proc.time())