diff --git a/NEWS.md b/NEWS.md index 6756f1edd..9e738932a 100644 --- a/NEWS.md +++ b/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. diff --git a/R/setops.R b/R/setops.R index 4ae78b193..ca4deb7e4 100644 --- a/R/setops.R +++ b/R/setops.R @@ -106,8 +106,8 @@ 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))) @@ -115,6 +115,13 @@ all.equal.data.table = function(target, current, trim.levels=TRUE, check.attribu 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" diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index 78123b73f..c34890f33 100644 --- a/inst/tests/tests.Rraw +++ b/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) diff --git a/man/all.equal.data.table.Rd b/man/all.equal.data.table.Rd index 8afac5125..4deda38ce 100644 --- a/man/all.equal.data.table.Rd +++ b/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 }