fix format.POSIXlt() for fractional secs

git-svn-id: https://svn.r-project.org/R/trunk@87354 00db46b3-68df-0310-9c12-caf00c1e9a41

Author: maechler

doc/NEWS.Rd

@@ -368,6 +368,12 @@
       \item \code{debugonce(<S4-simple-body>, signature=*)} now works
       correctly when \dQuote{called twice}, fixing \PR{18824} thanks to
       \I{Michael Jagan}.
+
+      \item \code{format(dtime, digits=* / format=*)} is more consistent
+      when the \code{POSIXt} date-time object \code{dtime} has fractional
+      (non integer) seconds.  Fixes \PR{17350}, thanks to new contributions
+      by \I{LatinR}'s \sQuote{\I{R Dev Day}} participants, \I{Heather
+      Turner} and \I{Dirk Eddelbuettel}.
     }
   }
 }

src/library/base/R/datetime.R

@@ -382,18 +382,20 @@ format.POSIXlt <- function(x, format = "", usetz = FALSE,
                            digits = getOption("digits.secs"), ...)
 {
     if(!inherits(x, "POSIXlt")) stop("wrong class")
-    if(any(f0 <- format == "")) {
-        ## need list [ method here.
-    times <- unlist(unclass(x)[1L:3L])[f0]
-    secs <- x$sec[f0]; secs <- secs[is.finite(secs)]
-        np <- if(is.null(digits)) 0L else min(6L, digits)
-        if(np >= 1L) # no unnecessary trailing '0' :
-            for (i in seq_len(np)- 1L)
-                if(all( abs(secs - round(secs, i)) < 1e-6 )) {
+    if(any(f0 <- format == "" | grepl("%OS$", format))) {
+        if(!is.null(digits)) {
+            secs <- x$sec[f0]; secs <- secs[is.finite(secs)]
+            np <- min(6L, digits)
+            ## no unnecessary trailing '0' ; use trunc() as .Internal() code:
+            for(i in seq_len(np)- 1L)
+                if(all( abs(secs - trunc(secs*(ti <- 10^i))/ti) < 1e-6 )) {
                     np <- i
                     break
                 }
-    format[f0] <-
+        } else np <- 0L
+        ## need list `[` method here to get 1:3 ~ {sec, min, hour}:
+        times <- unlist(`names<-`(unclass(x)[1L:3L], NULL))[f0]
+       format[f0] <-
         if(all(times[is.finite(times)] == 0)) "%Y-%m-%d"
         else if(np == 0L) "%Y-%m-%d %H:%M:%S"
         else paste0("%Y-%m-%d %H:%M:%OS", np)

src/library/base/man/strptime.Rd

@@ -39,9 +39,11 @@ strptime(x, format, tz = "")
     methods is
     \code{"\%Y-\%m-\%d \%H:\%M:\%S"} if any element has a time
     component which is not midnight, and \code{"\%Y-\%m-\%d"}
-    otherwise.  If \code{digits} is not \code{NULL}, i.e., by default when
-    \code{\link{options}("digits.secs")} is set, up to
-    the specified number of digits will be printed for seconds.}
+    otherwise.  In the first case and if \code{digits} is not \code{NULL},
+    i.e., by default when \code{\link{options}("digits.secs")} is set, up to
+    the specified number of digits will be printed for seconds, using
+    \code{"\%OS<n>"} instead of \code{"\%S"} in the format, see also
+    \sQuote{Details}.}
   \item{\dots}{further arguments to be passed from or to other methods.}
   \item{usetz}{logical.  Should the time zone abbreviation be appended
     to the output?  This is used in printing times, and more reliable
@@ -237,7 +239,9 @@ strptime(x, format, tz = "")
   Specific to \R is \code{\%OSn}, which for output gives the seconds
   truncated to \code{0 <= n <= 6} decimal places (and if \code{\%OS} is
   not followed by a digit, it uses \code{digits} unless that is
-  \code{NULL}, when \code{n = 0}).  Further, for \code{strptime}
+  \code{NULL}, when \code{n = 0}).  Note that the precedence is
+  \code{format="...\%OSn"} \eqn{\ll}{>>} \code{digits = n} \eqn{\ll}{>>}
+  \code{getOption("digits.prec")}.  Further, for \code{strptime}
   \code{\%OS} will input seconds including fractional seconds.  Note that
   \code{\%S} does not read fractional parts on output.
 
@@ -424,14 +428,17 @@ z2 <- strptime(x, "\%m/\%d/\%y \%H:\%M:\%S")
 ## *here* (but not in general), the same as format():
 stopifnot(identical(format(z2), as.character(z2)))
 
-## time with fractional seconds
-z3 <- strptime("20/2/06 11:16:16.683", "\%d/\%m/\%y \%H:\%M:\%OS") \donttest{
+## time with fractional seconds (setting `tz = ..` for reproducible output)
+z3 <- strptime("20/2/06 11:16:16.683", "\%d/\%m/\%y \%H:\%M:\%OS", tz = "UTC")
 z3 # prints without fractional seconds by default, digits.sec = NULL ("= 0")
-print(z3, digits = 3) # shows extra digits}
-op <- options(digits.secs = 3)
-\donttest{z3 # shows the 3 extra digits}
-as.character(z3) # ditto
+format(z3, digits = 3) # shows extra digits
+format(z3, digits = 6) # still 3 digits: *not* showing trailing zeros
+format(z3, format = "\%Y-\%m-\%d \%H:\%M:\%OS6") #  *does* keep trailing zeros
+op <- options(digits.secs = 3) # global option, the default for `digits`
+z3 # shows the 3 extra digits
 options(op)
+as.character(z3) # ditto
+
 
 ## time zone names are not portable, but 'EST5EDT' comes pretty close.
 ## (but its interpretation may not be universal: see ?timezones)

tests/datetime5.R

@@ -28,3 +28,40 @@ for (f in c("P", "k", "l", "s")) {
 dt2 <- as.POSIXlt(sprintf("%d-01-01 09:03;04", 2015:2018))
 cat(format(dt2, "%Y: %U %V %W"), sep = "\n")
 
+
+## fractional seconds print(<POSIXct>) --> format.POSIXlt() -- PR#17350 (and rdev day #83)
+## Original PR#17350 example (Vitalie Spinu):
+op <- options(digits.secs = 6, scipen = 20, digits = 15)
+## what we'd desire for print()ing etc:
+chx <- paste0("2009-08-03 12:01:59", c("", paste0(".",1:3)))
+print(chx, width = 40)
+xl <- as.POSIXlt(chx)
+stopifnot(identical(xl$sec, 59 + 0:3/10)) # POSIXlt keeping full precision (always did)
+## (but all arithmetic with POSIX*t currently happens via POSIXct, losing precision)
+fxl <- format(xl) # is perfect {with getOption("digits.secs") > 0  !}
+stopifnot(identical(sub(".*:59", '', fxl), paste0(".", 0:3)))
+x <- as.POSIXct("2009-08-03 12:01:59") + 0:3/10 # using POSIXct looses prec
+x. <- structure(x, tzone = "") ## == Vitalie's explicit original ex.
+identical(x, x.) # FALSE :  x. contains `tzone = ""`
+print(x, width = 40) # now .000000 .099999 2.00000 2.999999 (as digits.secs = 6 !)
+fx <- format(x)
+stopifnot(identical(fx, format(x.))) # *are* the same (for a while now)
+## The %OS and  %OS<d> formats have been fine "always":
+fD.OS <- function(d) format(x, format = paste0("%Y-%m-%d %H:%M:%OS", if(d=="_") "" else d))
+f.OSss <- vapply(c("_",0:6), fD.OS, character(length(x)))
+t(f.OSss) |> print(width=111, quote=FALSE) # shows  'trunc()'  instead of  'round()'
+stopifnot(identical(f.OSss[,"_"], f.OSss[,"6"])) # by option digits.secs 
+(secDig <- sub(".*:59", '', f.OSss)) ## [,"1"] is  *.0 *.0 *.2 *.2 - "bad" from using trunc() by design
+##      ___________   ___            __          __  "factory fresh" default
+options(digits.secs = NULL, scipen = 0, digits = 7)
+f.OSssD <- vapply(c("_",0:6), fD.OS, character(length(x))) # same call but different "digits.secs" option
+## digits = <d> now works "the same":
+fdig <- vapply(c("_",0:6), \(d) format(x, digits = if(d != "_") d), character(length(x)))
+stopifnot(exprs = {
+    nchar(t(secDig)) == c(7L, 0L, 2:7)     # as always
+    identical(f.OSssD[, 1], f.OSssD[,"0"]) # "" <--> "0"
+    identical(f.OSss [,-1], f.OSssD[, -1]) # only meaning of `empty' "%OS" changes with "digits.secs" option
+    identical(fdig, f.OSssD)
+})
+options(op)
+## Number of digits used differed in several cases in R <= 4.4.z