attr<-(., "tsp")`s C code uses "ts.eps" option instead of hardwired 1e-5; ts() using that

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

Author: maechler

doc/NEWS.Rd

@@ -63,7 +63,7 @@
       support variable font axes so far.
     }
   }
-  
+
   \subsection{INSTALLATION}{
     \itemize{
       \item .
@@ -146,6 +146,11 @@
       \item \code{text()} now truncates \code{labels} to maximum length
       of \code{x} and \code{y} (if it is longer), fixing \PR{7084}.
       Thanks to \I{Heather Turner} and \I{Ella Kaye}.
+
+      \item \code{attr(., "tsp") <- val} now uses \code{getOption("ts.eps")}
+      instead of hardwired \code{1e-5}; consequently, \code{ts(.., ts.eps=*)}
+      now passes \code{ts.eps} to the \code{"tsp"} setting C code;
+      both fixing a long-standing \sQuote{\I{FIXME}}.
     }
   }
 }
@@ -3551,7 +3556,7 @@
       patch by \I{Thomas Soeiro} in \PR{18243}.
 
       \item \code{as.vector()} gains a \code{data.frame} method which
-      returns a simple named list, also clearing a long standing
+      returns a simple named list, also clearing a long-standing
       \sQuote{\I{FIXME}} to enable \code{as.vector(<data.frame>,
       mode="list")}.  This breaks code relying on
       \code{as.vector(<data.frame>)} to return the unchanged data frame.

src/library/base/po/R.pot

@@ -1195,7 +1195,7 @@ msgid "names() applied to a non-vector"
 msgstr ""
 
 #: src/main/attrib.c:432
-msgid "invalid time series parameters specified"
+msgid "invalid time series parameters specified (%d)"
 msgstr ""
 
 #: src/main/attrib.c:446

src/library/stats/R/ts.R

@@ -1,7 +1,7 @@
 #  File src/library/stats/R/ts.R
 #  Part of the R package, https://www.R-project.org
 #
-#  Copyright (C) 1995-2024 The R Core Team
+#  Copyright (C) 1995-2025 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
@@ -86,8 +86,10 @@ ts <- function(data = NA, start = 1, end = numeric(), frequency = 1,
 		if(ndata < nobs) data[rep_len(1L:ndata, nobs), ]
 		else if(ndata > nobs) data[1L:nobs, ]
 	    }
-    ## FIXME: The following "attr<-"() calls C tspgets() which uses a
-    ##  	fixed equivalent of ts.eps := 1e-5
+    ## attr(data, "tsp") <- .. below calls C tspgets() which uses getOption("ts.eps"):
+    if(doEps <- !missing(ts.eps) && ts.eps != getOption("ts.eps")) {
+        op <- options(ts.eps = ts.eps); on.exit(options(op))
+    }
     attr(data, "tsp") <- c(start, end, frequency) #-- order is fixed
     if(!is.null(class) && class[[1]] != "none") attr(data, "class") <- class
     ## if you alter the return structure, you also need to alter
@@ -400,7 +402,7 @@ print.ts <- function(x, calendar, ...)
     invisible(x)
 }
 
-## To be used in a  format.ts():
+## used in print.ts(), and to be used in a (future / other pkg) format.ts()
 .preformat.ts <- function(x, calendar, ...)
 {
     fr.x <- frequency(x)
@@ -456,7 +458,7 @@ print.ts <- function(x, calendar, ...)
 		    paste(month.abb[t2], p1)
 		else
 		    paste(p1, if(fr.x == 4) c("Q1", "Q2", "Q3", "Q4")[t2]
-			  else format(t2))
+			      else format(t2))
 	    } else
 		format(time(x))
         attr(x, "class") <- attr(x, "tsp") <- attr(x, "na.action") <- NULL

src/library/stats/man/ts.Rd

@@ -1,6 +1,6 @@
 % File src/library/stats/man/ts.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{ts}
@@ -49,7 +49,8 @@ is.mts(x)
     \code{frequency} or \code{deltat} should be provided.}
   \item{ts.eps}{time series comparison tolerance.  Frequencies are
     considered equal if their absolute difference is less than
-    \code{ts.eps}.}
+    \code{ts.eps}.  It is also used to check consistency of \code{end - start},
+    \code{frequency}, and the length of the time-series.}
   \item{class}{class to be given to the result, or none if \code{NULL}
     or \code{"none"}.  The default is \code{"ts"} for a single series, or
     \code{c("mts", "ts", "matrix", "array")} for multiple series.}

src/library/stats/man/tsp.Rd

@@ -1,10 +1,10 @@
 % File src/library/stats/man/tsp.Rd
 % Part of the R package, https://www.R-project.org
-% Copyright 1995-2014 R Core Team
+% Copyright 1995-2025 R Core Team
 % Distributed under GPL 2 or later
 
 \name{tsp}
-\title{Tsp Attribute of Time-Series-like Objects}
+\title{`Tsp` Attribute of Time-Series-like Objects}
 \alias{tsp}
 \alias{tsp<-}
 \alias{hasTsp}
@@ -27,6 +27,7 @@ hasTsp(x)
   The \code{tsp} attribute gives the start time \emph{in time units},
   the end time and the frequency (the number of observations per unit of
   time, e.g.\sspace{}12 for a monthly series).
+  The frequency may be fractional, see \code{\link{ts}}.
 
   Assignments are checked for consistency.
 

src/main/attrib.c

@@ -427,17 +427,14 @@ static void checkNames(SEXP x, SEXP s)
 
 /* Time Series Parameters */
 
-NORET static void badtsp(void)
+NORET static void badtsp(int k)
 {
-    error(_("invalid time series parameters specified"));
+    error(_("invalid time series parameters specified (%d)"), k);
 }
 
 attribute_hidden
 SEXP tspgets(SEXP vec, SEXP val)
 {
-    double start, end, frequency;
-    int n;
-
     if (vec == R_NilValue)
 	error(_("attempt to set an attribute on NULL"));
 
@@ -451,6 +448,7 @@ SEXP tspgets(SEXP vec, SEXP val)
     if (!isNumeric(val) || LENGTH(val) != 3)
 	error(_("'tsp' attribute must be numeric of length three"));
 
+    double start, end, frequency;
     if (isReal(val)) {
 	start = REAL(val)[0];
 	end = REAL(val)[1];
@@ -464,13 +462,12 @@ SEXP tspgets(SEXP vec, SEXP val)
 	frequency = (INTEGER(val)[2] == NA_INTEGER) ?
 	    NA_REAL : INTEGER(val)[2];
     }
-    if (frequency <= 0) badtsp();
-    n = nrows(vec);
+    if (frequency <= 0) badtsp(0);
+    int n = nrows(vec);
     if (n == 0) error(_("cannot assign 'tsp' to zero-length vector"));
 
-    /* FIXME:  1.e-5 should rather be == option('ts.eps') !! */
-    if (fabs(end - start - (n - 1)/frequency) > 1.e-5)
-	badtsp();
+    if (fabs(end - start - (n - 1)/frequency) > asReal(GetOption1(install("ts.eps"))))
+	badtsp(1);
 
     PROTECT(vec);
     val = allocVector(REALSXP, 3);

tests/reg-tests-1e.R

@@ -1996,6 +1996,12 @@ stopifnot(exprs = {
 ## The t.test() calls errored all in R <= 4.5.1
 
 
+## long standing "FIXME" fixed:
+stopifnot(is.ts(ts(1:711, frequency=2*pi, start = 1, end = 114)))
+assertErrV(     ts(1:711, frequency=2*pi, start = 1, end = 114, ts.eps = 1e-6) )
+## did *not* error in R <= 4.5.1, as 'ts.eps' was *not* passed to C code
+
+
 
 ## keep at end
 rbind(last =  proc.time() - .pt,