From fc2a8cb3fee65f507e01192d188a5e0660dd9646 Mon Sep 17 00:00:00 2001 From: Matt Dowle Date: Mon, 9 Apr 2018 14:27:59 -0700 Subject: [PATCH 1/2] Minor improvement by avoiding a level of lapply constructing a list of expressions --- inst/tests/tests.Rraw | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index edf155caa4..45438284c6 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -8844,31 +8844,31 @@ nqjoin_test <- function(x, y, k=1L, test_no, mult="all") { ans } check <- function(x, y, cols, ops, mult="all") { - expr = lapply(1:nrow(y), function(i) { - expr = construct(cols, as.list(y[i, cols, with=FALSE]), ops) - }) - ans = lapply(expr, function(e) { - val = x[eval(e)] - if (!nrow(val)) return(val) - val = if (mult=="first") val[1L] else if (mult=="last") val[.N] else val - }) - rbindlist(ans) + rbindlist(lapply(1:nrow(y), function(i) { + e = construct(cols, as.list(y[i, cols, with=FALSE]), ops) + val = x[eval(e)] + if (!nrow(val) || mult=="all") + val + else if (mult=="first") + val[1L] + else # mult=="last" + val[.N] + })) } nq <- function(x, y, cols, ops, nomatch=0L, mult="all") { - sd_cols = c(paste("x.", cols, sep=""), setdiff(names(x), cols)) - ans = x[y, mget(sd_cols, as.environment(-1)), on = paste(cols, ops, cols, sep=""), allow=TRUE, nomatch=nomatch, mult=mult] + sd_cols = c(paste0("x.", cols), setdiff(names(x), cols)) + ans = x[y, mget(sd_cols, as.environment(-1)), on = paste0(cols, ops, cols), allow=TRUE, nomatch=nomatch, mult=mult] setnames(ans, gsub("^x[.]", "", names(ans))) setcolorder(ans, names(x))[] } for (i in seq_along(runcmb)) { thiscols = runcmb[[i]] thisops = runops[[i]] - # cat("k = ", k, "\ti = ", i, "\t thiscols = [", paste(thiscols,collapse=","), "]\t thisops = [", paste(thisops,collapse=","), "]\t ", sep="") + # cat("k = ", k, "\ti = ", i, "\t thiscols = [", paste0(thiscols,collapse=","), "]\t thisops = [", paste0(thisops,collapse=","), "]\t ", sep="") ans1 = nq(x, y, thiscols, thisops, 0L, mult=mult) ans2 = check(x, y, thiscols, thisops, mult=mult) - test_no = signif(test_no+.001, 7) - test(test_no, all.equal(ans1,ans2,ignore.row.order=TRUE), TRUE) - # if (identical(all.equal(ans1,ans2,ignore.row.order=TRUE), TRUE)) cat("successful\n") else stop("failed\n") + test_no = test_no + .001 + test(test_no, ans1, ans2) } } From bccb2341ca1e1837e60908b71a21c03765eda72a Mon Sep 17 00:00:00 2001 From: Matt Dowle Date: Mon, 9 Apr 2018 15:11:26 -0700 Subject: [PATCH 2/2] Minor simplificaton, plus a gc() in an attempt to free heap earlier as nqjoin tests 1641-1652 run --- inst/tests/tests.Rraw | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index 45438284c6..768369cf6f 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -8839,13 +8839,11 @@ nqjoin_test <- function(x, y, k=1L, test_no, mult="all") { else as.call(list(as.name(ops[[i]]), as.name(cols[[i]]), vals[[i]])) } }) - ans = expr[[1L]] - lapply(expr[-1L], function(e) ans <<- as.call(list(quote(`&`), ans, e))) - ans + Reduce(function(x,y)call("&",x,y), expr) } check <- function(x, y, cols, ops, mult="all") { rbindlist(lapply(1:nrow(y), function(i) { - e = construct(cols, as.list(y[i, cols, with=FALSE]), ops) + e = construct(cols, y[i, ..cols], ops) val = x[eval(e)] if (!nrow(val) || mult=="all") val @@ -8870,6 +8868,7 @@ nqjoin_test <- function(x, y, k=1L, test_no, mult="all") { test_no = test_no + .001 test(test_no, ans1, ans2) } + gc() # attempt to free heap earlier for the 50 nrow(y) tables created and then rbindlist'd in check(), repeated for each of the 91 runcmb } if (TRUE) { # turn off temporarily using FALSE when using valgrind, as very slow