Skip to content

Commit

Permalink
seq.Date() no longer coerces to double unnecessarily
Browse files Browse the repository at this point in the history
git-svn-id: https://svn.r-project.org/R/trunk@87284 00db46b3-68df-0310-9c12-caf00c1e9a41
  • Loading branch information
maechler committed Nov 1, 2024
1 parent 91a84c0 commit 6d3e49d
Show file tree
Hide file tree
Showing 5 changed files with 58 additions and 41 deletions.
7 changes: 6 additions & 1 deletion doc/NEWS.Rd
Original file line number Diff line number Diff line change
Expand Up @@ -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}).
Expand Down Expand Up @@ -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}.
}
}
}
Expand Down
64 changes: 28 additions & 36 deletions src/library/base/R/dates.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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)
}
}
Expand Down
6 changes: 5 additions & 1 deletion src/library/base/man/seq.Date.Rd
Original file line number Diff line number Diff line change
@@ -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}
Expand Down Expand Up @@ -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}}}

Expand Down
12 changes: 12 additions & 0 deletions tests/datetime3.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
10 changes: 7 additions & 3 deletions tests/reg-tests-1d.R
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down

0 comments on commit 6d3e49d

Please sign in to comment.