all.equal.data.table: sub-aggregate before comparison

NEWS.md

@@ -50,6 +50,8 @@
 
 14. `nafill()` and `setnafill()` gain a `limit` argument to restrict the maximum number of consecutive `NA` values filled, [#7677](https://github.com/Rdatatable/data.table/issues/7677). Thanks to @jaynewton for the suggestion and @venom1204 and @ben-schwen for the PR.
 
+15. `all.equal()` for `data.table` gains `by` and `fun.aggregate` arguments to allow sub-aggregating datasets before comparison, [#7890](https://github.com/Rdatatable/data.table/issues/7890). This is useful for comparing datasets at different levels of granularity (e.g., comparing raw data to a summary table). Defaults to `fun.aggregate=sum`. Thanks to @jangorecki for the suggestion and @venom1204 implementation.
+
 ### BUG FIXES
 
 1. `fread()` with `skip=0` and `(header=TRUE|FALSE)` no longer skips the first row when it has fewer fields than subsequent rows, [#7463](https://github.com/Rdatatable/data.table/issues/7463). Thanks @emayerhofer for the report and @ben-schwen for the fix.

R/setops.R

@@ -106,15 +106,22 @@ fsetequal = function(x, y, all=TRUE) {
 
 # all.equal ----
 
-all.equal.data.table = function(target, current, trim.levels=TRUE, check.attributes=TRUE, ignore.col.order=FALSE, ignore.row.order=FALSE, tolerance=sqrt(.Machine$double.eps), ...) {
-  stopifnot(is.logical(trim.levels), is.logical(check.attributes), is.logical(ignore.col.order), is.logical(ignore.row.order), is.numeric(tolerance), is.data.table(target))
+all.equal.data.table = function(target, current, trim.levels=TRUE, check.attributes=TRUE, ignore.col.order=FALSE, ignore.row.order=FALSE, tolerance=sqrt(.Machine$double.eps), by=NULL, fun.aggregate=sum, ...) {
+  stopifnot(is.logical(trim.levels), is.logical(check.attributes), is.logical(ignore.col.order), is.logical(ignore.row.order), is.numeric(tolerance), is.data.table(target), is.function(fun.aggregate))
 
   if (!is.data.table(current)) {
     if (check.attributes) return(paste0('target is data.table, current is ', data.class(current)))
     try({current = as.data.table(current)}, silent = TRUE)
     if (!is.data.table(current)) return('target is data.table but current is not and failed to be coerced to it')
   }
 
+  if (!is.null(by)) {
+    target = target[, lapply(.SD, fun.aggregate), by=by]
+    current = current[, lapply(.SD, fun.aggregate), by=by]
+    setkeyv(target, by)
+    setkeyv(current, by)
+  }
+
   msg = character(0L)
   # init checks that detect high level all.equal
   if (nrow(current) != nrow(target)) msg = "Different number of rows"

inst/tests/tests.Rraw

@@ -22011,3 +22011,10 @@ test(2388.21, nafill(c(1, NA, NA, 5), type="nocb", limit=1, nan=NaN), c(1, NA, 5
 test(2388.22, nafill(c(1L, NA, NA, 5L), type="nocb", limit=1), c(1L, NA, 5L, 5L))
 test(2388.23, nafill(c("a", NA, NA), type="const", fill="x", limit=1), c("a", "x", NA))
 test(2388.24, nafill(c("a", NA, NA, "z"), type="nocb", limit=1), c("a", NA, "z", "z"))
+
+# all.equal() could sub-aggregate before comparison #7890
+test(2389.01, all.equal(data.table(a = 1:2, b = c(1, 2)), data.table(a = c(1:2, 2L), b = c(1, 1, 1)), by = "a"), TRUE)
+test(2389.02, all.equal(data.table(a = c(1:2, 2L), b = c(1, 1, 1)), data.table(a = 1:2, b = c(1, 2)), by = "a"), TRUE)
+test(2389.03, all.equal(data.table(a = c(1, 1, 2, 2), b = c(1, 1, 1, 1)), data.table(a = c(1, 2), b = c(2, 2)), by = "a"), TRUE)
+test(2389.04, all.equal(data.table(a = c(1, 1, 1, 2), b = c("x", "x", "y", "x"), value = c(1, 2, 3, 4)), data.table(a = c(1, 1, 2), b = c("x", "y", "x"), value = c(3, 3, 4)), by = c("a", "b")), TRUE)
+test(2389.05, isTRUE(all.equal(data.table(a = c(1, 1, 2), b = c(1, 2, 3)), data.table(a = c(1, 2), b = c(99, 3)), by = "a")), FALSE)

man/all.equal.data.table.Rd

@@ -9,7 +9,7 @@
 \usage{
   \method{all.equal}{data.table}(target, current, trim.levels=TRUE, check.attributes=TRUE,
     ignore.col.order=FALSE, ignore.row.order=FALSE, tolerance=sqrt(.Machine$double.eps),
-    \dots)
+    by=NULL, fun.aggregate=sum, \dots)
 }
 
 \arguments{
@@ -39,6 +39,14 @@
     A numeric value used when comparing numeric columns, by default \code{sqrt(.Machine$double.eps)}. Unless non-default value provided it will be forced to \code{0} if used together with \code{ignore.row.order} and duplicate rows detected or factor columns present.
   }
 
+  \item{by}{
+    A character vector of column names to group and sub-aggregate both \code{target} and \code{current} before comparison.
+  }
+
+  \item{fun.aggregate}{
+    A function to use for aggregation when \code{by} is provided. Defaults to \code{sum}.
+  }
+
   \item{\dots}{
     Passed down to internal call of \code{\link[base]{all.equal}}.
   }
@@ -91,5 +99,10 @@ y <- data.table(A = factor(letters[1:5])[1:4]) # 5 levels
 all.equal(x, y, trim.levels = FALSE)
 all.equal(x, y, trim.levels = FALSE, check.attributes = FALSE)
 all.equal(x, y)
+
+# sub-aggregation before comparison
+d1 = data.table(a = 1:2, b=c(1,2))
+d2 = data.table(a = c(1:2,2L), b=c(1,1,1))
+all.equal(d1, d2, by = "a") # Returns TRUE
 }