implement frev as fast base::rev alternative

NAMESPACE

@@ -202,3 +202,4 @@ S3method(format_list_item, default)
 
 export(fdroplevels)
 S3method(droplevels, data.table)
+export(frev)

NEWS.md

@@ -293,6 +293,24 @@
 
 41. `tables()` is faster by default by excluding the size of character strings in R's global cache (which may be shared) and excluding the size of list column items (which also may be shared). `mb=` now accepts any function which accepts a `data.table` and returns a higher and better estimate of its size in bytes, albeit more slowly; e.g. `mb = utils::object.size`.
 
+42. `base::rev` gains a fast method `frev(x, copy)` for atomic vectors/list, [#5885](https://github.com/Rdatatable/data.table/issues/5885). Thanks to Benjamin Schwendinger for suggesting and implementing.
+
+    ```R
+    x = sample(2e8)
+    microbenchmark::microbenchmark(
+      base = rev(x),
+      frev_copy = frev(x, copy=TRUE),
+      frev_inplace = frev(x, copy=FALSE),
+      times = 10L,
+      unit = "s"
+    )
+    # Unit: seconds
+    #          expr   min    lq  mean median   uq   max neval cld
+    #          base 1.376 1.397 1.864 1.544 1.917 4.274    10 a  
+    #     frev_copy 0.529 0.591 0.769 0.659 0.727 1.351    10  b 
+    #  frev_inplace 0.064 0.065 0.066 0.066 0.067 0.070    10   c
+    ```
+
 ## BUG FIXES
 
 1. `by=.EACHI` when `i` is keyed but `on=` different columns than `i`'s key could create an invalidly keyed result, [#4603](https://github.com/Rdatatable/data.table/issues/4603) [#4911](https://github.com/Rdatatable/data.table/issues/4911). Thanks to @myoung3 and @adamaltmejd for reporting, and @ColeMiller1 for the PR. An invalid key is where a `data.table` is marked as sorted by the key columns but the data is not sorted by those columns, leading to incorrect results from subsequent queries.

R/wrappers.R

@@ -16,3 +16,5 @@ isRealReallyInt = function(x) .Call(CisRealReallyIntR, x)
 isReallyReal = function(x) .Call(CisReallyReal, x)
 
 coerceAs = function(x, as, copy=TRUE) .Call(CcoerceAs, x, as, copy)
+
+frev = function(x, copy=TRUE) if (isTRUE(copy)) .Call(Cfrev, x, copy) else invisible(.Call(Cfrev, x, copy))

inst/tests/tests.Rraw

@@ -18260,3 +18260,53 @@ test(2243.54, dt[, .I[j], x]$V1, c(1L, 3L), output="GForce TRUE")
 test(2243.55, dt[, .I[i], x]$V1, 1:4, output="GForce FALSE")
 test(2243.56, dt[, .I[1:2], x]$V1, 1:4, output="GForce FALSE")
 options(old)
+
+# 5885 implement frev
+d = c(NA, NaN, Inf, -Inf)
+test(2244.00, frev(c(FALSE, NA),    copy=TRUE), c(NA, FALSE))
+test(2244.01, frev(c(0L, NA),       copy=TRUE), c(NA, 0L))
+test(2244.02, frev(1:3,             copy=TRUE), 3:1)
+test(2244.03, frev(d,               copy=TRUE), c(-Inf, Inf, NaN, NA))
+test(2244.04, frev(c(NA, 1, 0+2i),  copy=TRUE), c(0+2i, 1, NA))
+test(2244.05, frev(as.raw(0:1),     copy=TRUE), as.raw(1:0))
+test(2244.06, frev(NULL,            copy=TRUE), NULL)
+test(2244.07, frev(character(5),    copy=TRUE), character(5))
+test(2244.08, frev(integer(0),      copy=TRUE), integer(0))
+test(2244.09, frev(list(1, "a"),    copy=TRUE), list("a", 1))
+test(2244.11, frev(c(0L, NA),       copy=FALSE), c(NA, 0L))
+test(2244.12, frev(1:3,             copy=FALSE), 3:1)
+test(2244.13, frev(d,               copy=FALSE), c(-Inf, Inf, NaN, NA))
+test(2244.14, frev(c(NA, 1, 0+2i),  copy=FALSE), c(0+2i, 1, NA))
+test(2244.15, frev(as.raw(0:1),     copy=FALSE), as.raw(1:0))
+test(2244.16, frev(NULL,            copy=FALSE), NULL)
+test(2244.17, frev(character(5),    copy=FALSE), character(5))
+test(2244.18, frev(integer(0),      copy=FALSE), integer(0))
+test(2244.19, frev(list(1, "a"),    copy=FALSE), list("a", 1))
+test(2244.20, frev(1:1e2,           copy=TRUE),  rev(1:1e2))
+# copy arguments
+x = 1:3
+test(2244.21, {frev(x, copy=TRUE);  x}, 1:3)
+test(2244.22, {frev(x, copy=FALSE); x}, 3:1)
+# levels
+f = as.factor(letters)
+test(2244.31, frev(f, copy=TRUE), rev(f))
+test(2244.32, frev(as.IDate(1:10), copy=TRUE), as.IDate(10:1))
+test(2244.33, frev(as.IDate(1:10), copy=TRUE), as.IDate(10:1))
+# names
+x = c(a=1L, b=2L, c=3L)
+test(2244.41, frev(x, copy=TRUE), rev(x))
+test(2244.42, frev(x, copy=FALSE), x)
+# attributes
+x = structure(1:10, class = c("IDate", "Date"), att = 1L)
+test(2244.51, attr(frev(x, copy=TRUE), "att"), 1L)
+test(2244.52, attr(frev(x, copy=FALSE), "att"), 1L)
+# errors
+test(2244.61, frev(data.table()), error="should not be data.frame or data.table")
+test(2244.62, frev(1:2, copy=NA), error="must be TRUE or FALSE")
+test(2244.63, frev(expression(1)), error="is not supported by frev")
+test(2244.64, frev(matrix(1)), error="should not be matrix or array")
+if (test_bit64) {
+  x = as.integer64(c(1, NA, 3))
+  test(2244.71, frev(x, copy=TRUE), rev(x))
+  test(2244.72, frev(x, copy=FALSE), x)
+}

man/frev.Rd

@@ -0,0 +1,32 @@
+\name{frev}
+\alias{frev}
+\alias{rev}
+\title{Fast reverse}
+\description{
+  Similar to \code{base::rev} but \emph{much faster}.
+}
+
+\usage{
+frev(x, copy=TRUE)
+}
+\arguments{
+  \item{x}{ An atomic \code{vector} or \code{list}. }
+  \item{copy}{ logical (default is \code{TRUE}). If \code{FALSE} reversing happens in-place. }
+}
+
+\value{
+  \code{frev} returns the input reversed.
+}
+
+\examples{
+# on vectors
+x = setNames(1:26, letters)
+frev(x[1:10])
+# reverse in-place
+frev(x, copy=FALSE)
+x
+
+# list
+frev(list(1, "a"))
+}
+\keyword{ data }

src/data.table.h

@@ -249,6 +249,7 @@ SEXP islockedR(SEXP x);
 bool need2utf8(SEXP x);
 SEXP coerceUtf8IfNeeded(SEXP x);
 SEXP coerceAs(SEXP x, SEXP as, SEXP copyArg);
+SEXP frev(SEXP x, SEXP copyArg);
 
 // types.c
 char *end(char *start);

src/init.c

@@ -141,6 +141,7 @@ R_CallMethodDef callMethods[] = {
 {"CstartsWithAny", (DL_FUNC)&startsWithAny, -1},
 {"CconvertDate", (DL_FUNC)&convertDate, -1},
 {"Cnotchin", (DL_FUNC)&notchin, -1},
+{"Cfrev", (DL_FUNC) &frev, -1},
 {NULL, NULL, 0}
 };
 

src/utils.c

@@ -424,3 +424,100 @@ SEXP startsWithAny(const SEXP x, const SEXP y, SEXP start) {
   return ScalarLogical(false);
 }
 
+SEXP frev(SEXP x, SEXP copyArg) {
+  if (INHERITS(x, char_dataframe) || INHERITS(x, char_datatable))
+    error(_("'x' should not be data.frame or data.table."));
+  if (!isNull(getAttrib(x, R_DimSymbol)))
+    error(_("'x' should not be matrix or array"));
+  if (!IS_TRUE_OR_FALSE(copyArg))
+    error(_("%s must be TRUE or FALSE."), "copy");
+  bool copy = LOGICAL(copyArg)[0];
+  R_xlen_t n = xlength(x);
+  int nprotect = 0;
+  if (copy) {
+    x = PROTECT(duplicate(x));
+    nprotect++;
+    copy = false;
+  }
+  if (n==0) {
+    UNPROTECT(nprotect);
+    return x;
+  }
+  switch (TYPEOF(x)) {
+    case LGLSXP: case INTSXP: {
+      int *restrict xd = INTEGER(x);
+      #pragma omp parallel for num_threads(getDTthreads(n, true))
+      for (uint64_t i=0; i<n/2; ++i) {
+        const int k = n-1-i;
+        const int tmp = xd[i];
+        xd[i] = xd[k];
+        xd[k] = tmp;
+      }
+    } break;
+    case REALSXP: if (INHERITS(x, char_integer64)) {
+      int64_t *xd = (int64_t *)REAL(x);
+      #pragma omp parallel for num_threads(getDTthreads(n, true))
+      for (uint64_t i=0; i<n/2; ++i) {
+        const int k = n-1-i;
+        const int64_t tmp = xd[i];
+        xd[i] = xd[k];
+        xd[k] = tmp;
+      }
+    } else {
+      double *xd = REAL(x);
+      #pragma omp parallel for num_threads(getDTthreads(n, true))
+      for (uint64_t i=0; i<n/2; ++i) {
+        const int k = n-1-i;
+        const double tmp = xd[i];
+        xd[i] = xd[k];
+        xd[k] = tmp;
+      }
+    } break;
+    case STRSXP: {
+      const SEXP *xd = SEXPPTR_RO(x);
+      for (uint64_t i=0; i<n/2; ++i) {
+        const int k = n-1-i;
+        const SEXP tmp = xd[i];
+        SET_STRING_ELT(x, i, xd[k]);
+        SET_STRING_ELT(x, k, tmp);
+      }
+    } break;
+    case VECSXP: {
+      const SEXP *xd = SEXPPTR_RO(x);
+      for (uint64_t i=0; i<n/2; ++i) {
+        const int k = n-1-i;
+        const SEXP tmp = xd[i];
+        SET_VECTOR_ELT(x, i, xd[k]);
+        SET_VECTOR_ELT(x, k, tmp);
+      }
+    } break;
+    case CPLXSXP: {
+      Rcomplex *xd = COMPLEX(x);
+      #pragma omp parallel for num_threads(getDTthreads(n, true))
+      for (uint64_t i=0; i<n/2; ++i) {
+        const int k = n-1-i;
+        const Rcomplex tmp = xd[i];
+        xd[i] = xd[k];
+        xd[k] = tmp;
+      }
+    } break;
+    case RAWSXP: {
+      Rbyte *xd = RAW(x);
+      #pragma omp parallel for num_threads(getDTthreads(n, true))
+      for (uint64_t i=0; i<n/2; ++i) {
+        const int k = n-1-i;
+        const Rbyte tmp = xd[i];
+        xd[i] = xd[k];
+        xd[k] = tmp;
+      }
+    } break;
+  default:
+    error(_("Type '%s' is not supported by frev"), type2char(TYPEOF(x)));
+  }
+  SEXP names = getAttrib(x, R_NamesSymbol);
+  if (!isNull(names)) {
+    frev(names, ScalarLogical(FALSE));
+  }
+  UNPROTECT(nprotect);
+  return x;
+}