between verbose, POSIXct support, RHS dot-alias, int64 support

NEWS.md

@@ -48,6 +48,8 @@
 
 7. New variable `.Last.updated` (similar to R's `.Last.value`) contains the number of rows affected by the most recent `:=` or `set()`, [#1885](https://github.com/Rdatatable/data.table/issues/1885).
 
+8. `between()` and `%between%` are faster for `POSIXct`, [#3519](https://github.com/Rdatatable/data.table/issues/3519), and now support the `.()` alias, [#2315](https://github.com/Rdatatable/data.table/issues/2315). Thanks to @Henrik-P for the reports.
+
 #### BUG FIXES
 
 1. `first`, `last`, `head` and `tail` by group no longer error in some cases, [#2030](https://github.com/Rdatatable/data.table/issues/2030) [#3462](https://github.com/Rdatatable/data.table/issues/3462). Thanks to @franknarf1 for reporting.

R/between.R

@@ -4,22 +4,45 @@ between <- function(x,lower,upper,incbounds=TRUE) {
   if (is.logical(lower)) lower = as.integer(lower)   # typically NA (which is logical type)
   if (is.logical(upper)) upper = as.integer(upper)   # typically NA (which is logical type)
   is_strictly_numeric <- function(x) is.numeric(x) && !inherits(x, "integer64")
+  try_posix_cast <- function(x, tz) {
+    x_time = as.POSIXct(x, tz = tz)
+    if (is.na(x_time)) return(x)
+    return(x_time)
+  }
+  if (inherits(x, "POSIXct")) {
+    # allow fast between on POSIX vs non-explicit-POSIX in some circumstances
+    #   (biggest worry is hard-to-predict timezone mismatch)
+    if (!is.null(tz <- attr(x, 'tzone'))) {
+      lower = try_posix_cast(lower, tz)
+      upper = try_posix_cast(upper, tz)
+    }
+    if (inherits(lower, "POSIXct") && inherits(upper, "POSIXct")) { #3519
+      x = unclass(x)
+      lower = unclass(lower)
+      upper = unclass(upper)
+    }
+  }
   if (is_strictly_numeric(x) && is_strictly_numeric(lower) && is_strictly_numeric(upper)) {
     # faster parallelised version for int/double.
     # Cbetween supports length(lower)==1 (recycled) and (from v1.12.0) length(lower)==length(x).
     # length(upper) can be 1 or length(x) independently of lower
     .Call(Cbetween, x, lower, upper, incbounds)
   } else {
+    if (isTRUE(getOption("datatable.verbose"))) cat("optimised between not available for this data type, fallback to slow R routine\n")
     # now just for character input. TODO: support character between in Cbetween and remove this branch
-    if(incbounds) x>=lower & x<=upper
+    if (incbounds) x>=lower & x<=upper
     else x>lower & x<upper
   }
 }
 
 # %between% is vectorised, #534.
 "%between%" <- function(x, y) {
+  ysub = substitute(y)
+  if (is.call(ysub) && ysub[[1L]]==".") {
+    ysub[[1L]]=quote(list)
+    y = eval.parent(ysub)
+  }
   if ((l <- length(y)) != 2L) {
-    ysub = substitute(y)
     stop("RHS has length() ", l, "; expecting length 2. ",
          if (is.call(ysub) && ysub[[1L]] == 'c')
            sprintf("Perhaps you meant %s? ",
@@ -37,7 +60,7 @@ inrange <- function(x,lower,upper,incbounds=TRUE) {
   query = setDT(list(x=x))
   subject = setDT(list(l=lower, u=upper))
   ops = if (incbounds) c(4L, 2L) else c(5L, 3L) # >=,<= and >,<
-  verbose = getOption("datatable.verbose")
+  verbose = isTRUE(getOption("datatable.verbose"))
   if (verbose) {last.started.at=proc.time();cat("forderv(query) took ... ");flush.console()}
   xo = forderv(query)
   if (verbose) {cat(timetaken(last.started.at),"\n"); flush.console()}

inst/tests/tests.Rraw

@@ -14129,6 +14129,36 @@ g = data.table(a=5:6, z=18L)
 d[, z:=NULL][g, on="a", z:=i.z]
 test(2030.18, .Last.updated, 0L) # zero match
 
+# `between` invalid args, and verbose #3516
+test(2031.01, between(1:5, 2, 4, incbounds=423), error="incbounds must be logical")
+test(2031.02, between(1:5, 2, 4, incbounds=NA), error="incbounds must be logical")
+old = options(datatable.verbose=TRUE)
+test(2031.05, between(1:5, 2L, 4L), output="between parallel processing of integer with recycling took")
+test(2031.06, between(1:5, rep(2L,5L), rep(4L, 5L)), output="between parallel processing of integer took")
+test(2031.07, between(as.double(1:5), 2, 4, incbounds=FALSE), output="between parallel processing of double using open bounds with recycling took")
+test(2031.08, between(as.double(1:5), 2, 4), output="between parallel processing of double using closed bounds with recycling took")
+test(2031.09, between(as.double(1:5), rep(2, 5L), rep(4, 5L)), output="between parallel processing of double took")
+test(2031.10, between(c("foo","bar","paz"), "bag", "fog"), output="optimised between not available for this data type, fallback to slow R routine")
+# `between` handle POSIXct type
+x = as.POSIXct("2016-09-18 07:00:00") + 0:10*60*15
+dn = as.POSIXct('2016-09-18 08:00:00')
+up = as.POSIXct('2016-09-18 09:00:00')
+test(2031.11, between(x, dn, up), output="between parallel processing of double using closed bounds with recycling took")
+test(2031.12, between(x, dn, up, incbounds=FALSE), output="between parallel processing of double using open bounds with recycling took")
+## also handling of string lower/upper bounds _only when x has a time zone_
+dn = as.character(dn)
+up = as.character(up)
+test(2031.13, between(x, dn, up), output = 'optimised between not available')
+attr(x, 'tzone') = 'UTC'
+test(2031.14, between(x, dn, up), output = 'between parallel processing of double')
+### additional flexibility -- cast when one bound is already POSIXct
+up = as.POSIXct(up)
+test(2031.15, between(x, dn, up), output = 'between parallel processing of double')
+# `between` support `.` in RHS #2315
+X = data.table(a = 1:5, b = 6:10, c = c(5:1))
+test(2031.16, X[c %between% list(a, b)], X[c %between% .(a, b)])
+options(old)
+
 
 ###################################
 #  Add new tests above this line  #

src/between.c

@@ -3,6 +3,7 @@
 SEXP between(SEXP x, SEXP lower, SEXP upper, SEXP bounds) {
 
   R_len_t nx = length(x), nl = length(lower), nu = length(upper);
+  double tic=0.0;
   if (!nx || !nl || !nu)
     return (allocVector(LGLSXP, 0));
   const int longest = MAX(MAX(nx, nl), nu);
@@ -12,7 +13,8 @@ SEXP between(SEXP x, SEXP lower, SEXP upper, SEXP bounds) {
     error("Incompatible vector lengths: length(x)==%d length(lower)==%d length(upper)==%d. Each should be either length 1 or the length of the longest.", nx, nl, nu);
   }
   if (!isLogical(bounds) || LOGICAL(bounds)[0] == NA_LOGICAL)
-    error("incbounds must be logical TRUE/FALSE.");  // # nocov
+    error("incbounds must be logical TRUE/FALSE.");
+  const bool verbose = GetVerbose();
 
   int nprotect = 0;
   bool integer=true;
@@ -41,16 +43,19 @@ SEXP between(SEXP x, SEXP lower, SEXP upper, SEXP bounds) {
     if (!recycleX && recycleLow && recycleUpp) {
       const int l = lp[0] + open;  // +open so we can always use >= and <=.  NA_INTEGER+1 == -INT_MAX == INT_MIN+1 (so NA limit handled by this too)
       const int u = up[0]==NA_INTEGER ? INT_MAX : up[0] - open;
+      if (verbose) tic = omp_get_wtime();
       #pragma omp parallel for num_threads(getDTthreads())
       for (int i=0; i<longest; i++) {
         int elem = xp[i];
         ansp[i] = elem==NA_INTEGER ? NA_LOGICAL : (l<=elem && elem<=u);
       }
+      if (verbose) Rprintf("between parallel processing of integer with recycling took %8.3fs\n", omp_get_wtime()-tic);
     }
     else {
       const int xMask = recycleX ? 0 : INT_MAX;
       const int lowMask = recycleLow ? 0 : INT_MAX;
       const int uppMask = recycleUpp ? 0 : INT_MAX;
+      if (verbose) tic = omp_get_wtime();
       #pragma omp parallel for num_threads(getDTthreads())
       for (int i=0; i<longest; i++) {
         int elem = xp[i & xMask];
@@ -59,6 +64,7 @@ SEXP between(SEXP x, SEXP lower, SEXP upper, SEXP bounds) {
         u = (u==NA_INTEGER) ? INT_MAX : u-open;
         ansp[i] = elem==NA_INTEGER ? NA_LOGICAL : (l<=elem && elem<=u);
       }
+      if (verbose) Rprintf("between parallel processing of integer took %8.3fs\n", omp_get_wtime()-tic);
     }
   } else {
     // type real
@@ -69,23 +75,28 @@ SEXP between(SEXP x, SEXP lower, SEXP upper, SEXP bounds) {
       const double l = isnan(lp[0]) ? -INFINITY : lp[0];
       const double u = isnan(up[0]) ?  INFINITY : up[0];
       if (open) {
+        if (verbose) tic = omp_get_wtime();
         #pragma omp parallel for num_threads(getDTthreads())
         for (int i=0; i<longest; i++) {
           double elem = xp[i];
           ansp[i] = isnan(elem) ? NA_LOGICAL : (l<elem && elem<u);
         }
+        if (verbose) Rprintf("between parallel processing of double using open bounds with recycling took %8.3fs\n", omp_get_wtime()-tic);
       } else {
+        if (verbose) tic = omp_get_wtime();
         #pragma omp parallel for num_threads(getDTthreads())
         for (int i=0; i<longest; i++) {
           double elem = xp[i];
           ansp[i] = isnan(elem) ? NA_LOGICAL : (l<=elem && elem<=u);
         }
+        if (verbose) Rprintf("between parallel processing of double using closed bounds with recycling took %8.3fs\n", omp_get_wtime()-tic);
       }
     }
     else {
       const int xMask = recycleX ? 0 : INT_MAX;
       const int lowMask = recycleLow ? 0 : INT_MAX;
       const int uppMask = recycleUpp ? 0 : INT_MAX;
+      if (verbose) tic = omp_get_wtime();
       #pragma omp parallel for num_threads(getDTthreads())
       for (int i=0; i<longest; i++) {
         double elem = xp[i & xMask];
@@ -95,6 +106,7 @@ SEXP between(SEXP x, SEXP lower, SEXP upper, SEXP bounds) {
         if (isnan(u)) u= INFINITY;
         ansp[i] = isnan(elem) ? NA_LOGICAL : (open ? l<elem && elem<u : l<=elem && elem<=u);
       }
+      if (verbose) Rprintf("between parallel processing of double took %8.3fs\n", omp_get_wtime()-tic);
     }
   }
   UNPROTECT(nprotect);

src/data.table.h

@@ -75,9 +75,11 @@ SEXP sym_index;
 SEXP sym_BY;
 SEXP sym_starts, char_starts;
 SEXP sym_maxgrpn;
+SEXP sym_verbose;
 bool INHERITS(SEXP x, SEXP char_);
 long long DtoLL(double x);
 double LLtoD(long long x);
+bool GetVerbose();
 double NA_INT64_D;
 long long NA_INT64_LL;
 
@@ -175,3 +177,6 @@ SEXP colnamesInt(SEXP x, SEXP cols);
 void nafillDouble(double *x, uint_fast64_t nx, unsigned int type, double fill, ans_t *ans, bool verbose);
 void nafillInteger(int32_t *x, uint_fast64_t nx, unsigned int type, int32_t fill, ans_t *ans, bool verbose);
 SEXP nafillR(SEXP obj, SEXP type, SEXP fill, SEXP inplace, SEXP cols, SEXP verbose);
+
+// between.c
+SEXP between(SEXP x, SEXP lower, SEXP upper, SEXP bounds);

src/init.c

@@ -289,6 +289,7 @@ void attribute_visible R_init_datatable(DllInfo *info)
   sym_index   = install("index");
   sym_BY      = install(".BY");
   sym_maxgrpn = install("maxgrpn");
+  sym_verbose = install("datatable.verbose");
   SelfRefSymbol = install(".internal.selfref");
 
   initDTthreads();
@@ -335,6 +336,12 @@ inline double LLtoD(long long x) {
   return u.d;
 }
 
+bool GetVerbose() {
+  // don't call repetitively; save first in that case
+  SEXP opt = GetOption(sym_verbose, R_NilValue);
+  return isLogical(opt) && LENGTH(opt)==1 && LOGICAL(opt)[0]==1;
+}
+
 // # nocov start
 SEXP hasOpenMP() {
   // Just for use by onAttach (hence nocov) to avoid an RPRINTF from C level which isn't suppressable by CRAN