S3 with generics package

Author: hcirellu

DESCRIPTION

@@ -8,7 +8,7 @@ Authors@R: c(
     person("Ofek", "Shilon", role="ctb"),
     person("Christian", "Ullerich", role="ctb")
   )
-Depends: R (>= 3.5.0)
+Depends: R (>= 3.5.0), generics
 Description:
   Package 'bit64' provides serializable S3 atomic 64bit (signed) integers.
   These are useful for handling database keys and exact counting in +-2^63.

NAMESPACE

@@ -89,8 +89,12 @@ S3method(hashtab,cache_integer64)
 S3method(hashuni,cache_integer64)
 S3method(hashupo,cache_integer64)
 S3method(identical,integer64)
+S3method(intersect,default)
+S3method(intersect,integer64)
 S3method(is.double,default)
 S3method(is.double,integer64)
+S3method(is.element,default)
+S3method(is.element,integer64)
 S3method(is.finite,integer64)
 S3method(is.infinite,integer64)
 S3method(is.na,integer64)
@@ -154,6 +158,10 @@ S3method(rowSums,default)
 S3method(rowSums,integer64)
 S3method(scale,integer64)
 S3method(seq,integer64)
+S3method(setdiff,default)
+S3method(setdiff,integer64)
+S3method(setequal,default)
+S3method(setequal,integer64)
 S3method(shellorder,integer64)
 S3method(shellsort,integer64)
 S3method(shellsortorder,integer64)
@@ -181,6 +189,8 @@ S3method(table,default)
 S3method(table,integer64)
 S3method(tiepos,integer64)
 S3method(trunc,integer64)
+S3method(union,default)
+S3method(union,integer64)
 S3method(unipos,integer64)
 S3method(unique,integer64)
 export("%in%")
@@ -227,9 +237,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)
@@ -270,8 +278,6 @@ export(rowSums)
 export(runif64)
 export(seq.integer64)
 export(setcache)
-export(setdiff)
-export(setequal)
 export(sortcache)
 export(sortfin)
 export(sortnut)
@@ -291,7 +297,6 @@ export(str.integer64)
 export(sum.integer64)
 export(table)
 export(tiepos)
-export(union)
 export(unipos)
 export(unique.integer64)
 if (getRversion() >= "4.2.0") S3method(mtfrm,integer64)
@@ -323,6 +328,11 @@ importFrom(bit,shellorder)
 importFrom(bit,shellsort)
 importFrom(bit,shellsortorder)
 importFrom(bit,still.identical)
+importFrom(generics,intersect)
+importFrom(generics,is.element)
+importFrom(generics,setdiff)
+importFrom(generics,setequal)
+importFrom(generics,union)
 importFrom(graphics,barplot)
 importFrom(graphics,par)
 importFrom(graphics,title)

R/setops64.R

@@ -10,6 +10,7 @@
 #' @title Set Operations
 #' @description Performs set union, intersection, (asymmetric!) difference, equality and membership on two vectors. As soon as an integer64 vector is involved, the operations are performed using integer64 semantics. Otherwise the \code{base} package functions are called.
 #' @inheritParams base::union
+#' @param ... further arguments passed to or from other methods.
 #' @return 
 #' For union, a vector of a common mode or class.
 #' 
@@ -28,12 +29,18 @@
 #' setequal(x, y)
 #' is.element(x, y)
 #' 
-#' @export
+#' @importFrom generics union
+#' @exportS3Method union default
+#' @aliases union
 #' @rdname sets
-union = function(x, y) {
-  if (!(is.integer64(x) || is.integer64(y)))
-    return(base::union(x, y))
-  
+union.default = function(x, y, ...) {
+  if (is.integer64(y)) return(union.integer64(x, y))
+  base::union(x, y)
+}
+    
+#' @exportS3Method union integer64
+#' @rdname sets
+union.integer64 = function(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)
@@ -56,13 +63,19 @@ union = function(x, y) {
   unique(c(x, y))
 }
 
-#' @export
+#' @importFrom generics intersect
+#' @exportS3Method intersect default
+#' @aliases intersect
+#' @rdname sets
+intersect.default = function(x, y, ...) {
+  if (is.integer64(y)) return(intersect.integer64(x, y))
+  base::intersect(x, y)
+}
+
+#' @exportS3Method intersect integer64
 #' @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))
-  
   target_class = target_class(list(x, y))
   x = unique(x)
   class_x = class(x)[1L]
@@ -84,12 +97,18 @@ intersect = function(x, y) {
   x[match(x, y, 0L) > 0L]
 }
 
-#' @export
+#' @importFrom generics setequal
+#' @exportS3Method setequal default
+#' @aliases setequal
 #' @rdname sets
-setequal = function(x, y) {
-  if (!(is.integer64(x) || is.integer64(y)))
-    return(base::setequal(x, y))
-  
+setequal.default = function(x, y, ...) {
+  if (is.integer64(y)) return(setequal.integer64(x, y))
+  base::setequal(x, y)
+}
+
+#' @exportS3Method setequal integer64
+#' @rdname sets
+setequal.integer64 = function(x, y, ...) {
   x = unique(x)
   y = unique(y)
   length_x = length(x)
@@ -106,12 +125,18 @@ setequal = function(x, y) {
   !anyNA(match(x, y))
 }
 
-#' @export
+#' @importFrom generics setdiff
+#' @exportS3Method setdiff default
+#' @aliases setdiff
 #' @rdname sets
-setdiff = function(x, y) {
-  if (!(is.integer64(x) || is.integer64(y)))
-    return(base::setdiff(x, y))
-  
+setdiff.default = function(x, y, ...) {
+  if (is.integer64(y)) return(setdiff.integer64(x, y))
+  base::setdiff(x, y)
+}
+
+#' @exportS3Method setdiff integer64
+#' @rdname sets
+setdiff.integer64 = function(x, y, ...) {
   class_x = class(x)[1L]
   if (class_x %in% c("POSIXct", "Date"))
     x = unclass(x)
@@ -135,12 +160,18 @@ setdiff = function(x, y) {
   x[match(x_match, y, 0L) == 0L]
 }
 
-#' @export
+#' @importFrom generics is.element
+#' @exportS3Method is.element default
+#' @aliases is.element
 #' @rdname sets
-is.element = function(el, set) {
-  if (!(is.integer64(el) || is.integer64(set)))
-    return(base::is.element(el, set))
-  
+is.element.default = function(el, set, ...) {
+  if (is.integer64(set)) return(is.element.integer64(el, set))
+  base::is.element(el, set)
+}
+
+#' @exportS3Method is.element integer64
+#' @rdname sets
+is.element.integer64 = function(el, set, ...) {
   target_class = target_class(list(el, set))
   class_el = class(el)[1L]
   if (class_el != target_class) {