sequence.default(..., recycle = ..getenv("..")): step #1 towards fully recycling w/ some back-compatibility

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

Author: maechler

doc/NEWS.Rd

@@ -147,6 +147,11 @@
       convenience and code readability, from an R-devel suggestion, after
       many years of private definitions mostly hidden in packages,
       including in \R's \pkg{tools} package.
+
+      \item The default method of \code{sequence()} gets a new option
+      \code{recycle} to swap between current (not fully recycling) and
+      future behaviour where all three of \code{(nvec, from, by)} are
+      jointly recycled.
     }
   }
 
@@ -427,6 +432,13 @@
       \item Values returned by active binding functions are now marked as
       not mutable to prevent unintended mutation in complex assignment
       operations.
+
+      \item The default method of \code{sequence()} now allows to
+      fully recycle all three of \code{(nvec, from, by)} as always
+      documented; with thanks to \I{Mikael Jagan}'s report and patch in
+      \PR{18304}.  Its behaviour remains back compatible for now, but can
+      be switched to future behaviour via enviroment variable
+      \env{R_sequence_recycle}, or explicit \code{recycle = TRUE}.
     }
   }
 }

src/library/base/R/seq.R

@@ -172,6 +172,8 @@ seq.default <-
 ## In reverence to the very first versions of R which already had sequence():
 sequence <- function(nvec, ...) UseMethod("sequence")
 
-sequence.default <- function(nvec, from = 1L, by = 1L, ...) {
-    .Internal(sequence(as.integer(nvec), as.integer(from), as.integer(by)))
+sequence.default <- function(nvec, from = 1L, by = 1L,
+                             recycle = Sys.getenv("R_sequence_recycle", "false"), ...) {
+    .Internal(sequence(as.integer(nvec), as.integer(from), as.integer(by),
+                       if(missing(recycle)) 0L else as.logical(recycle)))
 }

src/library/base/man/sequence.Rd

@@ -1,13 +1,14 @@
 % File src/library/base/man/sequence.Rd
 % Part of the R package, https://www.R-project.org
-% Copyright 1995-2007 R Core Team
+% Copyright 1995-2025 R Core Team
 % Distributed under GPL 2 or later
 
 \name{sequence}
 \title{Create A Vector of Sequences}
 \usage{
 sequence(nvec, \dots)
-\method{sequence}{default}(nvec, from = 1L, by = 1L, \dots)
+\method{sequence}{default}(nvec, from = 1L, by = 1L,
+    recycle = Sys.getenv("R_sequence_recycle", "false"), \dots)
 }
 \alias{sequence}
 \alias{sequence.default}
@@ -18,37 +19,59 @@ sequence(nvec, \dots)
     specifies the first element of a sequence.}
   \item{by}{coerced to an integer vector each element of which
     specifies the step size between elements of a sequence.}
+  \item{recycle}{\code{\link{logical}} or coercible to it, indicating if
+    \code{nvec} is recycled, as it has always been documented to.
+    We recommend to set this to \code{TRUE} explicitly, as that will become
+    default, see \sQuote{Details}.}% also \PR{18304} for background
   \item{\dots}{additional arguments passed to methods.}
 }
 \description{
   The default method for \code{sequence} generates the sequence
   \code{\link{seq}(from[i], by = by[i], length.out = nvec[i])} for each
   element \code{i} in the parallel (and recycled) vectors \code{from},
-  \code{by} and \code{nvec}. It then returns the result of concatenating
-  those sequences.
+  \code{by} and \code{nvec}.
+  Note that \code{nvec} is \emph{not} recycled unless \code{recycle}
+  is true, see \sQuote{Details}.
+  It then returns the result of concatenating those sequences.
 }
 \details{
   Negative values are supported for \code{from} and
   \code{by}. \code{sequence(nvec, from, by=0L)} is equivalent to
   \code{rep(from, each=nvec)}.
 
-  This function was originally implemented in R with fewer features, but
+  This function was originally implemented in \R with fewer features, but
   it has since become more flexible, and the default method is
   implemented in C for speed.
+
+  Argument \code{recycle} is new since \R 4.6.0;
+  currently, the default is \code{FALSE} unless the environment variable
+  \env{R_sequence_recycle} is set to a true value.  \cr
+  This provides back compatibility with \R <= 4.5.z, where \code{from} and
+  \code{by} are recycled or shortened to length \code{length(nvec)} in case
+  that is shorter than the maximal length.  \cr
+  The plan is to replace the environment variable with an option
+  (\code{\link{getOption}}) defaulting to \code{TRUE} and later to
+  \code{TRUE} without a global option, to use \R's usual recycling semantic
+  for all three arguments \code{nvec, from, by}.
 }
 \seealso{
   \code{\link{gl}}, \code{\link{seq}}, \code{\link{rep}}.
 }
 \author{Of the current version, Michael Lawrence based on code from the
-  S4Vectors Bioconductor package}
+  \pkg{S4Vectors} Bioconductor package}
 \examples{
 sequence(c(3, 2)) # the concatenated sequences 1:3 and 1:2.
-#> [1] 1 2 3 1 2
-sequence(c(3, 2), from=2L)
-#> [1] 2 3 4 2 3
-sequence(c(3, 2), from=2L, by=2L)
-#> [1] 2 4 6 2 4
-sequence(c(3, 2), by=c(-1L, 1L))
-#> [1] 1 0 -1 1 2
+#> [1] 1 2 3 ' 1 2  (using ' to visualize the sub-sequences)
+sequence(c(3, 2), from=2L)         #> [1] 2 3 4 ' 2 3
+sequence(c(3, 2), from=2L, by=2L)  #> [1] 2 4 6 ' 2 4
+sequence(c(3, 2), by=c(-1L, 1L))   #> [1] 1 0 -1 ' 1 2
+
+## Cases where  'recycle'  makes a difference:
+sequence(3, 1:3) #>  1 2 3  (_currently_ -- will change in future!)
+sequence(3, 1:3, recycle = FALSE)# back compatible: 1 2 3
+sequence(3, 1:3, recycle = TRUE) # future default -- use in new code!
+                                    # --> 1 2 3 ' 2 3 4 ' 3 4 5
+try(sequence(3, 1:3, 1[0], recycle = FALSE)) # an Error; default will be "empty":
+    sequence(3, 1:3, 1[0], recycle = TRUE) # |--> integer(0)
 }
 \keyword{manip}

src/main/names.c

@@ -269,7 +269,7 @@ FUNTAB R_FunTab[] =
 {"tcrossprod",	do_matprod,	2,	1,	1,	{PP_FUNCALL, PREC_FN,	0}},
 {"asplit",	do_asplit,	0,	11,	8,	{PP_FUNCALL, PREC_FN,	0}},
 {"lengths",	do_lengths,	0,	11,	2,	{PP_FUNCALL, PREC_FN,	0}},
-{"sequence",	do_sequence,	0,	11,	3,	{PP_FUNCALL, PREC_FN,	0}},
+{"sequence",	do_sequence,	0,	11,	4,	{PP_FUNCALL, PREC_FN,	0}},
 
 {"vhash",	do_vhash,	0,	11,	-1,	{PP_FUNCALL, PREC_FN,	0}},
 

src/main/seq.c

@@ -1122,57 +1122,83 @@ attribute_hidden SEXP do_seq_len(SEXP call, SEXP op, SEXP args, SEXP rho)
 
 attribute_hidden SEXP do_sequence(SEXP call, SEXP op, SEXP args, SEXP rho)
 {
-    R_xlen_t lengths_len, from_len, by_len, ans_len, i, i2, i3;
-    int from_elt, by_elt, length, j, k, *ans_elt;
-    const int *lengths_elt;
-    SEXP ans, lengths, from, by;
-
     checkArity(op, args);
 
-    lengths = CAR(args);
+    SEXP lengths = CAR(args);
     if (!isInteger(lengths))
 	error(_("'nvec' is not of mode integer"));
-    from = CADR(args);
+    SEXP from = CADR(args);
     if (!isInteger(from))
 	error(_("'from' is not of mode integer"));
-    by = CADDR(args);
+    SEXP by = CADDR(args);
     if (!isInteger(by))
 	error(_("'by' is not of mode integer"));
+    SEXP recycle_1st_ = CADDDR(args);
+    bool maybe_warn = (bool) isInteger(recycle_1st_); // when missing(recycle) in R
+    bool recycle_1st  = asBool2(recycle_1st_, call);
+    R_xlen_t
+	lengths_len = xlength(lengths);
+    if(lengths_len == 0)
+	return allocVector(INTSXP, 0);
+    R_xlen_t
+	from_len    = xlength(from),
+	by_len      = xlength(by);
 
-    lengths_len = length(lengths);
-    from_len = length(from);
-    by_len = length(by);
-    if (lengths_len != 0) {
+    if (!recycle_1st && lengths_len != 0) {
 	if (from_len == 0)
-	    error(_("'from' has length 0, but not 'nvec'"));
+	    error(_("'%s' has length 0, but not 'nvec'; 'recycle = TRUE' returns empty here"), "from");
 	if (by_len == 0)
-	    error(_("'by' has length 0, but not 'nvec'"));
+	    error(_("'%s' has length 0, but not 'nvec'; 'recycle = TRUE' returns empty here"), "by");
+    } else { // recycle_1st
+	if(from_len == 0 || by_len == 0)
+	return allocVector(INTSXP, 0);
+    }
+    R_xlen_t ans_len,
+	max_len = ((lengths_len > from_len) ?
+		   (lengths_len > by_len ? lengths_len : by_len) :
+		   (from_len    > by_len ?    from_len : by_len)),
+	i, i1, i2, i3;
+    if(!recycle_1st && lengths_len < max_len) {
+	/* warn that this will change, if arg was missing, at most *once* per R session */
+	static bool warn_1st = true;
+	if(warn_1st && maybe_warn) {
+	    char msg[99];
+	    snprintf(msg, 99, "length(nvec) %ld < %ld = max(length(from), length(by))",
+		     lengths_len, max_len);
+	    warning(_("%s -- future R`s default 'recycle = TRUE' will recycle 'nvec'"), msg);
+	    warn_1st = false;
+	}
+	max_len = lengths_len;
     }
-    ans_len = 0;
-    lengths_elt = INTEGER(lengths);
-    for (i = 0; i < lengths_len; i++, lengths_elt++) {
-	length = *lengths_elt;
-	if (length == NA_INTEGER || length < 0)
+    const int *lengths_elt = INTEGER(lengths);
+    for (i = i1 = ans_len = 0; i < max_len; i++, i1++) {
+	if (i1 >= lengths_len)
+	    i1 = 0; /* recycle */
+	int len = lengths_elt[i1];
+	if (len == NA_INTEGER || len < 0)
 	    error(_("'nvec' must be a vector of non-negative integers"));
-	ans_len += length;
+	ans_len += len;
     }
-    ans = allocVector(INTSXP, ans_len);
-    ans_elt = INTEGER(ans);
-    lengths_elt = INTEGER(lengths);
-    for (i = i2 = i3 = 0; i < lengths_len; i++, i2++, i3++, lengths_elt++) {
+    SEXP ans = allocVector(INTSXP, ans_len);
+    int *ans_elt = INTEGER(ans),
+	*pfrom   = INTEGER(from),
+	*pby     = INTEGER(by);
+    for (i = i1 = i2 = i3 = 0; i < max_len; i++, i1++, i2++, i3++) {
+	if (recycle_1st && i1 >= lengths_len)
+	    i1 = 0; /* recycle */
 	if (i2 >= from_len)
 	    i2 = 0; /* recycle */
 	if (i3 >= by_len)
 	    i3 = 0; /* recycle */
-	length = *lengths_elt;
-	from_elt = INTEGER(from)[i2];
+	int length = lengths_elt[i1],
+	    from_elt = pfrom[i2];
 	if (length != 0 && from_elt == NA_INTEGER)
 	    error(_("'from' contains NAs"));
-	by_elt = INTEGER(by)[i3];
+	int by_elt = pby[i3];
 	if (length >= 2 && by_elt == NA_INTEGER)
 	    error(_("'by' contains NAs"));
 	// int to = from_elt + (length - 1) * by_elt;
-	for (k = 0, j = from_elt; k < length; j += by_elt, k++)
+	for (int k = 0, j = from_elt; k < length; j += by_elt, k++)
 	    *(ans_elt++) = j;
     }
     return ans;

tests/reg-tests-1e.R

@@ -2408,6 +2408,47 @@ x[1] <- 2
 stopifnot(y == 1)
 rm(x)
 
+## PR#18304 -- recycling `nvec` argument of sequence.default()
+chkS <- function(n, nvec, recyc=FALSE) {
+    lxn <- rep.int(1L, n)
+    stopifnot(exprs = {
+	identical(sequence.default(from = lxn, by = 1L, nvec = nvec, recycle=recyc),
+		  sequence.default(from = 1L, by = lxn, nvec = nvec, recycle=recyc) -> s1)
+        is.integer(s2 <- unlist(mapply(seq, from = lxn, by = 1L,
+                                       length.out = rep_len(nvec, n),# <- to avoid warning: longer argument
+									# not a multiple of length of shorter
+				       SIMPLIFY=FALSE, USE.NAMES=FALSE)))
+        identical(s1, if(recyc || n <= length(nvec)) s2 else s2[seq_along(s1)])
+    })
+    s1
+}
+for(recycl in c(FALSE, TRUE)) withAutoprint({
+    cat("\n>>>> recycl: ", recycl, "-----\n",strrep("-", 25),"\n", sep="")
+    ## These all worked identically previously:
+    chkS(1, 1,   recyc = recycl) # 1
+    chkS(2, 1:2, recyc = recycl) # 1,  1 2
+    chkS(3, 1:3, recyc = recycl) # 1,  1 2,  1 2 3
+    chkS(3, 3:1, recyc = recycl) # 1 2 3,  1 2,  1
+    chkS(4, 1:4, recyc = recycl) # 1,  1 2,  1 2 3,  1 2 3 4
+    chkS(4, 4:1, recyc = recycl) # 1 2 3 4,  1 2 3,  1 2,  1
+    chkS(5, 1:5, recyc = recycl) # 1,   1 2,   1 2 3,   1 2 3 4,   1 2 3 4 5
+    ## These did not:  length(nvec) < n :
+    if(recycl)           chkS(3, 2:3, recyc = TRUE)
+    else { rF <- getVaW( chkS(3, 2:3, recyc = FALSE) )
+       ## the very first produces a  __once per R session__ warning:
+       if(!is.null(wrn <- attr(rF, "warning"))) {
+         cat("Caught warning: ")
+         writeLines(wrn) }       #          recycl: FALSE  ||  TRUE
+       as.vector(rF) }           # 1 2, 1 2 3              ||  1 2, 1 2 3, 1 2
+    chkS(5, 2:3, recyc = recycl) # 1 2, 1 2 3              ||  1 2, 1 2 3, 1 2, 1 2 3, 1 2
+    chkS(6, 2:3, recyc = recycl) # 1 2, 1 2 3              ||  1 2, 1 2 3, 1 2, 1 2 3, 1 2, 1 2 3
+    chkS(4, 2:1, recyc = recycl) # 1 2, 1                  ||  1 2, 1, 1 2, 1
+    chkS(4, 5:6, recyc = recycl) # 1 2 3 4 5, 1 2 3 4 5 6  ||  1 2 3 4 5, 1 2 3 4 5 6, 1 2 3 4 5, 1 2 3 4 5 6
+    chkS(5, 1:4, recyc = recycl) # 1, 1 2, 1 2 3, 1 2 3 4  ||  1, 1 2, 1 2 3, 1 2 3 4, 1
+    ## the last 6 cases all failed chkS() for recycle = TRUE
+})
+
+
 
 ## keep at end
 rbind(last =  proc.time() - .pt,