range(<Date_w_Inf>, finite=TRUE) and <POSIXt>, via new .rangeNum()

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

doc/NEWS.Rd

@@ -34,8 +34,8 @@
  \code{"glm"} objects have gained a possibility to do profiling
  based on the Rao Score statistic in addition to the default
  Likelihood Ratio. This is controlled by a new \code{test=}
- argument. 
- 
+ argument.
+
  \item The \code{"glm"} method for \code{anova()} computes test
  statistics and p-values by default, using a chi-squared test or
  an F test depending on whether the dispersion is fixed or
@@ -73,6 +73,12 @@
  it in a \sQuote{<builddir> != <srcdir>} setup, and in standard
  \dQuote{binary} Windows installation \bold{if} a source \file{tests/}
  folder is present.
+
+ \item \code{range(<DT_with_Inf>, finite=TRUE)} now work for objects
+ of class \code{"Date"}, \code{"POSIXct"}, and \code{"POSIXlt"} with
+ infinite entries, analogously to \code{range.default()}, as proposed
+ by Davis Vaughan on R-devel. Other \code{range()}-methods can make
+ use of new \code{.rangeNum()}.
  }
  }
 

src/library/base/R/datetime.R

@@ -530,7 +530,9 @@ Math.POSIXt <- function (x, ...)
  if(length(tzs)) tzs[1L] else NULL
 }
 
-Summary.POSIXct <- function (..., na.rm)
+## NB: 'na.rm' is part of the Summary generic,
+## -- but 'finite' is not: argument only of range.default() and these:
+Summary.POSIXct <- function (..., na.rm, finite = FALSE)
 {
  ok <- switch(.Generic, max = , min = , range = TRUE, FALSE)
  if (!ok)
@@ -541,7 +543,7 @@ Summary.POSIXct <- function (..., na.rm)
  .POSIXct(NextMethod(.Generic), tz = tz, cl = oldClass(args[[1L]]))
 }
 
-Summary.POSIXlt <- function (..., na.rm)
+Summary.POSIXlt <- function (..., na.rm, finite = FALSE)
 {
  ok <- switch(.Generic, max = , min = , range = TRUE, FALSE)
  if (!ok)
@@ -550,7 +552,7 @@ Summary.POSIXlt <- function (..., na.rm)
  args <- list(...)
  tz <- do.call(.check_tzones, args)
  args <- lapply(args, as.POSIXct)
- val <- do.call(.Generic, c(args, na.rm = na.rm))
+ val <- do.call(.Generic, c(args, na.rm = na.rm, finite = finite))
  as.POSIXlt(.POSIXct(val, tz))
 }
 

src/library/base/R/range.R

@@ -1,7 +1,7 @@
 # File src/library/base/R/range.R
 # Part of the R package, https://www.R-project.org
 #
-# Copyright (C) 1995-2017 The R Core Team
+# Copyright (C) 1995-2023 The R Core Team
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -16,10 +16,13 @@
 # A copy of the GNU General Public License is available at
 # https://www.R-project.org/Licenses/
 
-range.default <- function(..., na.rm = FALSE, finite = FALSE)
+### MM: ........ *OR* introduce an allow.infinite() generic (semantically <==> allow.finite() )
+### as Davis proposes on May 9 on the R-devel mailing list
+
+.rangeNum <- function(..., na.rm, finite, isNumeric)
 {
  x <- c(..., recursive = TRUE)
- if(is.numeric(x)) {
+ if(isNumeric(x)) {
  if(finite) x <- x[is.finite(x)]
  else if(na.rm) x <- x[!is.na(x)]
  c(min(x), max(x))
@@ -28,3 +31,9 @@ range.default <- function(..., na.rm = FALSE, finite = FALSE)
  c(min(x, na.rm=na.rm), max(x, na.rm=na.rm))
  }
 }
+
+range.default <- function(..., na.rm = FALSE, finite = FALSE)
+ .rangeNum(..., na.rm=na.rm, finite=finite, isNumeric = is.numeric)
+
+range.POSIXct <- range.Date <- function(..., na.rm = FALSE, finite = FALSE)
+ .rangeNum(..., na.rm=na.rm, finite=finite, isNumeric = function(.)TRUE)

src/library/base/R/zzz.R

@@ -576,6 +576,8 @@ matrix(c("!", "hexmode",
  "qr", "default",
  "quarters", "Date",
  "quarters", "POSIXt",
+ "range", "Date",
+ "range", "POSIXct",
  "range", "default",
  "rbind", "data.frame",
  "rep", "Date",
@@ -666,8 +668,7 @@ local({
  bdy <- bdy[c(1:2, seq_along(bdy)[-1L])] # taking [(1,2,2:n)] to insert at [2]:
  ## deprecation warning only when not called by method dispatch from as.data.frame():
  bdy[[2L]] <- quote(if((sys.nframe() <= 1L ||
- (!identical(sys.function(-1L), as.data.frame) &&
- !(sys.call(-1L)[[1L]] == quote(FUN) && sys.call(-2L)[[1L]] == quote(lapply))) # lapply(list(pi, 1L), as.data.frame)
+ (!identical(sys.function(-1L), as.data.frame))
  ) && nzchar(Sys.getenv("_R_CHECK_AS_DATA_FRAME_EXPLICIT_METHOD_")))
  .Deprecated(
  msg = gettextf(

src/library/base/man/range.Rd

@@ -1,23 +1,31 @@
 % File src/library/base/man/range.Rd
 % Part of the R package, https://www.R-project.org
-% Copyright 1995-2007 R Core Team
+% Copyright 1995-2023 R Core Team
 % Distributed under GPL 2 or later
 
 \name{range}
+\title{Range of Values}
 \alias{range}
 \alias{range.default}
-\title{Range of Values}
+\alias{range.Date}
+\alias{range.POSIXct}
+\alias{.rangeNum}
 \usage{
 range(\dots, na.rm = FALSE)
-
 \method{range}{default}(\dots, na.rm = FALSE, finite = FALSE)
+## same for classes 'Date' and 'POSIXct'
+
+.rangeNum(\dots, na.rm, finite, isNumeric)
 }
 \arguments{
  \item{\dots}{any \code{\link{numeric}} or character objects.}
  \item{na.rm}{logical, indicating if \code{\link{NA}}'s should be
  omitted.}
  \item{finite}{logical, indicating if all non-finite elements should
  be omitted.}
+ \item{isNumeric}{a \code{\link{function}} returning \code{TRUE} or
+ \code{FALSE} when called on \code{c(\dots, recursive = TRUE)},
+ \code{\link{is.numeric}()} for the default \code{range()} method.}
 }
 \description{
  \code{range} returns a vector containing the minimum and maximum of

tests/datetime3.R

@@ -1,4 +1,4 @@
-## Date-time egression tests for R >= 4.3.0
+## Date-time regression tests for R >= 4.3.0
 ## originally added to reg-tests-1d.R
 
 .pt <- proc.time()
@@ -529,6 +529,43 @@ stopifnot(exprs = {
 stopifnot(b1 == b2)
 
 
+## range(<Date>|<PoSIXt>, finite = TRUE) [R-devel mails, Davis Vaughan and MM, April 28, 2023ff]
+d <- .Date(c(0, Inf, 1, 2, Inf))
+(dN <- c(d, .Date(c(NA, NaN))))
+## Just the numbers :
+str(x <- unclass(d))
+str(xN <- unclass(dN), vec.len=9)
+stopifnot(exprs = {
+ identical(print(range(d)), .Date(range(unclass(d))))# "1970-01-01" "Inf"
+ is.na(range(dN))
+ identical3(range(d, finite = TRUE), .Date(range(x, finite=TRUE)),
+ range(dN,finite = TRUE) -> rd)
+ identical(rd, structure(c(0, 2), 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(0, 2 * 24*60*60),
+ class = c("POSIXct", "POSIXt"), tzone = "UTC"))
+ ## POSIXlt
+ identical(print(range(lt)), as.POSIXlt(range(ct)))# "1970-01-01" "Inf"
+ identical3(range(lt, finite = TRUE), as.POSIXlt(rct),
+ range(ltN,finite = TRUE))
+ is.na(range(ltN))
+ identical(range(ltN, na.rm=TRUE), range(lt))
+})
+
+
 
 ## keep at end
 rbind(last = proc.time() - .pt,

tests/demos.Rout.save

@@ -1,5 +1,5 @@
 
-R Under development (unstable) (2023-04-19 r84284) -- "Unsuffered Consequences"
+R Under development (unstable) (2023-05-17 r84444) -- "Unsuffered Consequences"
 Copyright (C) 2023 The R Foundation for Statistical Computing
 Platform: aarch64-apple-darwin22.4.0 (64-bit)
 
@@ -245,8 +245,8 @@ List of 3
 + "\n\t starting with 'is.' :\t ",
 + sum(grepl("^is\\.", ls.base[base.is.f])), "\n", sep = "")
 
-Number of all base objects: 1387
-Number of functions from these: 1343
+Number of all base objects: 1390
+Number of functions from these: 1346
  starting with 'is.' : 53
 
 > ## R ver.| #{is*()}