proper summary(<difftime>), printing by new format(*, with.units=FALSE); unique(); diff(); also fixing PR#18844

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

Author: maechler

doc/NEWS.Rd

@@ -182,6 +182,12 @@
       rounding.  The current default \code{zdigits = 4L} is somewhat
       experimental.  Specifying both \code{digits = *, zdigits = *} allows
       behaviour independent of the global \code{digits} option.
+
+      \item The \code{format()} method for \code{"difftime"} objects gets a
+      new back compatible option \code{with.units}.
+
+      \item A \code{summary()} method for \code{"difftime"} objects which
+      prints nicely, similar to those for \code{"Date"} and \code{"POSIXct"}.
     }
   }
 
@@ -192,7 +198,7 @@
       flag \option{--with-C23}.
 
       It is intended that this will become the default before release.
-      
+
       \item The minimum \command{autoconf} requirement for a maintainer
       build has been increased to \command{autoconf}\sspace{}2.72.
 
@@ -356,7 +362,7 @@
       \code{Rf_*()} as has been documented in
       \sQuote{Writing R Extensions} for a while, fixing \PR{18800}
       thanks to \I{Mikael Jagan} and \I{Suharto Anggono}.
-      
+
       \item \code{R_GetCurrentSrcref(skip)} now skips calls rather
       than \code{srcref}s, consistent with counting items in the
       \code{traceback()} display.  If \code{skip == NA_INTEGER},
@@ -519,13 +525,13 @@
       \item \code{summary(<stl>)} (which prints directly) finally gets the
       same \code{digits} default as the formatting printing of default
       \code{summary()} method results, and it is documented explicitly.
-      
+
       \item \code{options(show.error.locations = TRUE)} once
       again shows the most recent known location when an 
       error is reported.  Setting its value to \code{"bottom"} 
       is no longer supported.  Numerical values are converted
       to logical.
-      
+
       \item C API function \code{R_GetCurrentSrcref(skip)} now
       returns \code{srcref} entries correctly.  (Note that there
       is also a change to the interpretation of \code{skip}; 

src/library/base/R/datetime.R

@@ -465,7 +465,7 @@ summary.POSIXct <- function(object, digits = 15L, ...)
     }
     .POSIXct(x,
              tz = attr(object, "tzone"),
-             cl = c("summaryDefault", "table", oldClass(object)))
+             cl = c("summaryDefault", oldClass(object)))
 }
 
 summary.POSIXlt <- function(object, digits = 15, ...)
@@ -769,10 +769,10 @@ as.double.difftime <- function(x, units = "auto", ...)
 
 as.data.frame.difftime <- as.data.frame.vector
 
-format.difftime <- function(x,...)
+format.difftime <- function(x,..., with.units = TRUE)
 {
     y <- if(length(x))
-        paste(format(unclass(x),...), units(x))
+        paste0(format(unclass(x),...), if(with.units) paste0(" ",units(x)))
     else
         character()
     names(y) <- names(x)
@@ -786,7 +786,7 @@ print.difftime <- function(x, digits = getOption("digits"), ...)
     else if(is.array(x) || length(x) > 1L) {
         cat("Time differences in ", attr(x, "units"), "\n", sep = "")
         y <- unclass(x); attr(y, "units") <- NULL
-    print(y, digits=digits, ...)
+        print(y, digits=digits, ...)
     }
     else
         cat("Time difference of ", format(unclass(x), digits = digits), " ",
@@ -952,8 +952,9 @@ function(object, digits = getOption("digits"), ...)
         x <- x[-m]
         attr(x, "NAs") <- NAs
     }
-    .difftime(x, attr(object, "units"), oldClass(object))
-}    
+    .difftime(x, attr(object, "units"),
+              c("summaryDefault", oldClass(object)))
+}
 
 ## ----- convenience functions -----
 

src/library/base/R/summary.R

@@ -76,10 +76,9 @@ format.summaryDefault <- function(x, digits = max(3L, getOption("digits") - 3L),
     }
     class(xx) <- class(x)[-1]
     m <- match("NA's", names(x), 0)
-    if(inherits(x, "Date") || inherits(x, "POSIXct")) {
-        if(length(a <- attr(x, "NAs")))
-            c(format(xx, digits=digits, ...), "NA's" = as.character(a))
-        else  format(xx, digits=digits)
+    if((iD <- inherits(x, "Date")) | (iP <- inherits(x, "POSIXct")) || inherits(x, "difftime")) {
+        c(format(xx, digits = if(iP) 0L else digits),
+          "NA's" = if(length(a <- attr(x, "NAs"))) as.character(a))
     } else if(m && !is.character(x))
         c(format(xx[-m], digits=digits, ...), "NA's" = as.character(xx[m]))
     else  format(xx,     digits=digits, ...)
@@ -93,14 +92,20 @@ print.summaryDefault <- function(x, digits = max(3L, getOption("digits") - 3L),
       xx[finite] <- zapsmall(x[finite], digits = digits + zdigits)
     }
     class(xx) <- class(x)[-1] # for format
-    m <- match("NA's", names(xx), 0)
-    if(inherits(x, "Date") || inherits(x, "POSIXct")) {
-        xx <- if(length(a <- attr(x, "NAs")))
-            c(format(xx, digits=digits), "NA's" = as.character(a))
-        else  format(xx, digits=digits)
-        print(xx, digits=digits, ...)
+    if((iD <- inherits(x, "Date")) | (iP <- inherits(x, "POSIXct")) || inherits(x, "difftime")) {
+        no.q <- is.na(match("quote", ...names())) # no 'quote = *' in  `...`
+        if(no.q) quote <- TRUE
+        if(iP)
+            digits <- 0L
+        else if(!iD) { # have difftime
+            cat("Time differences in ", attr(x, "units"), "\n", sep = "")
+            if(no.q) quote <- FALSE
+        }
+        xx <- c(format(xx, digits = digits, with.units = FALSE),
+                "NA's" = if(length(a <- attr(x, "NAs"))) as.character(a))
+        print(xx, quote = quote, ...)
         return(invisible(x))
-    } else if(m && !is.character(x))
+    } else if((m <- match("NA's", names(xx), 0L)) && !is.character(x))
         xx <- c(format(xx[-m], digits=digits), "NA's" = as.character(xx[m]))
     print.table(xx, digits=digits, ...)
     invisible(x)

src/library/base/man/difftime.Rd

@@ -1,6 +1,6 @@
 % File src/library/base/man/difftime.Rd
 % Part of the R package, https://www.R-project.org
-% Copyright 1995-2024 R Core Team
+% Copyright 1995-2025 R Core Team
 % Distributed under GPL 2 or later
 
 \name{difftime}
@@ -41,7 +41,7 @@ difftime(time1, time2, tz,
 
 as.difftime(tim, format = "\%X", units = "auto", tz = "UTC")
 
-\method{format}{difftime}(x, ...)
+\method{format}{difftime}(x, ..., with.units = TRUE)
 \method{units}{difftime}(x)
 \method{units}{difftime}(x) <- value
 \method{as.double}{difftime}(x, units = "auto", ...)
@@ -63,6 +63,9 @@ as.difftime(tim, format = "\%X", units = "auto", tz = "UTC")
     \code{\link{strptime}}.  The default is a locale-specific time format.}
   \item{x}{an object inheriting from class \code{"difftime"}.}
   \item{\dots}{arguments to be passed to or from other methods.}
+  \item{with.units}{(for the  \code{format()} method:) logical indicating
+    the units should be part, e.g., "3.5 hours"; if false, the units are
+    suppressed.}
 }
 \details{
   Function \code{difftime} calculates a difference of two date/time

tests/reg-tests-1e.R

@@ -1782,6 +1782,24 @@ stopifnot(is.table(sdf), is.matrix(sdf), identical(dim(sdf), c(6L, 2L)))
 ## failed for a few days only
 
 
+## summary(<difftime>) and its print()ing
+xt <- .POSIXct(1737745992 + 2/7 + 10000 * (0:7))
+(dt <- diff(xt)) # |--> diff.POSIXt()  -- perfect
+(sdt <- summary(dt))
+stopifnot(exprs = {
+    inherits(dt,  "difftime")
+    inherits(sdt, "difftime")
+    inherits(diff(sdt), "difftime")
+             diff(sdt) == 0
+    inherits(sdt, "summaryDefault")
+    identical(capture.output(sdt), c(
+       "Time differences in hours",
+       "   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. ",
+       strrep('  2.778 ', 6)))
+})
+## summary(<difftime>) was not useful in R < 4.5.0
+
+
 
 ## keep at end
 rbind(last =  proc.time() - .pt,