seq.Date() no longer coerces to double unnecessarily

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

Author: maechler

doc/NEWS.Rd

@@ -292,7 +292,7 @@
       \item \code{update_pkg_po()} now copies \file{.mo} files to the
       \pkg{translation} package even if a \file{DESCRIPTION} file
       exists, thanks to \I{Michael Chirico} fixing \PR{18694}.
-      
+
       \item Auto-generated \code{citation()} entries no longer include
       (additional) URLs in the \samp{note} field (\PR{18547}).
 
@@ -343,6 +343,11 @@
       \item \code{rowSums(A, dims = dd)}, \code{colMeans(..)}, etc, give a
       more helpful error message when \code{dd} is not of length one,
       thanks to \I{Michael Chirico}'s \PR{18811}.
+
+      \item \code{seq.Date()} no longer explicitly coerces results from
+      integer to double, analogously with \code{seq.default()},
+      \code{seq.int()} and \code{seq.POSIXt()}, resolving a \emph{modified}
+      \PR{18782}.
     }
   }
 }

src/library/base/R/dates.R

@@ -255,22 +255,21 @@ seq.Date <- function(from, to, by, length.out = NULL, along.with = NULL, ...)
         if (length(length.out) != 1L) stop("'length.out' must be of length 1")
         length.out <- ceiling(length.out)
     }
+    if (!missing(to) && missing(by)) {
+        from <- as.integer(as.Date(from))
+        to   <- as.integer(as.Date(to))
+        res <- seq.int(from, to, length.out = length.out)
+        return(.Date(res))
+    }
+    ## else
     status <- c(!missing(to), !missing(by), !is.null(length.out))
     if(sum(status) != 2L)
         stop("exactly two of 'to', 'by' and 'length.out' / 'along.with' must be specified")
-    if (missing(by)) {
-        from <- unclass(as.Date(from))
-        to <- unclass(as.Date(to))
-        res <- seq.int(from, to, length.out = length.out)
-        ## force double storage for consistency
-        return(.Date(as.numeric(res)))
-    }
-
     if (length(by) != 1L) stop("'by' must be of length 1")
     valid <- 0L
     if (inherits(by, "difftime")) {
         by <- switch(attr(by,"units"), secs = 1/86400, mins = 1/1440,
-                     hours = 1/24, days = 1, weeks = 7) * unclass(by)
+                     hours = 1/24, days = 1, weeks = 7) * as.integer(by)
     } else if(is.character(by)) {
         by2 <- strsplit(by, " ", fixed = TRUE)[[1L]]
         if(length(by2) > 2L || length(by2) < 1L)
@@ -279,44 +278,37 @@ seq.Date <- function(from, to, by, length.out = NULL, along.with = NULL, ...)
                         c("days", "weeks", "months", "quarters", "years"))
         if(is.na(valid)) stop("invalid string for 'by'")
         if(valid <= 2L) {
-            by <- c(1, 7)[valid]
+            by <- c(1L, 7L)[valid]
             if (length(by2) == 2L) by <- by * as.integer(by2[1L])
         } else
-            by <- if(length(by2) == 2L) as.integer(by2[1L]) else 1
+            by <- if(length(by2) == 2L) as.integer(by2[1L]) else 1L
     } else if(!is.numeric(by)) stop("invalid mode for 'by'")
     if(is.na(by)) stop("'by' is NA")
 
     if(valid <= 2L) { # days or weeks
-        from <- unclass(as.Date(from))
-        if(!is.null(length.out))
-            res <- seq.int(from, by = by, length.out = length.out)
-        else {
-            to0 <- unclass(as.Date(to))
-            ## defeat test in seq.default
-            res <- seq.int(0, to0 - from, by) + from
-        }
-        ## force double storage for consistency
-        res <- .Date(as.numeric(res))
+        from <- as.integer(as.Date(from))
+        res <- .Date(if(!is.null(length.out))
+                         seq.int(from, by = by, length.out = length.out)
+                     else # defeat test in seq.default
+                         seq.int(0L, as.integer(as.Date(to)) - from, by) + from)
     } else {  # months or quarters or years
         r1 <- as.POSIXlt(from)
         if(valid == 5L) { # years
-            if(missing(to)) {
-                yr <- seq.int(r1$year, by = by, length.out = length.out)
-            } else {
-                to0 <- as.POSIXlt(to)
-                yr <- seq.int(r1$year, to0$year, by)
-            }
-            r1$year <- yr
+            r1$year <-
+                if(missing(to))
+                    seq.int(r1$year, by = by, length.out = length.out)
+                else
+                    seq.int(r1$year, as.POSIXlt(to)$year, by)
             res <- as.Date(r1)
         } else { # months or quarters
-            if (valid == 4L) by <- by * 3
-            if(missing(to)) {
-                mon <- seq.int(r1$mon, by = by, length.out = length.out)
-            } else {
-                to0 <- as.POSIXlt(to)
-                mon <- seq.int(r1$mon, 12*(to0$year - r1$year) + to0$mon, by)
-            }
-            r1$mon <- mon
+            if (valid == 4L) by <- by * 3L
+            r1$mon <-
+                if(missing(to))
+                    seq.int(r1$mon, by = by, length.out = length.out)
+                else {
+                    to0 <- as.POSIXlt(to)
+                    seq.int(r1$mon, 12L*(to0$year - r1$year) + to0$mon, by)
+                }
             res <- as.Date(r1)
         }
     }

src/library/base/man/seq.Date.Rd

@@ -1,6 +1,6 @@
 % File src/library/base/man/seq.Date.Rd
 % Part of the R package, https://www.R-project.org
-% Copyright 1995-2017 R Core Team
+% Copyright 1995-2024 R Core Team
 % Distributed under GPL 2 or later
 
 \name{seq.Date}
@@ -32,10 +32,14 @@
     and a space, or followed by \code{"s"}.
 
     See \code{\link{seq.POSIXt}} for the details of \code{"month"}.
+
+    In the case \code{seq(from, to)}, the default for \code{by} is
+    \code{"day"} (or \code{"1 day"}).
   }
 }
 \value{
   A vector of class \code{"Date"}.
+  Type \code{"\link{integer}"} is preserved.
 }
 \seealso{\code{\link{Date}}}
 

tests/datetime3.R

@@ -588,6 +588,18 @@ stopifnot(exprs = {
   grepl('x[, "yday"]', print(tryCmsg(pl[["yday"]])))# new error msg
 })
 
+## seq.Date() should preserve integer, seq(from, to) should work (default by = "1 day")
+D1 <- .Date(i1 <- 11111L)
+D2 <- .Date(i2 <- 11123L)
+D3 <- .Date(i3 <- 12345L)
+(seq1 <- seq(D1, D2))# 'by = "days" is now default
+head(seq3 <- seq(D1,D3, by = "weeks"))
+stopifnot(exprs = {
+    identical(c("2000-06-03", "2000-06-15"), format(c(D1,D2)))
+    identical(unclass(seq1), i1:i2) # preserve integer type
+    typeof(seq3) == "integer"
+})
+
 
 
 ## keep at end

tests/reg-tests-1d.R

@@ -646,10 +646,14 @@ D1 <- as.Date("2017-01-06")
 D2 <- as.Date("2017-01-12")
 seqD1 <- seq.Date(D1, D2, by = "1 day")
 stopifnot(exprs = {
+    identical(seqD1, seq(D1, D2)) # by = "days" now implicit default
     identical(seqD1, seq(D1, D2, by = "1 days"))
-    ## These two work "accidentally" via seq -> seq.default + "Date"-arithmetic
-    identical(seqD1, seq(by = 1, from = D1, length.out = 7))
-    identical(seqD1, seq(by = 1,   to = D2, length.out = 7))
+    ## These  work "accidentally" via seq -> seq.default + "Date"-arithmetic (but *not* seq.Date):
+    ## are equal, but 2nd is "double"
+    seqD1 == seq(by = 1, from = D1, length.out = 7)
+    seqD1 == seq(by = 1,   to = D2, length.out = 7)
+    seqD1 == seq(by = 1L,  to = D2, length.out = 7)
+    ## not (yet) identical(seqD1, seq(by = 1L, from = D1, length.out = 7))
     ## swap order of (by, to) ==> *FAILS* because directly calls seq.Date() - FIXME?
     TRUE ||
     identical(seqD1, seq(to = D2,  by = 1, length.out = 7))