Merge branch 'master' into issue6964

Author: venom1204

R/data.table.R

@@ -545,7 +545,7 @@ replace_dot_alias = function(e) {
           if (allLen1) {
             irows = f__
           } else {
-            join.many = isTRUE(getOption("datatable.join.many", TRUE)) # #914, default TRUE for backward compatibility
+            join.many = isTRUE(getOption("datatable.join.many")) # #914, default TRUE for backward compatibility
             anyDups = !notjoin &&
               (
                 # #698. When notjoin=TRUE, ignore allow.cartesian. Rows in answer will never be > nrow(x).

R/mergelist.R

@@ -143,6 +143,120 @@ dtmerge = function(x, i, on, how, mult, join.many, void=FALSE, verbose) {
   list(ans=ans, irows=irows, xrows=xrows)
 }
 
+# atomic join between two tables
+mergepair = function(lhs, rhs, on, how, mult, lhs.cols=names(lhs), rhs.cols=names(rhs), copy=TRUE, join.many=TRUE, verbose=FALSE) {
+  semi_or_anti = how == "semi" || how == "anti"
+  inner_or_full = how == "inner" || how == "full"
+
+  if (how != "cross") {
+    if (is.null(on)) {
+      if (how == "left" || semi_or_anti) on = key(rhs)
+      else if (how == "right") on = key(lhs)
+      else if (inner_or_full) on = onkeys(key(lhs), key(rhs))
+      if (is.null(on))
+        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)))
+    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)))
+  } else if (is.null(on)) {
+    on = character() ## cross join only
+  }
+
+  ## join-to and join-from tables and columns (right outer join-->swap)
+  if (how != "right") {
+    join_from = lhs; from_cols = lhs.cols; join_to = rhs; to_cols = rhs.cols
+  } else {
+    join_from = rhs; from_cols = rhs.cols; join_to = lhs; to_cols = lhs.cols
+  }
+
+  ## ensure symmetric join for inner|full join, apply mult on both tables, bmerge do only 'x' table
+  copy_i = FALSE ## copy marker of out.i
+  if (inner_or_full && !is.null(mult) && (mult == "first" || mult == "last")) {
+    join_from = fdistinct(join_from, on=on, mult=mult, cols=from_cols, copy=FALSE) ## might not copy when already unique by 'on'
+    copy_i = nrow(join_from) != nrow(lhs) ## nrow(lhs) bc how='inner|full' so join_from=lhs
+  } else if (how == "inner" && (is.null(mult) || mult == "error")) { ## we do this branch only to raise error from bmerge, we cannot use forder to just find duplicates because those duplicates might not have matching rows in another table, full join checks mult='error' during two non-void bmerges
+    dtmerge(x=join_from, i=join_to, on=on, how=how, mult=mult, verbose=verbose, join.many=join.many, void=TRUE)
+  }
+
+  ## binary merge
+  ans = dtmerge(x=join_to, i=join_from, on=on, how=how, mult=mult, verbose=verbose, join.many=join.many)
+
+  ## make i side; avoid subsetting if possible
+  cols_i = someCols(join_from, from_cols, keep=on, retain.order=semi_or_anti)
+  if (is.null(ans$irows)) {
+    out.i = .shallow(join_from, cols=cols_i, retain.key=TRUE)
+  } else {
+    out.i = .Call(CsubsetDT, join_from, ans$irows, cols_i)
+    copy_i = TRUE
+  }
+
+  ## make x side
+  copy_x = TRUE
+  if (semi_or_anti) {
+    out.x = list()
+  } else {
+    if (is.null(ans$xrows)) ## as of now xrows cannot be NULL #4409 thus nocov below
+      internal_error("dtmerge()$xrows returned NULL, #4409 been resolved but related code has not been updated?") # nocov
+    out.x = .Call(CsubsetDT, join_to, ans$xrows, someCols(join_to, to_cols, drop=on))
+    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]))
+  }
+
+  ## stack i and x
+  if (how != "full") {
+    if (!copy_i && copy) out.i = copy(out.i)
+    #if (!copy_x && copy) out.x = copy(out.x) ## as of now copy_x always TRUE, search for #4409 here
+    out = .Call(Ccbindlist, list(out.i, out.x), FALSE)
+    if (how == "right") setcolorder(out, neworder=c(on, names(out.x))) ## arrange columns: i.on, x.cols, i.cols
+  } else { # how=="full"
+    ## we made left join side above, proceed to right join side, so swap tbls
+    join_from = rhs; from_cols = rhs.cols; join_to = lhs; to_cols = lhs.cols
+
+    copy_r = FALSE
+    if (!is.null(mult) && (mult == "first" || mult == "last")) {
+      join_from = fdistinct(join_from, on=on, mult=mult, cols=from_cols, copy=FALSE)
+      copy_r = nrow(join_from) != nrow(rhs) ## nrow(rhs) bc join_from=rhs
+    } ## mult=="error" check was made on one side already, below we do on the second side, test 101.43
+
+    ## binary merge anti join; only need to keep 'irows'
+    mult = if (!is.null(mult) && mult != "all") mult
+    supplement_rows = dtmerge(x=join_to, i=join_from, on=on, how="anti", mult=mult, verbose=verbose, join.many=join.many)$irows
+
+    ## make anti join side
+    cols_r = someCols(join_from, from_cols, keep=on)
+    if (is.null(supplement_rows)) {
+      out.r = .shallow(join_from, cols=cols_r, retain.key=TRUE) ## retain.key is used only in the edge case when !nrow(out.i)
+    } else {
+      out.r = .Call(CsubsetDT, join_from, supplement_rows, cols_r)
+      copy_r = TRUE
+    }
+
+    ## short circuit to avoid rbindlist to empty sets and retains keys
+    if (!nrow(out.r)) { ## possibly also !nrow(out.i)
+      if (!copy_i && copy) out.i = copy(out.i)
+      #if (!copy_x && copy) out.x = copy(out.x) ## as of now copy_x always TRUE, search for #4409 here
+      out = .Call(Ccbindlist, list(out.i, out.x), FALSE)
+    } else if (!nrow(out.i)) { ## but not !nrow(out.r)
+      if (!copy_r && copy) out.r = copy(out.r)
+      if (length(add <- setdiff(names(out.i), names(out.r)))) { ## add missing columns of proper types NA
+        neworder = copy(names(out.i)) #set(out.r, NULL, add, lapply(unclass(out.i)[add], `[`, 1L)) ## 291.04 overalloc exceed fail during set()
+        out.i = lapply(unclass(out.i)[add], `[`, seq_len(nrow(out.r))) ## could eventually remove this when cbindlist recycle 0 rows up, note that we need out.r not to be copied
+        out.r = .Call(Ccbindlist, list(out.r, out.i), FALSE)
+        setcolorder(out.r, neworder=neworder)
+      }
+      out = out.r
+    } else { ## all might have not been copied yet, rbindlist will copy
+      out.l = .Call(Ccbindlist, list(out.i, out.x), FALSE)
+      out = rbindlist(list(out.l, out.r), use.names=TRUE, fill=TRUE)
+    }
+  }
+  setDT(out)
+}
+
 # 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/onLoad.R

@@ -84,6 +84,7 @@
        "datatable.print.trunc.cols"="FALSE",   # for print.data.table
        "datatable.show.indices"="FALSE",       # for print.data.table
        "datatable.allow.cartesian"="FALSE",    # datatable.<argument name>
+       "datatable.join.many"="TRUE",           # mergelist, [.data.table #4383 #914
        "datatable.dfdispatchwarn"="TRUE",                   # not a function argument
        "datatable.warnredundantby"="TRUE",                  # not a function argument
        "datatable.alloccol"="1024L",           # argument 'n' of alloc.col. Over-allocate 1024 spare column slots