From 9c0eedb2cc92d197985461484d1b228c36b172e8 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 19 Mar 2026 06:34:11 +0000 Subject: [PATCH 1/8] Attempt S4 dispatch for intersect(), maybe --- NAMESPACE | 2 ++ R/bit64-package.R | 2 +- R/setops64.R | 6 +++++- tests/testthat/test-setops64.R | 22 ++++++++++++++++++++++ 4 files changed, 30 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index d80abdf4..a1a499a7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -329,6 +329,8 @@ importFrom(graphics,par) importFrom(graphics,title) importFrom(methods,as) importFrom(methods,is) +importFrom(methods,isGeneric) +importFrom(methods,selectMethod) importFrom(stats,cor) importFrom(stats,median) importFrom(stats,quantile) diff --git a/R/bit64-package.R b/R/bit64-package.R index dbac467a..e6937154 100644 --- a/R/bit64-package.R +++ b/R/bit64-package.R @@ -704,7 +704,7 @@ #' ramsort ramsortorder repeat.time setattr shellorder shellsort #' shellsortorder still.identical #' @importFrom graphics barplot par title -#' @importFrom methods as is +#' @importFrom methods as is isGeneric selectMethod #' @importFrom stats cor median quantile #' @importFrom utils head packageDescription strOptions tail getS3method #' @export : %in% is.double match order print.cache rank diff --git a/R/setops64.R b/R/setops64.R index 78deb9ab..ed93582f 100644 --- a/R/setops64.R +++ b/R/setops64.R @@ -62,7 +62,11 @@ intersect = function(x, y) { if (is.null(x) || is.null(y)) return(NULL) if (!(is.integer64(x) || is.integer64(y))) return(base::intersect(x, y)) - + if ((isS4(x) || isS4(y)) && isGeneric("intersect")) { + s4_intersect = selectMethod("intersect", list(x=class(x), y=class(y))) + return(s4_intersect(x, y)) + } + target_class = target_class(list(x, y)) x = unique(x) class_x = class(x)[1L] diff --git a/tests/testthat/test-setops64.R b/tests/testthat/test-setops64.R index 91c6ccb9..73a08bd3 100644 --- a/tests/testthat/test-setops64.R +++ b/tests/testthat/test-setops64.R @@ -320,3 +320,25 @@ test_that("is.element works (additional cases)", { expect_true(is.element(NA_integer64_, NA)) }) + +test_that("S4 dispatch still happens for classes extending integer64 (#301)", { + delete_generic = !methods::isGeneric("intersect") + methods::setClass("TestS4", representation(data="integer")) + suppressMessages(methods::setGeneric("intersect")) + methods::setMethod( + "intersect", + signature=c("TestS4", "integer64"), + function(x, y) "Successfully routed to S4 method!" + ) + withr::defer({ + methods::removeMethod("intersect", signature=c("TestS4", "integer64")) + methods::removeClass("TestS4") + if (delete_generic) methods::removeGeneric("intersect") + }) + + # Instantiate test objects + x = methods::new("TestS4", data = 1L) + y = as.integer64(2L) + + expect_identical(intersect(x, y), "Successfully routed to S4 method!") +}) From f9ec364ecf699c8398f3da6683621f2d46f42b2d Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 18 Mar 2026 23:41:27 -0700 Subject: [PATCH 2/8] rearrange --- R/setops64.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/setops64.R b/R/setops64.R index ed93582f..21062ec3 100644 --- a/R/setops64.R +++ b/R/setops64.R @@ -60,12 +60,12 @@ union = function(x, y) { #' @rdname sets intersect = function(x, y) { if (is.null(x) || is.null(y)) return(NULL) - if (!(is.integer64(x) || is.integer64(y))) - return(base::intersect(x, y)) if ((isS4(x) || isS4(y)) && isGeneric("intersect")) { s4_intersect = selectMethod("intersect", list(x=class(x), y=class(y))) return(s4_intersect(x, y)) } + if (!(is.integer64(x) || is.integer64(y))) + return(base::intersect(x, y)) target_class = target_class(list(x, y)) x = unique(x) From 7f4902adb4ad77d809ad2ac0363b0e7f96668b0c Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 18 Mar 2026 23:44:08 -0700 Subject: [PATCH 3/8] corresponding test --- tests/testthat/test-setops64.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/tests/testthat/test-setops64.R b/tests/testthat/test-setops64.R index 73a08bd3..fe458352 100644 --- a/tests/testthat/test-setops64.R +++ b/tests/testthat/test-setops64.R @@ -341,4 +341,10 @@ test_that("S4 dispatch still happens for classes extending integer64 (#301)", { y = as.integer64(2L) expect_identical(intersect(x, y), "Successfully routed to S4 method!") + # NB: nanoival class is "complex64" -- it kludges complex to be a pair + # of integer64 vectors, but there is no complex64 class, so it just + # shows up on the inheritance chain as 'complex' --> need to ensure + # S4 gets invoked when possible even if the inputs don't directly test + # as being is("integer64"). + expect_identical(intersect(x, x), "Successfully routed to S4 method!") }) From 9b5a9e7700b9aa8ea8b532437bb6d7e5083a92d0 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 18 Mar 2026 23:46:23 -0700 Subject: [PATCH 4/8] nanotime uses union(), too --- R/setops64.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/setops64.R b/R/setops64.R index 21062ec3..15e00d8f 100644 --- a/R/setops64.R +++ b/R/setops64.R @@ -31,6 +31,10 @@ #' @export #' @rdname sets union = function(x, y) { + if ((isS4(x) || isS4(y)) && isGeneric("union")) { + s4_intersect = selectMethod("union", list(x=class(x), y=class(y))) + return(s4_intersect(x, y)) + } if (!(is.integer64(x) || is.integer64(y))) return(base::union(x, y)) From d556d212ef157901d22bad5b15b54468c453e047 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 18 Mar 2026 23:49:19 -0700 Subject: [PATCH 5/8] tests for union --- tests/testthat/test-setops64.R | 41 +++++++++++++++++++++++++++++++++- 1 file changed, 40 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-setops64.R b/tests/testthat/test-setops64.R index fe458352..7ef1bdf1 100644 --- a/tests/testthat/test-setops64.R +++ b/tests/testthat/test-setops64.R @@ -322,7 +322,46 @@ test_that("is.element works (additional cases)", { }) test_that("S4 dispatch still happens for classes extending integer64 (#301)", { - delete_generic = !methods::isGeneric("intersect") + methods::setClass("TestS4", representation(data="integer")) + delete_intersect_generic = !methods::isGeneric("intersect") + suppressMessages(methods::setGeneric("intersect")) + delete_union_generic = !methods::isGeneric("union") + suppressMessages(methods::setGeneric("union")) + methods::setMethod( + "intersect", + signature=c("TestS4", "integer64"), + function(x, y) "Successfully routed to S4 method!" + ) + methods::setMethod( + "union", + signature=c("TestS4", "integer64"), + function(x, y) "Successfully routed to S4 method!" + ) + withr::defer({ + methods::removeMethod("union", signature=c("TestS4", "integer64")) + methods::removeMethod("intersect", signature=c("TestS4", "integer64")) + methods::removeClass("TestS4") + if (delete_intersect_generic) methods::removeGeneric("intersect") + if (delete_union_generic) methods::removeGeneric("union") + }) + + # Instantiate test objects + x = methods::new("TestS4", data = 1L) + y = as.integer64(2L) + + expect_identical(intersect(x, y), "Successfully routed to S4 method!") + expect_identical(union(x, y), "Successfully routed to S4 method!") + # NB: nanoival class is "complex64" -- it kludges complex to be a pair + # of integer64 vectors, but there is no complex64 class, so it just + # shows up on the inheritance chain as 'complex' --> need to ensure + # S4 gets invoked when possible even if the inputs don't directly test + # as being is("integer64"). + expect_identical(intersect(x, x), "Successfully routed to S4 method!") + expect_identical(union(x, x), "Successfully routed to S4 method!") +}) + +test_that("S4 dispatch still happens for classes extending integer64 (#301, union)", { + delete_generic = !methods::isGeneric("union") methods::setClass("TestS4", representation(data="integer")) suppressMessages(methods::setGeneric("intersect")) methods::setMethod( From 8d07b7b2806018a68c4d41d13a8df8dc0b8deb36 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 18 Mar 2026 23:49:44 -0700 Subject: [PATCH 6/8] (rm unneeded) --- tests/testthat/test-setops64.R | 28 ---------------------------- 1 file changed, 28 deletions(-) diff --git a/tests/testthat/test-setops64.R b/tests/testthat/test-setops64.R index 7ef1bdf1..497458a7 100644 --- a/tests/testthat/test-setops64.R +++ b/tests/testthat/test-setops64.R @@ -359,31 +359,3 @@ test_that("S4 dispatch still happens for classes extending integer64 (#301)", { expect_identical(intersect(x, x), "Successfully routed to S4 method!") expect_identical(union(x, x), "Successfully routed to S4 method!") }) - -test_that("S4 dispatch still happens for classes extending integer64 (#301, union)", { - delete_generic = !methods::isGeneric("union") - methods::setClass("TestS4", representation(data="integer")) - suppressMessages(methods::setGeneric("intersect")) - methods::setMethod( - "intersect", - signature=c("TestS4", "integer64"), - function(x, y) "Successfully routed to S4 method!" - ) - withr::defer({ - methods::removeMethod("intersect", signature=c("TestS4", "integer64")) - methods::removeClass("TestS4") - if (delete_generic) methods::removeGeneric("intersect") - }) - - # Instantiate test objects - x = methods::new("TestS4", data = 1L) - y = as.integer64(2L) - - expect_identical(intersect(x, y), "Successfully routed to S4 method!") - # NB: nanoival class is "complex64" -- it kludges complex to be a pair - # of integer64 vectors, but there is no complex64 class, so it just - # shows up on the inheritance chain as 'complex' --> need to ensure - # S4 gets invoked when possible even if the inputs don't directly test - # as being is("integer64"). - expect_identical(intersect(x, x), "Successfully routed to S4 method!") -}) From cf211e984a9f8a13fef9175121948640f0fbbcb9 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 18 Mar 2026 23:51:47 -0700 Subject: [PATCH 7/8] also setdiff --- R/setops64.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/setops64.R b/R/setops64.R index 15e00d8f..786ad0c0 100644 --- a/R/setops64.R +++ b/R/setops64.R @@ -37,7 +37,7 @@ union = function(x, y) { } if (!(is.integer64(x) || is.integer64(y))) return(base::union(x, y)) - + target_class = target_class(list(x, y)) # try using the benefit of integer64 caching, if possible. I.e. call unique() before as(). x = unique(x) @@ -117,6 +117,10 @@ setequal = function(x, y) { #' @export #' @rdname sets setdiff = function(x, y) { + if ((isS4(x) || isS4(y)) && isGeneric("setdiff")) { + s4_intersect = selectMethod("setdiff", list(x=class(x), y=class(y))) + return(s4_intersect(x, y)) + } if (!(is.integer64(x) || is.integer64(y))) return(base::setdiff(x, y)) From e11898f3f276321258ebdab6f7fd2d7d25890647 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 18 Mar 2026 23:53:09 -0700 Subject: [PATCH 8/8] setdiff tests --- tests/testthat/test-setops64.R | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-setops64.R b/tests/testthat/test-setops64.R index 497458a7..a3386d6d 100644 --- a/tests/testthat/test-setops64.R +++ b/tests/testthat/test-setops64.R @@ -323,10 +323,14 @@ test_that("is.element works (additional cases)", { test_that("S4 dispatch still happens for classes extending integer64 (#301)", { methods::setClass("TestS4", representation(data="integer")) + delete_intersect_generic = !methods::isGeneric("intersect") suppressMessages(methods::setGeneric("intersect")) delete_union_generic = !methods::isGeneric("union") suppressMessages(methods::setGeneric("union")) + delete_setdiff_generic = !methods::isGeneric("setdiff") + suppressMessages(methods::setGeneric("setdiff")) + methods::setMethod( "intersect", signature=c("TestS4", "integer64"), @@ -337,12 +341,19 @@ test_that("S4 dispatch still happens for classes extending integer64 (#301)", { signature=c("TestS4", "integer64"), function(x, y) "Successfully routed to S4 method!" ) + methods::setMethod( + "setdiff", + signature=c("TestS4", "integer64"), + function(x, y) "Successfully routed to S4 method!" + ) withr::defer({ + methods::removeMethod("setdiff", signature=c("TestS4", "integer64")) methods::removeMethod("union", signature=c("TestS4", "integer64")) methods::removeMethod("intersect", signature=c("TestS4", "integer64")) methods::removeClass("TestS4") - if (delete_intersect_generic) methods::removeGeneric("intersect") + if (delete_setdiff_generic) methods::removeGeneric("setdiff") if (delete_union_generic) methods::removeGeneric("union") + if (delete_intersect_generic) methods::removeGeneric("intersect") }) # Instantiate test objects @@ -351,6 +362,7 @@ test_that("S4 dispatch still happens for classes extending integer64 (#301)", { expect_identical(intersect(x, y), "Successfully routed to S4 method!") expect_identical(union(x, y), "Successfully routed to S4 method!") + expect_identical(setdiff(x, y), "Successfully routed to S4 method!") # NB: nanoival class is "complex64" -- it kludges complex to be a pair # of integer64 vectors, but there is no complex64 class, so it just # shows up on the inheritance chain as 'complex' --> need to ensure @@ -358,4 +370,5 @@ test_that("S4 dispatch still happens for classes extending integer64 (#301)", { # as being is("integer64"). expect_identical(intersect(x, x), "Successfully routed to S4 method!") expect_identical(union(x, x), "Successfully routed to S4 method!") + expect_identical(setdiff(x, x), "Successfully routed to S4 method!") })