From 7a3713ea240cfe08e8f130747a0fd69f3b760b83 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 21 Oct 2024 15:41:31 -0500 Subject: [PATCH 1/4] Add some explicit integer64 support Fixes #159 --- DESCRIPTION | 1 + NEWS.md | 1 + R/compare-value.R | 2 +- R/compare.R | 6 ++++- R/num_equal.R | 9 +++++-- R/utils.R | 10 +++++++- tests/testthat/_snaps/compare.md | 44 ++++++++++++++++++++++++++------ tests/testthat/test-compare.R | 18 +++++++++++++ 8 files changed, 78 insertions(+), 13 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index cb09e72..758090d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -21,6 +21,7 @@ Imports: methods, rlang (>= 1.0.0) Suggests: + bit64, R6, S7, testthat (>= 3.0.0), diff --git a/NEWS.md b/NEWS.md index 86a7e8e..d73eefa 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # waldo (development version) +* `compare()` can numeric differences between int64 objects and integers/doubles when `tolerance` is set (#159). * waldo gains basic support for S7 objects (#200). * `as_map()` now preserves attributes (#185). * `compare()` can now distinguish between objects that differ only in the value of their S4 bit (#189). diff --git a/R/compare-value.R b/R/compare-value.R index 4272237..64c7a6c 100644 --- a/R/compare-value.R +++ b/R/compare-value.R @@ -1,7 +1,7 @@ compare_vector <- function(x, y, paths = c("x", "y"), opts = compare_opts()) { # Early exit for numerics (except for) with format methods - if (typeof(x) %in% c("integer", "double") && num_equal(x, y, opts$tolerance)) { + if (is_numeric(x) && num_equal(x, y, opts$tolerance)) { return() } diff --git a/R/compare.R b/R/compare.R index 3ccae24..e701dee 100644 --- a/R/compare.R +++ b/R/compare.R @@ -231,6 +231,10 @@ compare_structure <- function(x, y, paths = c("x", "y"), opts = compare_opts()) y <- zap_srcref(y) } + if (compare_as_numeric(x, y, opts$tolerance)) { + opts$ignore_attr <- union(opts$ignore_attr, "class") + } + out <- c(out, compare_by_attr(attrs(x, opts$ignore_attr), attrs(y, opts$ignore_attr), paths, opts)) } @@ -391,7 +395,7 @@ compare_terminate <- function(x, y, paths, return(character()) } - if (!is.null(tolerance) && is_numeric(x) && is_numeric(y)) { + if (compare_as_numeric(x, y, tolerance)) { return(character()) } diff --git a/R/num_equal.R b/R/num_equal.R index 4be3694..8c4194e 100644 --- a/R/num_equal.R +++ b/R/num_equal.R @@ -10,8 +10,13 @@ num_equal <- function(x, y, tolerance = default_tol()) { return(FALSE) } - attributes(x) <- NULL - attributes(y) <- NULL + if (is_int64(x) || is_int64(y)) { + x <- bit64::as.integer64(x) + y <- bit64::as.integer64(y) + } else { + attributes(x) <- NULL + attributes(y) <- NULL + } same <- is.na(x) | x == y if (is.null(tolerance)) { diff --git a/R/utils.R b/R/utils.R index 4a69a13..cc4afaa 100644 --- a/R/utils.R +++ b/R/utils.R @@ -108,7 +108,15 @@ attrs <- function(x, ignore) { out[c(first, rest)] } -is_numeric <- function(x) is_integer(x) || is_double(x) +compare_as_numeric <- function(x, y, tol) { + !is.null(tol) && is_numeric(x) && is_numeric(y) +} +is_numeric <- function(x) { + is_integer(x) || is_double(x) || is_int64(x) +} +is_int64 <- function(x) { + inherits(x, "integer64") +} in_ci <- function() { isTRUE(as.logical(Sys.getenv("CI", "FALSE"))) diff --git a/tests/testthat/_snaps/compare.md b/tests/testthat/_snaps/compare.md index 1c379b4..f253d94 100644 --- a/tests/testthat/_snaps/compare.md +++ b/tests/testthat/_snaps/compare.md @@ -184,6 +184,34 @@ `old` is an S3 object of class , a double vector `new` is an integer vector (1) +# can compare int64 with numbers + + Code + compare(int64_1, int64_1) + Output + v No differences + Code + compare(int64_0, int64_1) + Output + `old`: "0" + `new`: "1" + +# can ignore numeric differences between int64 and other numbers + + Code + compare(1, int64_1) + Output + `old` is a double vector (1) + `new` is an S3 object of class , a double vector + Code + compare(1, int64_1, tolerance = 0) + Output + v No differences + Code + compare(1L, int64_1, tolerance = 0) + Output + v No differences + # ignores S3 [[ methods Code @@ -404,17 +432,17 @@ # Different body compare(f3, f1, ignore_srcref = FALSE) Output - `attr(old, 'srcref')`: 207 9 209 3 9 3 207 209 - `attr(new, 'srcref')`: 203 15 205 3 15 3 203 205 + `attr(old, 'srcref')`: 225 9 227 3 9 3 225 227 + `attr(new, 'srcref')`: 221 15 223 3 15 3 221 223 - `attr(body(old), 'srcref')[[1]]`: 207 20 207 20 20 20 207 207 - `attr(body(new), 'srcref')[[1]]`: 203 26 203 26 26 26 203 203 + `attr(body(old), 'srcref')[[1]]`: 225 20 225 20 20 20 225 225 + `attr(body(new), 'srcref')[[1]]`: 221 26 221 26 26 26 221 221 - `attr(body(old), 'srcref')[[2]]`: 208 5 208 9 5 9 208 208 - `attr(body(new), 'srcref')[[2]]`: 204 5 204 9 5 9 204 204 + `attr(body(old), 'srcref')[[2]]`: 226 5 226 9 5 9 226 226 + `attr(body(new), 'srcref')[[2]]`: 222 5 222 9 5 9 222 222 - `attr(body(old), 'wholeSrcref')`: 1 0 209 3 0 3 1 209 - `attr(body(new), 'wholeSrcref')`: 1 0 205 3 0 3 1 205 + `attr(body(old), 'wholeSrcref')`: 1 0 227 3 0 3 1 227 + `attr(body(new), 'wholeSrcref')`: 1 0 223 3 0 3 1 223 `body(old)`: `{` ` 1 + 3` `}` `body(new)`: `{` ` 1 + 2` `}` diff --git a/tests/testthat/test-compare.R b/tests/testthat/test-compare.R index 7e83eb9..9dd56f2 100644 --- a/tests/testthat/test-compare.R +++ b/tests/testthat/test-compare.R @@ -96,6 +96,24 @@ test_that("can ignore minor numeric differences", { expect_equal(compare_structure(x, x + 1e-9, opts = compare_opts(tolerance = 1e-6)), character()) }) +test_that("can compare int64s", { + int64_0 <- bit64::as.integer64(0) + int64_1 <- bit64::as.integer64(1) + expect_snapshot({ + compare(int64_1, int64_1) + compare(int64_0, int64_1) + }) +}) + +test_that("can ignore numeric differences between int64 and other numbers", { + int64_1 <- bit64::as.integer64(1) + expect_snapshot({ + compare(1, int64_1) + compare(1, int64_1, tolerance = 0) + compare(1L, int64_1, tolerance = 0) + }) +}) + test_that("ignores S3 [[ methods", { expect_snapshot({ x <- as.POSIXlt("2020-01-01") From cd1f38dd754bd810dd6a9e57d6d7df29b7f88284 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Tue, 22 Oct 2024 17:39:52 -0500 Subject: [PATCH 2/4] Check doubles are in range --- R/num_equal.R | 12 ++++++++++-- tests/testthat/test-num_equal.R | 5 +++++ 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/R/num_equal.R b/R/num_equal.R index 8c4194e..9107019 100644 --- a/R/num_equal.R +++ b/R/num_equal.R @@ -11,8 +11,16 @@ num_equal <- function(x, y, tolerance = default_tol()) { } if (is_int64(x) || is_int64(y)) { - x <- bit64::as.integer64(x) - y <- bit64::as.integer64(y) + in_range <- + (!is.double(x) || all(x >= 2^63 & x <= 2^63 - 1)) && + (!is.double(y) || all(y >= 2^63 & y <= 2^63 - 1)) + if (in_range) { + x <- bit64::as.integer64(x) + y <- bit64::as.integer64(y) + } else { + x <- as.double(x) + y <- as.double(y) + } } else { attributes(x) <- NULL attributes(y) <- NULL diff --git a/tests/testthat/test-num_equal.R b/tests/testthat/test-num_equal.R index f29d04e..3d633d1 100644 --- a/tests/testthat/test-num_equal.R +++ b/tests/testthat/test-num_equal.R @@ -36,3 +36,8 @@ test_that("NaN is equal to NA_real_ unless tolerance is NULL", { expect_true(num_equal(NaN, NaN)) expect_true(num_equal(NA_real_, NA_real_)) }) + +test_that("coerce large integers to doubles not int64", { + expect_no_warning(num_equal(36893488147419103232, bit64::as.integer64(1))) + expect_no_warning(num_equal(bit64::as.integer64(1), 36893488147419103232)) +}) From 2b9ce893b62291f02360ea3df69ba62e06f87359 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Tue, 22 Oct 2024 17:46:05 -0500 Subject: [PATCH 3/4] Update snaps --- tests/testthat/_snaps/compare.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/_snaps/compare.md b/tests/testthat/_snaps/compare.md index f253d94..acb0e40 100644 --- a/tests/testthat/_snaps/compare.md +++ b/tests/testthat/_snaps/compare.md @@ -184,7 +184,7 @@ `old` is an S3 object of class , a double vector `new` is an integer vector (1) -# can compare int64 with numbers +# can compare int64s Code compare(int64_1, int64_1) From 83e700981bc8a81d9cbbc6d07ab7c3c5f63be742 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Tue, 22 Oct 2024 17:51:18 -0500 Subject: [PATCH 4/4] ??? --- R/num_equal.R | 6 +++--- tests/testthat/test-num_equal.R | 3 +++ 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/R/num_equal.R b/R/num_equal.R index 9107019..851a041 100644 --- a/R/num_equal.R +++ b/R/num_equal.R @@ -12,9 +12,9 @@ num_equal <- function(x, y, tolerance = default_tol()) { if (is_int64(x) || is_int64(y)) { in_range <- - (!is.double(x) || all(x >= 2^63 & x <= 2^63 - 1)) && - (!is.double(y) || all(y >= 2^63 & y <= 2^63 - 1)) - if (in_range) { + (!is.double(x) || all((x >= 2^63 & x <= 2^63 - 1) | is.na(x))) && + (!is.double(y) || all((y >= 2^63 & y <= 2^63 - 1) | is.na(x))) + if (isTRUE(in_range)) { x <- bit64::as.integer64(x) y <- bit64::as.integer64(y) } else { diff --git a/tests/testthat/test-num_equal.R b/tests/testthat/test-num_equal.R index 3d633d1..5a88a45 100644 --- a/tests/testthat/test-num_equal.R +++ b/tests/testthat/test-num_equal.R @@ -40,4 +40,7 @@ test_that("NaN is equal to NA_real_ unless tolerance is NULL", { test_that("coerce large integers to doubles not int64", { expect_no_warning(num_equal(36893488147419103232, bit64::as.integer64(1))) expect_no_warning(num_equal(bit64::as.integer64(1), 36893488147419103232)) + + expect_no_error(num_equal(NA, bit64::as.integer64(1))) + expect_no_error(num_equal(bit64::as.integer64(1), NA)) })