From 974f2c7658edede34e270b203eba5cfb1078c8ec Mon Sep 17 00:00:00 2001 From: hcirellu Date: Thu, 19 Mar 2026 16:09:12 +0100 Subject: [PATCH 1/2] using S4 setMethod to dispatch S4 classes on intersect.integer64 --- NAMESPACE | 15 ++++--- R/setops64.R | 35 +++++++++++++--- man/sets.Rd | 22 +++++----- tests/testthat/test-setops64.R | 76 ++++++++++++++++++++++++++++++++++ 4 files changed, 127 insertions(+), 21 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index d80abdf4..95fec83e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -89,8 +89,10 @@ S3method(hashtab,cache_integer64) S3method(hashuni,cache_integer64) S3method(hashupo,cache_integer64) S3method(identical,integer64) +S3method(intersect,integer64) S3method(is.double,default) S3method(is.double,integer64) +S3method(is.element,integer64) S3method(is.finite,integer64) S3method(is.infinite,integer64) S3method(is.na,integer64) @@ -155,6 +157,8 @@ S3method(rowSums,default) S3method(rowSums,integer64) S3method(scale,integer64) S3method(seq,integer64) +S3method(setdiff,integer64) +S3method(setequal,integer64) S3method(shellorder,integer64) S3method(shellsort,integer64) S3method(shellsortorder,integer64) @@ -182,6 +186,7 @@ S3method(table,default) S3method(table,integer64) S3method(tiepos,integer64) S3method(trunc,integer64) +S3method(union,integer64) S3method(unipos,integer64) S3method(unique,integer64) export("%in%") @@ -228,9 +233,7 @@ export(hashuni) export(hashupo) export(identical.integer64) export(integer64) -export(intersect) export(is.double) -export(is.element) export(is.integer64) export(is.na.integer64) export(jamcache) @@ -271,8 +274,6 @@ export(rowSums) export(runif64) export(seq.integer64) export(setcache) -export(setdiff) -export(setequal) export(sortcache) export(sortfin) export(sortnut) @@ -292,9 +293,13 @@ export(str.integer64) export(sum.integer64) export(table) export(tiepos) -export(union) export(unipos) export(unique.integer64) +exportMethods(intersect) +exportMethods(is.element) +exportMethods(setdiff) +exportMethods(setequal) +exportMethods(union) if (getRversion() >= "4.2.0") S3method(mtfrm,integer64) if (getRversion() >= "4.3.0") S3method(chooseOpsMethod,integer64) importFrom(bit,clone) diff --git a/R/setops64.R b/R/setops64.R index 78deb9ab..ecc90fdb 100644 --- a/R/setops64.R +++ b/R/setops64.R @@ -30,7 +30,7 @@ #' #' @export #' @rdname sets -union = function(x, y) { +union.integer64 = function(x, y) { if (!(is.integer64(x) || is.integer64(y))) return(base::union(x, y)) @@ -55,10 +55,15 @@ union = function(x, y) { unique(c(x, y)) } +#' @exportMethod union +setMethod("union", signature(x="ANY", y="ANY"), union.integer64) +setMethod("union", signature(x="integer64", y="ANY"), union.integer64) +setMethod("union", signature(x="ANY", y="integer64"), union.integer64) +setMethod("union", signature(x="integer64", y="integer64"), union.integer64) #' @export #' @rdname sets -intersect = function(x, y) { +intersect.integer64 = function(x, y) { if (is.null(x) || is.null(y)) return(NULL) if (!(is.integer64(x) || is.integer64(y))) return(base::intersect(x, y)) @@ -83,10 +88,15 @@ intersect = function(x, y) { x[match(x, y, 0L) > 0L] } +#' @exportMethod intersect +setMethod("intersect", signature(x="ANY", y="ANY"), intersect.integer64) +setMethod("intersect", signature(x="integer64", y="ANY"), intersect.integer64) +setMethod("intersect", signature(x="ANY", y="integer64"), intersect.integer64) +setMethod("intersect", signature(x="integer64", y="integer64"), intersect.integer64) #' @export #' @rdname sets -setequal = function(x, y) { +setequal.integer64 = function(x, y) { if (!(is.integer64(x) || is.integer64(y))) return(base::setequal(x, y)) @@ -105,10 +115,15 @@ setequal = function(x, y) { !anyNA(match(x, y)) } +#' @exportMethod setequal +setMethod("setequal", signature(x="ANY", y="ANY"), setequal.integer64) +setMethod("setequal", signature(x="integer64", y="ANY"), setequal.integer64) +setMethod("setequal", signature(x="ANY", y="integer64"), setequal.integer64) +setMethod("setequal", signature(x="integer64", y="integer64"), setequal.integer64) #' @export #' @rdname sets -setdiff = function(x, y) { +setdiff.integer64 = function(x, y) { if (!(is.integer64(x) || is.integer64(y))) return(base::setdiff(x, y)) @@ -134,10 +149,15 @@ setdiff = function(x, y) { x[match(x_match, y, 0L) == 0L] } +#' @exportMethod setdiff +setMethod("setdiff", signature(x="ANY", y="ANY"), setdiff.integer64) +setMethod("setdiff", signature(x="integer64", y="ANY"), setdiff.integer64) +setMethod("setdiff", signature(x="ANY", y="integer64"), setdiff.integer64) +setMethod("setdiff", signature(x="integer64", y="integer64"), setdiff.integer64) #' @export #' @rdname sets -is.element = function(el, set) { +is.element.integer64 = function(el, set) { if (!(is.integer64(el) || is.integer64(set))) return(base::is.element(el, set)) @@ -160,3 +180,8 @@ is.element = function(el, set) { match(el, set, 0L) > 0L } +#' @exportMethod is.element +setMethod("is.element", signature(el="ANY", set="ANY"), is.element.integer64) +setMethod("is.element", signature(el="integer64", set="ANY"), is.element.integer64) +setMethod("is.element", signature(el="ANY", set="integer64"), is.element.integer64) +setMethod("is.element", signature(el="integer64", set="integer64"), is.element.integer64) diff --git a/man/sets.Rd b/man/sets.Rd index e93b18fe..123dc00d 100644 --- a/man/sets.Rd +++ b/man/sets.Rd @@ -1,22 +1,22 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/setops64.R -\name{union} -\alias{union} -\alias{intersect} -\alias{setequal} -\alias{setdiff} -\alias{is.element} +\name{union.integer64} +\alias{union.integer64} +\alias{intersect.integer64} +\alias{setequal.integer64} +\alias{setdiff.integer64} +\alias{is.element.integer64} \title{Set Operations} \usage{ -union(x, y) +union.integer64(x, y) -intersect(x, y) +intersect.integer64(x, y) -setequal(x, y) +setequal.integer64(x, y) -setdiff(x, y) +setdiff.integer64(x, y) -is.element(el, set) +is.element.integer64(el, set) } \arguments{ \item{x, y, el, set}{vectors (of the same mode) containing a sequence diff --git a/tests/testthat/test-setops64.R b/tests/testthat/test-setops64.R index 91c6ccb9..4e2d8be7 100644 --- a/tests/testthat/test-setops64.R +++ b/tests/testthat/test-setops64.R @@ -320,3 +320,79 @@ 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)", { + 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"), + function(x, y) "Successfully routed to S4 method A!" + ) + methods::setMethod( + "intersect", + signature=c("TestS4", "TestS4"), + function(x, y) "Successfully routed to S4 method B!" + ) + methods::setMethod( + "union", + signature=c("TestS4", "integer64"), + function(x, y) "Successfully routed to S4 method A!" + ) + methods::setMethod( + "union", + signature=c("TestS4", "TestS4"), + function(x, y) "Successfully routed to S4 method B!" + ) + methods::setMethod( + "setdiff", + signature=c("TestS4", "integer64"), + function(x, y) "Successfully routed to S4 method A!" + ) + methods::setMethod( + "setdiff", + signature=c("TestS4", "TestS4"), + function(x, y) "Successfully routed to S4 method B!" + ) + 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_setdiff_generic) methods::removeGeneric("setdiff") + if (delete_union_generic) methods::removeGeneric("union") + if (delete_intersect_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 A!") + expect_identical(union(x, y), "Successfully routed to S4 method A!") + expect_identical(setdiff(x, y), "Successfully routed to S4 method A!") + # 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 B!") + expect_identical(union(x, x), "Successfully routed to S4 method B!") + expect_identical(setdiff(x, x), "Successfully routed to S4 method B!") +}) + +test_that("S3 dispatch still happens for classes extending integer64 (#298)", { + x = 1:2 + y = as.integer64(1L) + class(y) = c('foo', 'integer64') + expect_identical(intersect(x, y), as.integer64(1L)) + expect_identical(union(x, y), as.integer64(1:2)) + expect_identical(setdiff(x, y), 2L) +}) From 0858b012e42006fb8c64c757ca2bcc19396b3b29 Mon Sep 17 00:00:00 2001 From: hcirellu Date: Thu, 19 Mar 2026 17:25:22 +0100 Subject: [PATCH 2/2] add documentation --- R/setops64.R | 21 ++++++++++++++++++ man/sets.Rd | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 83 insertions(+), 1 deletion(-) diff --git a/R/setops64.R b/R/setops64.R index ecc90fdb..4fb13dba 100644 --- a/R/setops64.R +++ b/R/setops64.R @@ -30,6 +30,7 @@ #' #' @export #' @rdname sets +#' @name sets union.integer64 = function(x, y) { if (!(is.integer64(x) || is.integer64(y))) return(base::union(x, y)) @@ -56,9 +57,13 @@ union.integer64 = function(x, y) { unique(c(x, y)) } #' @exportMethod union +#' @rdname sets setMethod("union", signature(x="ANY", y="ANY"), union.integer64) +#' @rdname sets setMethod("union", signature(x="integer64", y="ANY"), union.integer64) +#' @rdname sets setMethod("union", signature(x="ANY", y="integer64"), union.integer64) +#' @rdname sets setMethod("union", signature(x="integer64", y="integer64"), union.integer64) #' @export @@ -89,9 +94,13 @@ intersect.integer64 = function(x, y) { x[match(x, y, 0L) > 0L] } #' @exportMethod intersect +#' @rdname sets setMethod("intersect", signature(x="ANY", y="ANY"), intersect.integer64) +#' @rdname sets setMethod("intersect", signature(x="integer64", y="ANY"), intersect.integer64) +#' @rdname sets setMethod("intersect", signature(x="ANY", y="integer64"), intersect.integer64) +#' @rdname sets setMethod("intersect", signature(x="integer64", y="integer64"), intersect.integer64) #' @export @@ -116,9 +125,13 @@ setequal.integer64 = function(x, y) { !anyNA(match(x, y)) } #' @exportMethod setequal +#' @rdname sets setMethod("setequal", signature(x="ANY", y="ANY"), setequal.integer64) +#' @rdname sets setMethod("setequal", signature(x="integer64", y="ANY"), setequal.integer64) +#' @rdname sets setMethod("setequal", signature(x="ANY", y="integer64"), setequal.integer64) +#' @rdname sets setMethod("setequal", signature(x="integer64", y="integer64"), setequal.integer64) #' @export @@ -150,9 +163,13 @@ setdiff.integer64 = function(x, y) { x[match(x_match, y, 0L) == 0L] } #' @exportMethod setdiff +#' @rdname sets setMethod("setdiff", signature(x="ANY", y="ANY"), setdiff.integer64) +#' @rdname sets setMethod("setdiff", signature(x="integer64", y="ANY"), setdiff.integer64) +#' @rdname sets setMethod("setdiff", signature(x="ANY", y="integer64"), setdiff.integer64) +#' @rdname sets setMethod("setdiff", signature(x="integer64", y="integer64"), setdiff.integer64) #' @export @@ -181,7 +198,11 @@ is.element.integer64 = function(el, set) { match(el, set, 0L) > 0L } #' @exportMethod is.element +#' @rdname sets setMethod("is.element", signature(el="ANY", set="ANY"), is.element.integer64) +#' @rdname sets setMethod("is.element", signature(el="integer64", set="ANY"), is.element.integer64) +#' @rdname sets setMethod("is.element", signature(el="ANY", set="integer64"), is.element.integer64) +#' @rdname sets setMethod("is.element", signature(el="integer64", set="integer64"), is.element.integer64) diff --git a/man/sets.Rd b/man/sets.Rd index 123dc00d..3c0ec035 100644 --- a/man/sets.Rd +++ b/man/sets.Rd @@ -1,22 +1,83 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/setops64.R -\name{union.integer64} +\name{sets} +\alias{sets} \alias{union.integer64} +\alias{union,ANY,ANY-method} +\alias{union,integer64,ANY-method} +\alias{union,ANY,integer64-method} +\alias{union,integer64,integer64-method} \alias{intersect.integer64} +\alias{intersect,ANY,ANY-method} +\alias{intersect,integer64,ANY-method} +\alias{intersect,ANY,integer64-method} +\alias{intersect,integer64,integer64-method} \alias{setequal.integer64} +\alias{setequal,ANY,ANY-method} +\alias{setequal,integer64,ANY-method} +\alias{setequal,ANY,integer64-method} +\alias{setequal,integer64,integer64-method} \alias{setdiff.integer64} +\alias{setdiff,ANY,ANY-method} +\alias{setdiff,integer64,ANY-method} +\alias{setdiff,ANY,integer64-method} +\alias{setdiff,integer64,integer64-method} \alias{is.element.integer64} +\alias{is.element,ANY,ANY-method} +\alias{is.element,integer64,ANY-method} +\alias{is.element,ANY,integer64-method} +\alias{is.element,integer64,integer64-method} \title{Set Operations} \usage{ union.integer64(x, y) +\S4method{union}{ANY,ANY}(x, y) + +\S4method{union}{integer64,ANY}(x, y) + +\S4method{union}{ANY,integer64}(x, y) + +\S4method{union}{integer64,integer64}(x, y) + intersect.integer64(x, y) +\S4method{intersect}{ANY,ANY}(x, y) + +\S4method{intersect}{integer64,ANY}(x, y) + +\S4method{intersect}{ANY,integer64}(x, y) + +\S4method{intersect}{integer64,integer64}(x, y) + setequal.integer64(x, y) +\S4method{setequal}{ANY,ANY}(x, y) + +\S4method{setequal}{integer64,ANY}(x, y) + +\S4method{setequal}{ANY,integer64}(x, y) + +\S4method{setequal}{integer64,integer64}(x, y) + setdiff.integer64(x, y) +\S4method{setdiff}{ANY,ANY}(x, y) + +\S4method{setdiff}{integer64,ANY}(x, y) + +\S4method{setdiff}{ANY,integer64}(x, y) + +\S4method{setdiff}{integer64,integer64}(x, y) + is.element.integer64(el, set) + +\S4method{is.element}{ANY,ANY}(el, set) + +\S4method{is.element}{integer64,ANY}(el, set) + +\S4method{is.element}{ANY,integer64}(el, set) + +\S4method{is.element}{integer64,integer64}(el, set) } \arguments{ \item{x, y, el, set}{vectors (of the same mode) containing a sequence