Merge remote-tracking branch 'origin/dt-mat-opt' into dt-mat-opt

Author: MichaelChirico

.ci/.lintr.R

@@ -21,6 +21,7 @@ linters = c(dt_linters, all_linters(
     message = "Use messagef to avoid fragmented translations.",
     warning = "Use warningf to avoid fragmented translations.",
     stop = "Use stopf to avoid fragmented translations.",
+    rev = "Use frev internally, or setfrev if by-reference is safe.",
     NULL
   )),
   # undesirable_function_linter(modify_defaults(

NAMESPACE

@@ -59,6 +59,7 @@ export(nafill)
 export(setnafill)
 export(.Last.updated)
 export(fcoalesce)
+export(mergelist, setmergelist)
 export(cbindlist, setcbindlist)
 export(substitute2)
 #export(DT)  # mtcars |> DT(i,j,by)  #4872 #5472
@@ -208,6 +209,7 @@ S3method(format_list_item, data.frame)
 
 export(fdroplevels, setdroplevels)
 S3method(droplevels, data.table)
+export(frev)
 
 # sort_by added in R 4.4.0, #6662, https://stat.ethz.ch/pipermail/r-announce/2024/000701.html
 if (getRversion() >= "4.4.0") S3method(sort_by, data.table)  

NEWS.md

@@ -50,6 +50,12 @@
 
 10. `data.table()` and `as.data.table()` with `keep.rownames=TRUE` now extract row names from named vectors, matching `data.frame()` behavior. Names from the first named vector in the input are used to create the row names column (default name `"rn"` or custom name via `keep.rownames="column_name"`), [#1916](https://github.com/Rdatatable/data.table/issues/1916). Thanks to @richierocks for the feature request and @Mukulyadav2004 for the implementation.
 
+11. New `frev(x)` as a faster analogue to `base::rev()` for atomic vectors/lists, [#5885](https://github.com/Rdatatable/data.table/issues/5885). Twice as fast as `base::rev()` on large inputs, and faster with more threads. Thanks to Benjamin Schwendinger for suggesting and implementing.
+
+12. New `cbindlist()` and `setcbindlist()` for concatenating a `list` of data.tables column-wise, evocative of the analogous `do.call(rbind, l)` <-> `rbindlist(l)`, [#2576](https://github.com/Rdatatable/data.table/issues/2576). `setcbindlist()` does so without making any copies. Thanks @MichaelChirico for the FR, @jangorecki for the PR, and @MichaelChirico for extensive reviews and fine-tuning.
+
+13. New `mergelist()` and `setmergelist()` similarly work _a la_ `Reduce()` to recursively merge a `list` of data.tables, [#599](https://github.com/Rdatatable/data.table/issues/599). Different join modes (_left_, _inner_, _full_, _right_, _semi_, _anti_, and _cross_) are supported through the `how` argument; duplicate handling goes through the `mult` argument. `setmergelist()` carefully avoids copies where one is not needed, e.g. in a 1:1 left join. Thanks Patrick Nicholson for the FR (in 2013!), @jangorecki for the PR, and @MichaelChirico for extensive reviews and fine-tuning.
+
 ### BUG FIXES
 
 1. `fread()` no longer warns on certain systems on R 4.5.0+ where the file owner can't be resolved, [#6918](https://github.com/Rdatatable/data.table/issues/6918). Thanks @ProfFancyPants for the report and PR.
@@ -76,6 +82,8 @@
 
 12. `print(..., col.names = 'none')` now correctly adapts column widths to the data content, ignoring the original column names and producing a more compact output, [#6882](https://github.com/Rdatatable/data.table/issues/6882). Thanks to @brooksambrose for the report and @venom1204 for the PR.
 
+13. Reference to `.SD` in `...` arguments to `lapply()`, e.g. ``lapply(list_of_tables, `[`, j=.SD[1L])`` is evaluated correctly, [#2982](https://github.com/Rdatatable/data.table/issues/2982). Thanks @franknarf1 for the report and @MichaelChirico for the fix.
+
 ### NOTES
 
 1. The following in-progress deprecations have proceeded:

R/as.data.table.R

@@ -36,11 +36,11 @@ as.data.table.table = function(x, keep.rownames=FALSE, key=NULL, ...) {
   # prevent #4179 & just cut out here
   if (any(dim(x) == 0L)) return(null.data.table())
   # Fix for bug #43 - order of columns are different when doing as.data.table(with(DT, table(x, y)))
-  val = rev(dimnames(provideDimnames(x)))
+  val = frev(dimnames(provideDimnames(x)))
   if (is.null(names(val)) || !any(nzchar(names(val))))
-    setattr(val, 'names', paste0("V", rev(seq_along(val))))
+    setattr(val, 'names', paste0("V", frev(seq_along(val))))
   ans = data.table(do.call(CJ, c(val, sorted=FALSE)), N = as.vector(x), key=key)
-  setcolorder(ans, c(rev(head(names(ans), -1L)), "N"))
+  setcolorder(ans, c(frev(head(names(ans), -1L)), "N"))
   ans
 }
 
@@ -104,18 +104,18 @@ as.data.table.array = function(x, keep.rownames=FALSE, key=NULL, sorted=TRUE, va
     dnx[nulldnx] = lapply(dx[nulldnx], seq_len) #3636
     dnx
   } else dnx
-  val = rev(val)
+  setfrev(val)
   if (is.null(names(val)) || !any(nzchar(names(val))))
-    setattr(val, 'names', paste0("V", rev(seq_along(val))))
+    setattr(val, 'names', paste0("V", frev(seq_along(val))))
   if (value.name %chin% names(val))
-    stopf("Argument 'value.name' should not overlap with column names in result: %s", brackify(rev(names(val))))
+    stopf("Argument 'value.name' should not overlap with column names in result: %s", brackify(frev(names(val))))
   N = NULL
   ans = do.call(CJ, c(val, sorted=FALSE))
   set(ans, j="N", value=as.vector(x))
   if (isTRUE(na.rm))
     ans = ans[!is.na(N)]
   setnames(ans, "N", value.name)
-  dims = rev(head(names(ans), -1L))
+  dims = frev(head(names(ans), -1L))
   setcolorder(ans, c(dims, value.name))
   if (isTRUE(sorted) && is.null(key)) key = dims
   setkeyv(ans, key)

R/bmerge.R

@@ -110,7 +110,7 @@ bmerge = function(i, x, icols, xcols, roll, rollends, nomatch, mult, ops, verbos
     }
     if (x_merge_type=="integer64" || i_merge_type=="integer64") {
       nm = c(iname, xname)
-      if (x_merge_type=="integer64") { w=i; wc=icol; wclass=i_merge_type; } else { w=x; wc=xcol; wclass=x_merge_type; nm=rev(nm) }  # w is which to coerce
+      if (x_merge_type=="integer64") { w=i; wc=icol; wclass=i_merge_type; } else { w=x; wc=xcol; wclass=x_merge_type; setfrev(nm) }  # w is which to coerce
       if (wclass=="integer" || (wclass=="double" && fitsInInt64(w[[wc]]))) {
         from_detail = if (wclass == "double") gettext(" (which has integer64 representation, e.g. no fractions)") else ""
         coerce_col(w, wc, wclass, "integer64", nm[1L], nm[2L], from_detail, verbose=verbose)

R/cedta.R

@@ -1,6 +1,4 @@
 
-cedta.override = NULL  # If no need arises, will deprecate.
-
 cedta.pkgEvalsUserCode = c("gWidgetsWWW","statET","FastRWeb","slidify","rmarkdown","knitr","ezknitr","IRkernel", "rtvs")
 # These packages run user code in their own environment and thus do not
 # themselves Depend or Import data.table. knitr's eval is passed envir=globalenv() so doesn't
@@ -39,6 +37,16 @@ cedta.pkgEvalsUserCode = c("gWidgetsWWW","statET","FastRWeb","slidify","rmarkdow
 }
 # nocov end
 
+.any_sd_queries_in_stack = function(calls) {
+  for (ii in length(calls):1) { # nolint: seq_linter. As above.
+    if (!calls[[ii]] %iscall% "[") next
+    the_lhs = calls[[ii]][[2L]]
+    if (!is.name(the_lhs) || the_lhs != ".SD") next
+    return(TRUE)
+  }
+  FALSE
+}
+
 # cedta = Calling Environment Data.Table-Aware
 cedta = function(n=2L) {
   # Calling Environment Data Table Aware
@@ -52,14 +60,16 @@ cedta = function(n=2L) {
     return(TRUE)
   }
   nsname = getNamespaceName(ns)
+  sc = sys.calls()
   ans = nsname=="data.table" ||
     "data.table" %chin% names(getNamespaceImports(ns)) ||   # most common and recommended cases first for speed
     (nsname=="utils" &&
       (exists("debugger.look", parent.frame(n+1L)) ||
-      (length(sc<-sys.calls())>=8L && sc[[length(sc)-7L]] %iscall% 'example')) ) || # 'example' for #2972
-    (nsname=="base" && all(c("FUN", "X") %chin% ls(parent.frame(n)))) || # lapply
+      (length(sc)>=8L && sc[[length(sc)-7L]] %iscall% 'example')) ) || # 'example' for #2972
+    (nsname=="base" && # lapply
+      (all(c("FUN", "X") %chin% ls(parent.frame(n))) ||
+      .any_sd_queries_in_stack(sc))) ||
     (nsname %chin% cedta.pkgEvalsUserCode && .any_eval_calls_in_stack()) ||
-    nsname %chin% cedta.override ||
     isTRUE(ns$.datatable.aware) ||  # As of Sep 2018: RCAS, caretEnsemble, dtplyr, rstanarm, rbokeh, CEMiTool, rqdatatable, RImmPort, BPRMeth, rlist
     tryCatch("data.table" %chin% get(".Depends",paste("package",nsname,sep=":"),inherits=FALSE),error=function(e)FALSE)  # both ns$.Depends and get(.Depends,ns) are not sufficient
   if (!ans && getOption("datatable.verbose")) {

R/data.table.R

@@ -221,7 +221,7 @@ replace_dot_alias = function(e) {
     }
     return(x)
   }
-  if (!mult %chin% c("first", "last", "all")) stopf("mult argument can only be 'first', 'last' or 'all'")
+  if (!mult %chin% c("first", "last", "all", "error")) stopf("mult argument can only be 'first', 'last', 'all' or 'error'")
   missingroll = missing(roll)
   if (length(roll)!=1L || is.na(roll)) stopf("roll must be a single TRUE, FALSE, positive/negative integer/double including +Inf and -Inf or 'nearest'")
   if (is.character(roll)) {
@@ -520,6 +520,7 @@ replace_dot_alias = function(e) {
       }
       i = .shallow(i, retain.key = TRUE)
       ans = bmerge(i, x, leftcols, rightcols, roll, rollends, nomatch, mult, ops, verbose=verbose)
+      if (mult == "error") mult = "all" ## error should have been raised inside bmerge() call above already, if it wasn't continue as mult="all"
       xo = ans$xo ## to make it available for further use.
       # temp fix for issue spotted by Jan, test #1653.1. TODO: avoid this
       # 'setorder', as there's another 'setorder' in generating 'irows' below...

R/mergelist.R

@@ -9,7 +9,7 @@ cbindlist_impl_ = function(l, copy) {
 }
 
 cbindlist = function(l) cbindlist_impl_(l, copy=TRUE)
-setcbindlist = function(l) cbindlist_impl_(l, copy=FALSE)
+setcbindlist = function(l) invisible(cbindlist_impl_(l, copy=FALSE))
 
 # when 'on' is missing then use keys, used only for inner and full join
 onkeys = function(x, y) {
@@ -157,9 +157,9 @@ mergepair = function(lhs, rhs, on, how, mult, lhs.cols=names(lhs), rhs.cols=name
         stopf("'on' is missing and necessary key is not present")
     }
     if (any(bad.on <- !on %chin% names(lhs)))
-      stopf("'on' argument specifies columns to join [%s] that are not present in %s table [%s]", brackify(on[bad.on]), "LHS", brackify(names(lhs)))
+      stopf("'on' argument specifies columns to join %s that are not present in %s table %s", brackify(on[bad.on]), "LHS", brackify(names(lhs)))
     if (any(bad.on <- !on %chin% names(rhs)))
-      stopf("'on' argument specifies columns to join [%s] that are not present in %s table [%s]", brackify(on[bad.on]), "RHS", brackify(names(rhs)))
+      stopf("'on' argument specifies columns to join %s that are not present in %s table %s", brackify(on[bad.on]), "RHS", brackify(names(rhs)))
   } else if (is.null(on)) {
     on = character() ## cross join only
   }
@@ -203,7 +203,7 @@ mergepair = function(lhs, rhs, on, how, mult, lhs.cols=names(lhs), rhs.cols=name
     copy_x = TRUE
     ## ensure no duplicated column names in merge results
     if (any(dup.i <- names(out.i) %chin% names(out.x)))
-      stopf("merge result has duplicated column names [%s], use 'cols' argument or rename columns in 'l' tables", brackify(names(out.i)[dup.i]))
+      stopf("merge result has duplicated column names %s, use 'cols' argument or rename columns in 'l' tables", brackify(names(out.i)[dup.i]))
   }
 
   ## stack i and x
@@ -257,6 +257,104 @@ mergepair = function(lhs, rhs, on, how, mult, lhs.cols=names(lhs), rhs.cols=name
   setDT(out)
 }
 
+mergelist_impl_ = function(l, on, cols, how, mult, join.many, copy) {
+  verbose = getOption("datatable.verbose")
+  if (verbose)
+    p = proc.time()[[3L]]
+
+  if (!is.list(l) || is.data.frame(l))
+    stopf("'%s' must be a list", "l")
+  if (!all(vapply_1b(l, is.data.table)))
+    stopf("Every element of 'l' list must be data.table objects")
+  if (!all(idx <- lengths(l) > 0L))
+    stopf("Tables in 'l' must all have columns, but these entries have 0: %s", brackify(which(!idx)))
+  if (any(idx <- vapply_1i(l, function(x) anyDuplicated(names(x))) > 0L))
+    stopf("Column names in individual 'l' entries must be unique, but these have some duplicates: %s", brackify(which(idx)))
+
+  n = length(l)
+  if (n < 2L) {
+    out = if (n) l[[1L]] else as.data.table(l)
+    if (copy) out = copy(out)
+    if (verbose)
+      catf("mergelist: merging %d table(s), took %.3fs\n", n, proc.time()[[3L]]-p)
+    return(out)
+  }
+
+  if (!is.list(join.many))
+    join.many = rep(list(join.many), n - 1L)
+  if (length(join.many) != n - 1L || !all(vapply_1b(join.many, isTRUEorFALSE)))
+    stopf("'join.many' must be TRUE or FALSE, or a list of such whose length must be length(l)-1L")
+
+  if (missing(mult))
+    mult = NULL
+  if (!is.list(mult))
+    mult = rep(list(mult), n - 1L)
+  if (length(mult) != n - 1L || !all(vapply_1b(mult, function(x) is.null(x) || (is.character(x) && length(x) == 1L && !anyNA(x) && x %chin% c("error", "all", "first", "last")))))
+    stopf("'mult' must be one of [error, all, first, last] or NULL, or a list of such whose length must be length(l)-1L")
+
+  if (!is.list(how))
+    how = rep(list(how), n-1L)
+  if (length(how)!=n-1L || !all(vapply_1b(how, function(x) is.character(x) && length(x)==1L && !anyNA(x) && x %chin% c("left", "inner", "full", "right", "semi", "anti", "cross"))))
+    stopf("'how' must be one of [left, inner, full, right, semi, anti, cross], or a list of such whose length must be length(l)-1L")
+
+  if (is.null(cols)) {
+    cols = vector("list", n)
+  } else {
+    if (!is.list(cols))
+      stopf("'%s' must be a list", "cols")
+    if (length(cols) != n)
+      stopf("'cols' must be same length as 'l' (%d != %d)", length(cols), n)
+    skip = vapply_1b(cols, is.null)
+    if (!all(vapply_1b(cols[!skip], function(x) is.character(x) && !anyNA(x) && !anyDuplicated(x))))
+      stopf("'cols' must be a list of non-zero length, non-NA, non-duplicated, character vectors, or eventually NULLs (all columns)")
+    if (any(mapply(function(x, icols) !all(icols %chin% names(x)), l[!skip], cols[!skip])))
+      stopf("'cols' specify columns not present in corresponding table")
+  }
+
+  if (missing(on) || is.null(on)) {
+    on = vector("list", n - 1L)
+  } else {
+    if (!is.list(on))
+      on = rep(list(on), n - 1L)
+    if (length(on) != n-1L || !all(vapply_1b(on, function(x) is.character(x) && !anyNA(x) && !anyDuplicated(x)))) ## length checked in dtmerge
+      stopf("'on' must be non-NA, non-duplicated, character vector, or a list of such which length must be length(l)-1L")
+  }
+
+  l.mem = lapply(l, vapply, address, "")
+  out = l[[1L]]
+  out.cols = cols[[1L]]
+  for (join.i in seq_len(n - 1L)) {
+    rhs.i = join.i + 1L
+    out = mergepair(
+      lhs = out, rhs = l[[rhs.i]],
+      on = on[[join.i]],
+      how = how[[join.i]], mult = mult[[join.i]],
+      lhs.cols = out.cols, rhs.cols = cols[[rhs.i]],
+      copy = FALSE, ## avoid any copies inside, will copy once below
+      join.many = join.many[[join.i]],
+      verbose = verbose
+    )
+    out.cols = copy(names(out))
+  }
+  out.mem = vapply_1c(out, address)
+  if (copy)
+    .Call(CcopyCols, out, colnamesInt(out, names(out.mem)[out.mem %chin% unique(unlist(l.mem, recursive=FALSE))]))
+  if (verbose)
+    catf("mergelist: merging %d tables, took %.3fs\n", n, proc.time()[[3L]] - p)
+  out
+}
+
+mergelist = function(l, on, cols=NULL, how=c("left", "inner", "full", "right", "semi", "anti", "cross"), mult, join.many=getOption("datatable.join.many")) {
+  if (missing(how) || is.null(how))
+    how = match.arg(how)
+  mergelist_impl_(l, on, cols, how, mult, join.many, copy=TRUE)
+}
+setmergelist = function(l, on, cols=NULL, how=c("left", "inner", "full", "right", "semi", "anti", "cross"), mult, join.many=getOption("datatable.join.many")) {
+  if (missing(how) || is.null(how))
+    how = match.arg(how)
+  invisible(mergelist_impl_(l, on, cols, how, mult, join.many, copy=FALSE))
+}
+
 # Previously, we had a custom C implementation here, which is ~2x faster,
 #   but this is fast enough we don't bother maintaining a new routine.
 #   Hopefully in the future rep() can recognize the ALTREP and use that, too.

R/test.data.table.R

@@ -197,7 +197,7 @@ test.data.table = function(script="tests.Rraw", verbose=FALSE, pkg=".", silent=F
     tryCatch(error = function(c) warningf("Attempt to subset to %d tests matching '%s' failed, running full suite.", length(keep_test_ids), testPattern), {
       new_script = file_lines[c(header_lines, keep_lines)]
       parse(text = new_script) # as noted above the static approach is not fool-proof (yet?), so force the script to at least parse before continuing.
-      fn = tempfile()
+      fn = setNames(tempfile(), names(fn))
       on.exit(unlink(fn), add=TRUE)
       catf("Running %d of %d tests matching '%s'\n", length(keep_test_ids), nrow(test_calls), testPattern)
       writeLines(new_script, fn)

R/utils.R

@@ -86,7 +86,7 @@ which.last = function(x)
   if (!is.logical(x)) {
     stopf("x not boolean")
   }
-  length(x) - match(TRUE, rev(x)) + 1L
+  length(x) - match(TRUE, frev(x)) + 1L
 }
 
 require_bit64_if_needed = function(DT) {
@@ -226,7 +226,7 @@ fctr = function(x, levels=unique(x), ..., sort=FALSE, rev=FALSE) {
   if (!isTRUEorFALSE(rev))
     stopf("argument 'rev' must be TRUE or FALSE")
   if (sort) levels = sort(levels)
-  if (rev) levels = rev(levels)
+  if (rev) levels = frev(levels)
   factor(x, levels=levels, ...)
 }