diff --git a/NAMESPACE b/NAMESPACE index 04bd7bd8..4db53826 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,31 +1,31 @@ # Generated by roxygen2: do not edit by hand -S3method("!",integer64) -S3method("!=",integer64) -S3method("%%",integer64) -S3method("%*%",integer64) -S3method("%/%",integer64) S3method("%in%",default) S3method("%in%",integer64) -S3method("&",integer64) -S3method("*",integer64) -S3method("+",integer64) -S3method("-",integer64) -S3method("/",integer64) S3method(":",default) S3method(":",integer64) -S3method("<",integer64) -S3method("<=",integer64) -S3method("==",integer64) -S3method(">",integer64) -S3method(">=",integer64) S3method("[",integer64) S3method("[<-",integer64) S3method("[[",integer64) S3method("[[<-",integer64) -S3method("^",integer64) S3method("length<-",integer64) -S3method("|",integer64) +S3method(`!=`,integer64) +S3method(`!`,integer64) +S3method(`%%`,integer64) +S3method(`%*%`,integer64) +S3method(`%/%`,integer64) +S3method(`&`,integer64) +S3method(`*`,integer64) +S3method(`+`,integer64) +S3method(`-`,integer64) +S3method(`/`,integer64) +S3method(`<=`,integer64) +S3method(`<`,integer64) +S3method(`==`,integer64) +S3method(`>=`,integer64) +S3method(`>`,integer64) +S3method(`^`,integer64) +S3method(`|`,integer64) S3method(abs,integer64) S3method(all,integer64) S3method(all.equal,integer64) @@ -184,7 +184,6 @@ S3method(tiepos,integer64) S3method(trunc,integer64) S3method(unipos,integer64) S3method(unique,integer64) -S3method(xor,integer64) export("%in%") export("%in%.default") export("%in%.integer64") @@ -387,8 +386,8 @@ export(tiepos.integer64) export(unipos) export(unipos.integer64) export(unique.integer64) -export(xor.integer64) if (getRversion() >= "4.2.0") S3method(mtfrm,integer64) +if (getRversion() >= "4.3.0") S3method(chooseOpsMethod,integer64) importFrom(bit,clone) importFrom(bit,is.sorted) importFrom(bit,keyorder) @@ -416,7 +415,6 @@ importFrom(bit,shellorder) importFrom(bit,shellsort) importFrom(bit,shellsortorder) importFrom(bit,still.identical) -importFrom(bit,xor) importFrom(graphics,barplot) importFrom(graphics,par) importFrom(graphics,title) diff --git a/NEWS.md b/NEWS.md index e6e1d545..6be0bc0c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -59,6 +59,7 @@ - Ignores leading/trailing whitespace (as does `as.integer()`; #232). 1. `sortcache`, `sortordercache` and `ordercache` get a new argument `na.last`. 1. `matrix`, `array`, `%*%` and `as.matrix` get an `integer64` method (#45). Thanks @hcirellu. +1. The methods of the 'Ops' group (e.g. `+`, `&`, `==`) now support dispatch for both arguments so that e.g. `difftime * integer64` works consistent to R (>= 4.3.0) (#179). Thanks @hcirellu. ## BUG FIXES diff --git a/R/bit64-package.R b/R/bit64-package.R index a0d8ac11..bd154b02 100644 --- a/R/bit64-package.R +++ b/R/bit64-package.R @@ -85,37 +85,57 @@ #' example in [`c()`][c.integer64], [`cbind()`][cbind.integer64], and #' [`rbind()`][rbind.integer64] #' -#' Different from Base R, our operators [`+`][+.integer64], [`-`][-.integer64], -#' \code{\link[=xor.integer64]{\%/\%}}, and \code{\link[=xor.integer64]{\%\%}} coerce their arguments to -#' `integer64` and always return `integer64`. -#' -#' The multiplication operator [`*`][*.integer64] coerces its first argument to -#' `integer64` but allows its second argument to be also `double`: the second -#' argument is internaly coerced to 'long double' and the result of the -#' multiplication is returned as `integer64`. -#' -#' The division [`/`][/.integer64] and power [`^`][^.integer64] operators also -#' coerce their first argument to `integer64` and coerce internally their second -#' argument to 'long double', they return as `double`, like +#' Our operators [`+`][ops64], [`-`][ops64], [`%/%`][ops64], and [`%%`][ops64] coerce +#' their arguments to `integer64` and return `integer64` if they are `integer`, +#' `double` or `logical`. Otherwise the `integer64` argument is coerced to double and +#' the R base method for the other class is called. +#' +#' Our operators [`*`][ops64] and [`^`][ops64] coerce their first argument to +#' `integer64` and possibly the second to `integer64` if it is not `double` and +#' return `integer64` if they are `integer`, `double` or `logical`. Otherwise the +#' `integer64` argument is coerced to double and the R base method for the other +#' class is called. +#' +#' The division [`/`][ops64] operator also coerces its first argument to `integer64` +#' and possibly the second to `integer64` if it is not `double` and returns +#' `integer64` if they are `integer`, `double` or `logical`. Otherwise the `integer64` +#' argument is coerced to double and the R base method for the other class is called. +#' #' [`sqrt()`][sqrt.integer64], [`log()`][log.integer64], -#' [`log2()`][log2.integer64], and [`log10()`][log10.integer64] do. +#' [`log2()`][log2.integer64], and [`log10()`][log10.integer64] coerce their first +#' argument to `integer64` and coerce internally their second argument to +#' 'long double', they return as `double` #' #' | **argument1** | **op** | **argument2** | **->** | **coerced1** | **op** | **coerced2** | **->** | **result** | #' |:-------------:|:------:|:-------------:|:------:|:------------:|:------:|:------------:|:------:|:----------:| #' | integer64 | + | double | -> | integer64 | + | integer64 | -> | integer64 | #' | double | + | integer64 | -> | integer64 | + | integer64 | -> | integer64 | +#' | integer64 | + | complex | -> | double | + | complex | -> | complex | +#' | complex | + | integer64 | -> | complex | + | double | -> | complex | #' | integer64 | - | double | -> | integer64 | - | integer64 | -> | integer64 | #' | double | - | integer64 | -> | integer64 | - | integer64 | -> | integer64 | +#' | integer64 | - | complex | -> | double | - | complex | -> | complex | +#' | complex | - | integer64 | -> | complex | - | double | -> | complex | #' | integer64 | %/% | double | -> | integer64 | %/% | integer64 | -> | integer64 | #' | double | %/% | integer64 | -> | integer64 | %/% | integer64 | -> | integer64 | +#' | integer64 | %/% | complex | -> | double | %/% | complex | -> | complex | +#' | complex | %/% | integer64 | -> | complex | %/% | double | -> | complex | #' | integer64 | %% | double | -> | integer64 | %% | integer64 | -> | integer64 | #' | double | %% | integer64 | -> | integer64 | %% | integer64 | -> | integer64 | +#' | integer64 | %% | complex | -> | double | %% | complex | -> | complex | +#' | complex | %% | integer64 | -> | complex | %% | double | -> | complex | #' | integer64 | * | double | -> | integer64 | * | long double | -> | integer64 | #' | double | * | integer64 | -> | integer64 | * | integer64 | -> | integer64 | +#' | integer64 | * | complex | -> | double | * | complex | -> | complex | +#' | complex | * | integer64 | -> | complex | * | double | -> | complex | #' | integer64 | / | double | -> | integer64 | / | long double | -> | double | #' | double | / | integer64 | -> | integer64 | / | long double | -> | double | -#' | integer64 | ^ | double | -> | integer64 | / | long double | -> | double | -#' | double | ^ | integer64 | -> | integer64 | / | long double | -> | double | +#' | integer64 | / | complex | -> | double | / | complex | -> | complex | +#' | complex | / | integer64 | -> | complex | / | double | -> | complex | +#' | integer64 | ^ | double | -> | integer64 | ^ | long double | -> | double | +#' | double | ^ | integer64 | -> | integer64 | ^ | long double | -> | double | +#' | integer64 | ^ | complex | -> | double | ^ | complex | -> | complex | +#' | complex | ^ | integer64 | -> | complex | ^ | double | -> | complex | #' | integer64 | %*% | double | -> | integer64 | %*% | integer64 | -> | integer64 | #' | double | %*% | integer64 | -> | integer64 | %*% | integer64 | -> | integer64 | #' | integer64 | %*% | complex | -> | double | %*% | complex | -> | complex | @@ -218,8 +238,8 @@ #' | [`*.integer64`] | [`*`] | returns integer64 | #' | [`^.integer64`] | [`^`] | returns double | #' | [`/.integer64`] | [`/`] | returns double | -#' | \code{\link[=xor.integer64]{\%/\%}} | \code{\link[=Arithmetic]{\%/\%}} | returns integer64 | -#' | \code{\link[=xor.integer64]{\%\%}} | \code{\link[=Arithmetic]{\%\%}} | returns integer64 | +#' | \code{\link[=ops64]{\%/\%}} | \code{\link[=Arithmetic]{\%/\%}} | returns integer64 | +#' | \code{\link[=ops64]{\%\%}} | \code{\link[=Arithmetic]{\%\%}} | returns integer64 | #' #' | **comparison operators** | **see also** | **description** | #' |-------------------------:|-------------:|:----------------| @@ -234,16 +254,14 @@ #' \strong{logical operators} \tab \strong{see also} \tab \strong{description} \cr #' \code{\link{!.integer64}} \tab \code{\link{!}} \tab \cr #' \code{\link{&.integer64}} \tab \code{\link{&}} \tab \cr -#' \code{\link[=xor.integer64]{|.integer64}} \tab \code{\link[base:Logic]{|}} \tab \cr -#' \code{\link{xor.integer64}} \tab \code{\link[=xor]{xor()}} \tab \cr +#' \code{\link{|.integer64}} \tab \code{\link[base:Logic]{|}} \tab \cr #' } # TODO(r-lib/roxygen2#1668): Restore the markdown representation of the table. # | **logical operators** | **see also** | **description** | # |----------------------:|-------------:|:----------------| # | [`!.integer64`] | [`!`] | | # | [`&.integer64`] | [`&`] | | -# | [`\|.integer64`][xor.integer64] | [`\|`][base::Logic] | | -# | [`xor.integer64`] | [xor()] | | +# | [`\|.integer64`] | [`\|`][base::Logic] | | #' #' | **math functions** | **see also** | **description** | #' |----------------------:|-------------:|:-----------------------------| @@ -360,19 +378,6 @@ #' `recursive=TRUE`. Therefore `c(list(integer64, integer64))` does not work and #' for now you can only call `c.integer64(list(x, x))`. #' -#' - **generic binary operators** fail to dispatch *any* user-defined S3 method -#' if the two arguments have two different S3 classes. For example we have two -#' classes [`bit::bit`] and [`bit::bitwhich`] sparsely representing boolean vectors -#' and we have methods [`&.bit`][bit::xor.default] and -#' [`&.bitwhich`][bit::xor.default]. For an expression involving both as in -#' `bit & bitwhich`, none of the two methods is dispatched. Instead a standard -#' method is dispatched, which neither handles `bit` nor `bitwhich`. Although -#' it lacks symmetry, the better choice would be to dispatch simply the method -#' of the class of the first argument in case of class conflict. This choice would -#' allow authors of extension packages providing coherent behaviour at least within -#' their contributed classes. But as long as none of the package author's methods is -#' dispatched, they cannot handle the conflicting classes at all. -#' #' - **[unlist()]** is not generic and if it were, we would face similar problems as #' with [c()] #' - **[vector()]** with argument `mode='integer64'` cannot work without adjustment @@ -697,7 +702,7 @@ #' mergesort mergesortorder na.count nties nunique nvalid quickorder #' quicksort quicksortorder radixorder radixsort radixsortorder ramorder #' ramsort ramsortorder repeat.time setattr shellorder shellsort -#' shellsortorder still.identical xor +#' shellsortorder still.identical #' @importFrom graphics barplot par title #' @importFrom methods as is #' @importFrom stats cor median quantile @@ -744,6 +749,6 @@ #' @export sortordertie.integer64 sortorderuni.integer64 sortorderupo.integer64 #' @export sortqtl.integer64 sorttab.integer64 sortuni.integer64 #' @export str.integer64 sum.integer64 summary.integer64 tiepos.integer64 -#' @export unipos.integer64 unique.integer64 xor.integer64 +#' @export unipos.integer64 unique.integer64 ## usethis namespace: end NULL diff --git a/R/integer64.R b/R/integer64.R index 6faf0c42..f86c404a 100644 --- a/R/integer64.R +++ b/R/integer64.R @@ -2,7 +2,7 @@ # R-Code # S3 atomic 64bit integers for R # (c) 2011-2024 Jens Oehlschägel -# (c) 2025 Michael Chirico +# (c) 2025-2026 Michael Chirico # Licence: GPL2 # Provided 'as is', use at your own risk # Created: 2011-12-11 @@ -150,47 +150,12 @@ NULL #' [signif()] is not implemented #' #' @keywords classes manip -#' @seealso [xor.integer64()] [integer64()] +#' @seealso [ops64] [integer64()] #' @examples #' sqrt(as.integer64(1:12)) #' @name format.integer64 NULL -#' Binary operators for integer64 vectors -#' -#' Binary operators for integer64 vectors. -#' -#' @param e1 an atomic vector of class 'integer64' -#' @param e2 an atomic vector of class 'integer64' -#' @param x an atomic vector of class 'integer64' -#' @param y an atomic vector of class 'integer64' -#' -#' @returns -#' [`&`], [`|`], [xor()], [`!=`], [`==`], -#' [`<`], [`<=`], [`>`], [`>=`] return a logical vector -#' -#' [`^`] and [`/`] return a double vector -#' -#' [`+`], [`-`], [`*`], \code{\link[=Arithmetic]{\%/\%}}, \code{\link[=Arithmetic]{\%\%}} -#' return a vector of class 'integer64' -#' -#' @keywords classes manip -#' @seealso [format.integer64()] [integer64()] -#' @examples -#' as.integer64(1:12) - 1 -#' options(integer64_semantics="new") -#' d <- 2.5 -#' i <- as.integer64(5) -#' d/i # new 0.5 -#' d*i # new 13 -#' i*d # new 13 -#' options(integer64_semantics="old") -#' d/i # old: 0.4 -#' d*i # old: 10 -#' i*d # old: 13 -#' @name xor.integer64 -NULL - #' Summary functions for integer64 vectors #' #' Summary functions for integer64 vectors. Function 'range' without arguments @@ -545,73 +510,6 @@ plusclass = function(class, whichclass) { c(class, if (!any(whichclass == class)) whichclass) } -# Version of Leonardo Silvestri -#' @rdname xor.integer64 -#' @export -binattr = function(e1, e2) { - d1 = dim(e1) - d2 = dim(e2) - n1 = length(e1) - n2 = length(e2) - - ## this first part takes care of erroring out when the dimensions - ## are not compatible or warning if needed: - if (length(d1)) { - if (length(d2)) { - if (!identical(dim(e1), dim(e2))) - stop(gettext("non-conformable arrays", domain="R")) - } else { - if (n2 > n1 && n1) - stop("length(e2) does not match dim(e1)") - if (n2 && n1 %% n2) - warning("length(e1) not a multiple length(e2)") - } - } else if (length(d2)) { - if (n1 > n2 && n2) - stop("length(e1) does not match dim(n2)") - if (n1 && n2 %% n1) - warning("length(e2) not a multiple length(e1)") - } else { - # nolint next: unnecessary_nesting_linter. Good parallelism. - if (n1 < n2 && n1) { - if (n1 && n2 %% n1) - warning("length(e2) not a multiple length(e1)") - } else { - # nolint next: unnecessary_nesting_linter. Good parallelism. - if (n2 && n1 %% n2) - warning("length(e1) not a multiple length(e2)") - } - } - - ## in this part we mimic R's algo for selecting attributes: - if (n1 == n2) { - ## if same size take attribute from e1 if it exists, else from e2 - if (n1 == 0L) { - ae1 <- attributes(e1)[c("class", "dim", "dimnames")] - ae2 <- attributes(e2)[c("class", "dim", "dimnames")] - } - ae1 <- attributes(e1) - ae2 <- attributes(e2) - nae1 <- names(attributes(e1)) - nae2 <- names(attributes(e2)) - if (n1==0L) { - ae1 <- ae1[nae1 %in% c("class", "dim", "dimnames")] - ae2 <- ae1[nae1 %in% c("class", "dim", "dimnames")] - } - allattr <- list() - for (a in union(nae1, nae2)) - if (a %in% nae1) - allattr[[a]] <- ae1[[a]] - else - allattr[[a]] <- ae2[[a]] - allattr - } else if (n1 == 0L || n1 > n2) { - attributes(e1) - } else { - attributes(e2) - } -} - #' @rdname bit64-package #' @param length length of vector using [integer()] #' @return `integer64` returns a vector of 'integer64', i.e., @@ -1187,174 +1085,6 @@ seq.integer64 = function(from=NULL, to=NULL, by=NULL, length.out=NULL, along.wit ret } - -# helper for determining the target class for Ops methods -target_class_for_Ops = function(e1, e2) { - if(missing(e2)) { - if (!is.numeric(unclass(e1)) && !is.logical(e1) && !is.complex(e1)) - stop(errorCondition(gettext("non-numeric argument to mathematical function", domain = "R"), call=sys.call(sys.nframe() - 1L))) - - if (is.complex(e1)) { - "complex" - } else { - "integer64" - } - } else { - if (!is.numeric(unclass(e1)) && !is.logical(e1) && !is.complex(e1)) - stop(errorCondition(gettext("non-numeric argument to binary operator", domain = "R"), call=sys.call(sys.nframe() - 1L))) - if (!is.numeric(unclass(e2)) && !is.logical(e2) && !is.complex(e2)) - stop(errorCondition(gettext("non-numeric argument to binary operator", domain = "R"), call=sys.call(sys.nframe() - 1L))) - - if (is.complex(e1) || is.complex(e2)) { - "complex" - } else { - "integer64" - } - } -} - -#' @rdname xor.integer64 -#' @export -`+.integer64` <- function(e1, e2) { - if (missing(e2)) - return(e1) - a = binattr(e1, e2) - e1 = as.integer64(e1) - e2 = as.integer64(e2) - l1 = length(e1) - l2 = length(e2) - l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) - ret = double(l) - ret = .Call(C_plus_integer64, e1, e2, ret) - a$class = plusclass(a$class, "integer64") - attributes(ret) = a - ret -} - -#' @rdname xor.integer64 -#' @export -`-.integer64` <- function(e1, e2) { - if (missing(e2)) { - e2 <- e1 - e1 <- 0L - } - a = binattr(e1, e2) - e1 = as.integer64(e1) - e2 = as.integer64(e2) - l1 = length(e1) - l2 = length(e2) - l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) - ret = double(l) - .Call(C_minus_integer64, e1, e2, ret) - a$class = plusclass(a$class, "integer64") - attributes(ret) = a - ret -} - -#' @rdname xor.integer64 -#' @export -`%/%.integer64` <- function(e1, e2) { - a = binattr(e1, e2) - e1 = as.integer64(e1) - e2 = as.integer64(e2) - l1 = length(e1) - l2 = length(e2) - l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) - ret = double(l) - .Call(C_intdiv_integer64, e1, e2, ret) - a$class = plusclass(a$class, "integer64") - attributes(ret) = a - ret -} - -#' @rdname xor.integer64 -#' @export -`%%.integer64` <- function(e1, e2) { - a = binattr(e1, e2) - e1 = as.integer64(e1) - e2 = as.integer64(e2) - l1 = length(e1) - l2 = length(e2) - l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) - ret = double(l) - .Call(C_mod_integer64, e1, e2, ret) - a$class = plusclass(a$class, "integer64") - attributes(ret) = a - ret -} - -#' @rdname xor.integer64 -#' @export -`*.integer64` <- function(e1, e2) { - a = binattr(e1, e2) - l1 = length(e1) - l2 = length(e2) - l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) - ret = double(l) - if (getOption("integer64_semantics", "old") == "old") { - if (is.double(e2)) # implies !is.integer64(e2) - ret <- .Call(C_times_integer64_double, as.integer64(e1), e2, ret) - else - ret <- .Call(C_times_integer64_integer64, as.integer64(e1), as.integer64(e2), ret) - } else { - # nolint next: unnecessary_nesting_linter. Good parallelism, and on a to-be-deprecated code path. - if (is.double(e2)) # implies !is.integer64(e2) - ret <- .Call(C_times_integer64_double, as.integer64(e1), e2, ret) - else if (is.double(e1)) - ret <- .Call(C_times_integer64_double, as.integer64(e2), e1, ret) - else - ret <- .Call(C_times_integer64_integer64, as.integer64(e1), as.integer64(e2), ret) - } - a$class = plusclass(a$class, "integer64") - attributes(ret) = a - ret -} - -#' @rdname xor.integer64 -#' @export -`^.integer64` <- function(e1, e2) { - a = binattr(e1, e2) - l1 = length(e1) - l2 = length(e2) - l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) - ret = double(l) - if (is.double(e2)) # implies !is.integer64(e2) - ret <- .Call(C_power_integer64_double, as.integer64(e1), e2, ret) - else - ret <- .Call(C_power_integer64_integer64, as.integer64(e1), as.integer64(e2), ret) - a$class = plusclass(a$class, "integer64") - attributes(ret) = a - ret -} - -#' @rdname xor.integer64 -#' @export -`/.integer64` <- function(e1, e2) { - a = binattr(e1, e2) - l1 = length(e1) - l2 = length(e2) - l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) - ret = double(l) - if (getOption("integer64_semantics", "old") == "old") { - if (is.double(e2)) # implies !is.integer64(e2) - ret <- .Call(C_divide_integer64_double, as.integer64(e1), e2, ret) - else - ret <- .Call(C_divide_integer64_integer64, as.integer64(e1), as.integer64(e2), ret) - } else { - # nolint next: unnecessary_nesting_linter. Good parallelism, and on a to-be-deprecated code path. - if (is.double(e2)) # implies !is.integer64(e2) - ret <- .Call(C_divide_integer64_double, as.integer64(e1), e2, ret) - else if (is.double(e1)) - ret <- .Call(C_divide_double_integer64, e1, e2, ret) - else - ret <- .Call(C_divide_integer64_integer64, as.integer64(e1), as.integer64(e2), ret) - } - a$class = minusclass(a$class, "integer64") - attributes(ret) = a - ret -} - - #' @rdname format.integer64 #' @export sign.integer64 = function(x) { @@ -1747,143 +1477,6 @@ is.infinite.integer64 = function(x) rep(FALSE, length(x)) is.nan.integer64 = function(x) rep(FALSE, length(x)) -#' @rdname xor.integer64 -#' @export -`==.integer64` <- function(e1, e2) { - a = binattr(e1, e2) - e1 = as.integer64(e1) - e2 = as.integer64(e2) - l1 = length(e1) - l2 = length(e2) - l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) - ret = logical(l) - .Call(C_EQ_integer64, e1, e2, ret) - a$class = minusclass(a$class, "integer64") - attributes(ret) = a - ret -} - -#' @rdname xor.integer64 -#' @export -`!=.integer64` <- function(e1, e2) { - a = binattr(e1, e2) - e1 = as.integer64(e1) - e2 = as.integer64(e2) - l1 = length(e1) - l2 = length(e2) - l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) - ret = logical(l) - .Call(C_NE_integer64, e1, e2, ret) - a$class = minusclass(a$class, "integer64") - attributes(ret) = a - ret -} - -#' @rdname xor.integer64 -#' @export -`<.integer64` <- function(e1, e2) { - a = binattr(e1, e2) - e1 = as.integer64(e1) - e2 = as.integer64(e2) - l1 = length(e1) - l2 = length(e2) - l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) - ret = logical(l) - .Call(C_LT_integer64, e1, e2, ret) - a$class = minusclass(a$class, "integer64") - attributes(ret) = a - ret -} - -#' @rdname xor.integer64 -#' @export -`<=.integer64` <- function(e1, e2) { - a = binattr(e1, e2) - e1 = as.integer64(e1) - e2 = as.integer64(e2) - l1 = length(e1) - l2 = length(e2) - l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) - ret = logical(l) - .Call(C_LE_integer64, e1, e2, ret) - a$class = minusclass(a$class, "integer64") - attributes(ret) = a - ret -} - -#' @rdname xor.integer64 -#' @export -`>.integer64` <- function(e1, e2) { - a = binattr(e1, e2) - e1 = as.integer64(e1) - e2 = as.integer64(e2) - l1 = length(e1) - l2 = length(e2) - l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) - ret = logical(l) - .Call(C_GT_integer64, e1, e2, ret) - a$class = minusclass(a$class, "integer64") - attributes(ret) = a - ret -} - -#' @rdname xor.integer64 -#' @export -`>=.integer64` <- function(e1, e2) { - a = binattr(e1, e2) - e1 = as.integer64(e1) - e2 = as.integer64(e2) - l1 = length(e1) - l2 = length(e2) - l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) - ret = logical(l) - .Call(C_GE_integer64, e1, e2, ret) - a$class = minusclass(a$class, "integer64") - attributes(ret) = a - ret -} - -#' @rdname xor.integer64 -#' @export -`&.integer64` <- function(e1, e2) { - a = binattr(e1, e2) - ret = as.logical(e1) & as.logical(e2) - a$class = minusclass(a$class, "integer64") - attributes(ret) = a - ret -} - -#' @rdname xor.integer64 -#' @export -`|.integer64` <- function(e1, e2) { - a = binattr(e1, e2) -ret = as.logical(e1) | as.logical(e2) - a$class = minusclass(a$class, "integer64") - attributes(ret) = a - ret -} - -#' @rdname xor.integer64 -#' @export -xor.integer64 = function(x, y) { - a = binattr(x, y) - ret = as.logical(x) != as.logical(y) - a$class = minusclass(a$class, "integer64") - attributes(ret) = a - ret -} - - -#' @rdname format.integer64 -#' @export -`!.integer64` <- function(x) { - a = attributes(x) - ret = !as.logical(x) - a$class = minusclass(a$class, "integer64") - attributes(ret) = a - ret -} - # as.vector.integer64 removed as requested by the CRAN maintainer # as.vector.integer64 <- function(x, mode="any") { # ret <- NextMethod() diff --git a/R/ops64.R b/R/ops64.R new file mode 100644 index 00000000..bc619bed --- /dev/null +++ b/R/ops64.R @@ -0,0 +1,505 @@ +# /* +# R-Code +# S3 atomic 64bit integers for R +# (c) 2011-2024 Jens Oehlschägel +# (c) 2025-2026 Michael Chirico +# Licence: GPL2 +# Provided 'as is', use at your own risk +# Created: 2026-01-16 +#*/ + +#' Binary operators for integer64 vectors +#' +#' Binary operators for integer64 vectors. +#' +#' @param e1,e2,x numeric or complex vectors or objects which can be coerced to such, or other objects for which methods have been written for - especially 'integer64' vectors. +#' +#' @returns +#' [`&`], [`|`], [`!`], [`!=`], [`==`], [`<`], [`<=`], [`>`], [`>=`] return a logical vector +#' +#' [`/`] returns a double vector +#' +#' [`+`], [`-`], [`*`], [`%/%`][Arithmetic], [`%%`][Arithmetic], [`^`] return a vector of class 'integer64' or different class depending on the operands +#' +#' @keywords classes manip +#' @seealso [integer64()] +#' @examples +#' as.integer64(1:12) - 1 +#' options(integer64_semantics="new") +#' d <- 2.5 +#' i <- as.integer64(5) +#' d/i # new 0.5 +#' d*i # new 13 +#' i*d # new 13 +#' options(integer64_semantics="old") +#' d/i # old: 0.4 +#' d*i # old: 10 +#' i*d # old: 13 +#' @name ops64 +NULL + +# Version of Leonardo Silvestri +#' @rdname ops64 +#' @export +binattr = function(e1, e2) { + d1 = dim(e1) + d2 = dim(e2) + n1 = length(e1) + n2 = length(e2) + + ## this first part takes care of erroring out when the dimensions + ## are not compatible or warning if needed: + if (length(d1)) { + if (length(d2)) { + if (!identical(dim(e1), dim(e2))) + stop(gettext("non-conformable arrays", domain="R")) + } else { + if (n2 > n1 && n1) + stop("length(e2) does not match dim(e1)") + if (n2 && n1 %% n2) + warning("length(e1) not a multiple length(e2)") + } + } else if (length(d2)) { + if (n1 > n2 && n2) + stop("length(e1) does not match dim(n2)") + if (n1 && n2 %% n1) + warning("length(e2) not a multiple length(e1)") + } else { + # nolint next: unnecessary_nesting_linter. Good parallelism. + if (n1 < n2 && n1) { + if (n1 && n2 %% n1) + warning("length(e2) not a multiple length(e1)") + } else { + # nolint next: unnecessary_nesting_linter. Good parallelism. + if (n2 && n1 %% n2) + warning("length(e1) not a multiple length(e2)") + } + } + + ## in this part we mimic R's algo for selecting attributes: + if (n1 == n2) { + ## if same size take attribute from e1 if it exists, else from e2 + if (n1 == 0L) { + ae1 = attributes(e1)[c("class", "dim", "dimnames")] + ae2 = attributes(e2)[c("class", "dim", "dimnames")] + } + ae1 = attributes(e1) + ae2 = attributes(e2) + nae1 = names(attributes(e1)) + nae2 = names(attributes(e2)) + if (n1 == 0L) { + ae1 = ae1[nae1 %in% c("class", "dim", "dimnames")] + ae2 = ae1[nae1 %in% c("class", "dim", "dimnames")] + } + allattr = list() + for (a in union(nae1, nae2)) + if (a %in% nae1) + allattr[[a]] = ae1[[a]] + else + allattr[[a]] = ae2[[a]] + allattr + } else if (n1 == 0L || n1 > n2) { + attributes(e1) + } else { + attributes(e2) + } +} + +# helper for determining the target class for Ops methods +target_class_for_Ops = function(e1, e2) { + convert_to_integer64 = function(el) is.integer64(el) || ((is.integer(el) || is.double(el)) && !inherits(el, c("difftime", "Date", "POSIXt"))) || is.logical(el) + if(missing(e2)) { + if (!is.numeric(unclass(e1)) && !is.logical(e1) && !is.complex(e1) && !inherits(e1, "POSIXt")) + stop(errorCondition(gettext("non-numeric argument to mathematical function", domain="R"), call=sys.call(sys.nframe() - 1L))) + + if (convert_to_integer64(e1)) { + "integer64" + } else { + class(e1)[1L] + } + } else { + if (!is.numeric(unclass(e1)) && !is.logical(e1) && !is.complex(e1) && !inherits(e1, "POSIXt")) + stop(errorCondition(gettext("non-numeric argument to binary operator", domain="R"), call=sys.call(sys.nframe() - 1L))) + if (!is.numeric(unclass(e2)) && !is.logical(e2) && !is.complex(e2) && !inherits(e2, "POSIXt")) + stop(errorCondition(gettext("non-numeric argument to binary operator", domain="R"), call=sys.call(sys.nframe() - 1L))) + + conv_to_int1 = convert_to_integer64(e1) + if (conv_to_int1 && convert_to_integer64(e2)) { + "integer64" + } else if (conv_to_int1) { + class(e2)[1L] + } else { + class(e1)[1L] + } + } +} + +#' @rawNamespace if (getRversion() >= "4.3.0") S3method(chooseOpsMethod,integer64) +chooseOpsMethod.integer64 = function(x, y, mx, my, cl, reverse) { + TRUE +} + +#' @rdname ops64 +#' @exportS3Method `+` integer64 +`+.integer64` = function(e1, e2) { + if (missing(e2)) + return(e1) + + target_class = target_class_for_Ops(e1, e2) + if (target_class != "integer64") { + if (is.integer64(e1)) + e1 = .as_double_integer64(e1, keep.attributes=TRUE) + else + e2 = .as_double_integer64(e2, keep.attributes=TRUE) + return(e1 + e2) + } + + a = binattr(e1, e2) + l1 = length(e1) + l2 = length(e2) + l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) + ret = .Call(C_plus_integer64, as.integer64(e1), as.integer64(e2), double(l)) + a$class = plusclass(a$class, "integer64") + attributes(ret) = a + ret +} + +#' @rdname ops64 +#' @exportS3Method `-` integer64 +`-.integer64` = function(e1, e2) { + if (missing(e2)) { + if (!is.integer64(e1)) + return(-e1) + e2 = e1 + e1 = as.integer64(0L) + } else { + target_class = target_class_for_Ops(e1, e2) + if (target_class != "integer64") { + if (is.integer64(e1)) + e1 = .as_double_integer64(e1, keep.attributes=TRUE) + else + e2 = .as_double_integer64(e2, keep.attributes=TRUE) + return(e1 - e2) + } + } + + a = binattr(e1, e2) + l1 = length(e1) + l2 = length(e2) + l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) + ret = .Call(C_minus_integer64, as.integer64(e1), as.integer64(e2), double(l)) + a$class = plusclass(a$class, "integer64") + attributes(ret) = a + ret +} + +#' @rdname ops64 +#' @exportS3Method `%/%` integer64 +`%/%.integer64` = function(e1, e2) { + target_class = target_class_for_Ops(e1, e2) + if (target_class != "integer64") { + if (is.integer64(e1)) + e1 = .as_double_integer64(e1, keep.attributes=TRUE) + else + e2 = .as_double_integer64(e2, keep.attributes=TRUE) + return(e1 %/% e2) + } + + a = binattr(e1, e2) + l1 = length(e1) + l2 = length(e2) + l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) + ret = .Call(C_intdiv_integer64, as.integer64(e1), as.integer64(e2), double(l)) + a$class = plusclass(a$class, "integer64") + attributes(ret) = a + ret +} + +#' @rdname ops64 +#' @exportS3Method `%%` integer64 +`%%.integer64` = function(e1, e2) { + target_class = target_class_for_Ops(e1, e2) + if (target_class != "integer64") { + if (is.integer64(e1)) + e1 = .as_double_integer64(e1, keep.attributes=TRUE) + else + e2 = .as_double_integer64(e2, keep.attributes=TRUE) + return(e1 %% e2) + } + + a = binattr(e1, e2) + l1 = length(e1) + l2 = length(e2) + l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) + ret = .Call(C_mod_integer64, as.integer64(e1), as.integer64(e2), double(l)) + a$class = plusclass(a$class, "integer64") + attributes(ret) = a + ret +} + +#' @rdname ops64 +#' @exportS3Method `*` integer64 +`*.integer64` = function(e1, e2) { + target_class = target_class_for_Ops(e1, e2) + if (target_class != "integer64") { + if (is.integer64(e1)) + e1 = .as_double_integer64(e1, keep.attributes=TRUE) + else + e2 = .as_double_integer64(e2, keep.attributes=TRUE) + return(e1 * e2) + } + + a = binattr(e1, e2) + l1 = length(e1) + l2 = length(e2) + l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) + if (getOption("integer64_semantics", "old") == "old") { + if (is.double(e2)) # implies !is.integer64(e2) + ret = .Call(C_times_integer64_double, as.integer64(e1), e2, double(l)) + else + ret = .Call(C_times_integer64_integer64, as.integer64(e1), as.integer64(e2), double(l)) + } else { + # nolint next: unnecessary_nesting_linter. Good parallelism, and on a to-be-deprecated code path. + if (is.double(e2)) # implies !is.integer64(e2) + ret = .Call(C_times_integer64_double, as.integer64(e1), e2, double(l)) + else if (is.double(e1)) + ret = .Call(C_times_integer64_double, as.integer64(e2), e1, double(l)) + else + ret = .Call(C_times_integer64_integer64, as.integer64(e1), as.integer64(e2), double(l)) + } + a$class = plusclass(a$class, "integer64") + attributes(ret) = a + ret +} + +#' @rdname ops64 +#' @exportS3Method `^` integer64 +`^.integer64` = function(e1, e2) { + target_class = target_class_for_Ops(e1, e2) + if (target_class != "integer64") { + if (is.integer64(e1)) + e1 = .as_double_integer64(e1, keep.attributes=TRUE) + else + e2 = .as_double_integer64(e2, keep.attributes=TRUE) + return(e1 ^ e2) + } + + a = binattr(e1, e2) + l1 = length(e1) + l2 = length(e2) + l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) + if (is.double(e2)) { + ret = .Call(C_power_integer64_double, e1, e2, double(l)) + } else { + ret = .Call(C_power_integer64_integer64, as.integer64(e1), as.integer64(e2), double(l)) + } + a$class = plusclass(a$class, "integer64") + attributes(ret) = a + ret +} + +#' @rdname ops64 +#' @exportS3Method `/` integer64 +`/.integer64` = function(e1, e2) { + target_class = target_class_for_Ops(e1, e2) + if (target_class != "integer64") { + if (is.integer64(e1)) + e1 = .as_double_integer64(e1, keep.attributes=TRUE) + else + e2 = .as_double_integer64(e2, keep.attributes=TRUE) + return(e1 / e2) + } + + a = binattr(e1, e2) + l1 = length(e1) + l2 = length(e2) + l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) + if (getOption("integer64_semantics", "old") == "old") { + if (is.double(e2)) # implies !is.integer64(e2) + ret = .Call(C_divide_integer64_double, as.integer64(e1), e2, double(l)) + else + ret = .Call(C_divide_integer64_integer64, as.integer64(e1), as.integer64(e2), double(l)) + } else { + # nolint next: unnecessary_nesting_linter. Good parallelism, and on a to-be-deprecated code path. + if (is.double(e2)) # implies !is.integer64(e2) + ret = .Call(C_divide_integer64_double, as.integer64(e1), e2, double(l)) + else if (is.double(e1)) + ret = .Call(C_divide_double_integer64, e1, e2, double(l)) + else + ret = .Call(C_divide_integer64_integer64, as.integer64(e1), as.integer64(e2), double(l)) + } + a$class = minusclass(a$class, "integer64") + attributes(ret) = a + ret +} + +#' @rdname ops64 +#' @exportS3Method `==` integer64 +`==.integer64` = function(e1, e2) { + target_class = target_class_for_Ops(e1, e2) + if (target_class != "integer64") { + if (is.integer64(e1)) + e1 = .as_double_integer64(e1, keep.attributes=TRUE) + else + e2 = .as_double_integer64(e2, keep.attributes=TRUE) + return(e1 == e2) + } + + a = binattr(e1, e2) + l1 = length(e1) + l2 = length(e2) + l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) + ret = .Call(C_EQ_integer64, as.integer64(e1), as.integer64(e2), logical(l)) + names(ret) = a$names + ret +} + +#' @rdname ops64 +#' @exportS3Method `!=` integer64 +`!=.integer64` = function(e1, e2) { + target_class = target_class_for_Ops(e1, e2) + if (target_class != "integer64") { + if (is.integer64(e1)) + e1 = .as_double_integer64(e1, keep.attributes=TRUE) + else + e2 = .as_double_integer64(e2, keep.attributes=TRUE) + return(e1 != e2) + } + + a = binattr(e1, e2) + l1 = length(e1) + l2 = length(e2) + l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) + ret = .Call(C_NE_integer64, as.integer64(e1), as.integer64(e2), logical(l)) + names(ret) = a$names + ret +} + +#' @rdname ops64 +#' @exportS3Method `<` integer64 +`<.integer64` = function(e1, e2) { + target_class = target_class_for_Ops(e1, e2) + if (target_class != "integer64") { + if (is.integer64(e1)) + e1 = .as_double_integer64(e1, keep.attributes=TRUE) + else + e2 = .as_double_integer64(e2, keep.attributes=TRUE) + return(e1 < e2) + } + + a = binattr(e1, e2) + l1 = length(e1) + l2 = length(e2) + l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) + ret = .Call(C_LT_integer64, as.integer64(e1), as.integer64(e2), logical(l)) + names(ret) = a$names + ret +} + +#' @rdname ops64 +#' @exportS3Method `<=` integer64 +`<=.integer64` = function(e1, e2) { + target_class = target_class_for_Ops(e1, e2) + if (target_class != "integer64") { + if (is.integer64(e1)) + e1 = .as_double_integer64(e1, keep.attributes=TRUE) + else + e2 = .as_double_integer64(e2, keep.attributes=TRUE) + return(e1 <= e2) + } + + a = binattr(e1, e2) + l1 = length(e1) + l2 = length(e2) + l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) + ret = .Call(C_LE_integer64, as.integer64(e1), as.integer64(e2), logical(l)) + names(ret) = a$names + ret +} + +#' @rdname ops64 +#' @exportS3Method `>` integer64 +`>.integer64` = function(e1, e2) { + target_class = target_class_for_Ops(e1, e2) + if (target_class != "integer64") { + if (is.integer64(e1)) + e1 = .as_double_integer64(e1, keep.attributes=TRUE) + else + e2 = .as_double_integer64(e2, keep.attributes=TRUE) + return(e1 > e2) + } + + a = binattr(e1, e2) + l1 = length(e1) + l2 = length(e2) + l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) + ret = .Call(C_GT_integer64, as.integer64(e1), as.integer64(e2), logical(l)) + names(ret) = a$names + ret +} + +#' @rdname ops64 +#' @exportS3Method `>=` integer64 +`>=.integer64` = function(e1, e2) { + target_class = target_class_for_Ops(e1, e2) + if (target_class != "integer64") { + if (is.integer64(e1)) + e1 = .as_double_integer64(e1, keep.attributes=TRUE) + else + e2 = .as_double_integer64(e2, keep.attributes=TRUE) + return(e1 >= e2) + } + + a = binattr(e1, e2) + l1 = length(e1) + l2 = length(e2) + l = if (l1 == 0L || l2 == 0L) 0L else max(l1, l2) + ret = .Call(C_GE_integer64, as.integer64(e1), as.integer64(e2), logical(l)) + names(ret) = a$names + ret +} + +#' @rdname ops64 +#' @exportS3Method `&` integer64 +`&.integer64` = function(e1, e2) { + target_class = target_class_for_Ops(e1, e2) + if (target_class != "integer64") { + if (is.integer64(e1)) + e1 = .as_double_integer64(e1, keep.attributes=TRUE) + else + e2 = .as_double_integer64(e2, keep.attributes=TRUE) + return(e1 & e2) + } + + a = binattr(e1, e2) + ret = as.logical(e1) & as.logical(e2) + names(ret) = a$names + ret +} + +#' @rdname ops64 +#' @exportS3Method `|` integer64 +`|.integer64` = function(e1, e2) { + target_class = target_class_for_Ops(e1, e2) + if (target_class != "integer64") { + if (is.integer64(e1)) + e1 = .as_double_integer64(e1, keep.attributes=TRUE) + else + e2 = .as_double_integer64(e2, keep.attributes=TRUE) + return(e1 | e2) + } + + a = binattr(e1, e2) + ret = as.logical(e1) | as.logical(e2) + names(ret) = a$names + ret +} + +#' @rdname ops64 +#' @exportS3Method `!` integer64 +`!.integer64` = function(x) { + a = attributes(x) + ret = !as.logical(x) + names(ret) = a$names + ret +} diff --git a/man/bit64-package.Rd b/man/bit64-package.Rd index b0d122a3..0621ff91 100644 --- a/man/bit64-package.Rd +++ b/man/bit64-package.Rd @@ -160,35 +160,55 @@ integers, we usually return \code{integer64} from functions involving \code{inte example in \code{\link[=c.integer64]{c()}}, \code{\link[=cbind.integer64]{cbind()}}, and \code{\link[=rbind.integer64]{rbind()}} -Different from Base R, our operators \code{\link[=+.integer64]{+}}, \code{\link[=-.integer64]{-}}, -\code{\link[=xor.integer64]{\%/\%}}, and \code{\link[=xor.integer64]{\%\%}} coerce their arguments to -\code{integer64} and always return \code{integer64}. - -The multiplication operator \code{\link[=*.integer64]{*}} coerces its first argument to -\code{integer64} but allows its second argument to be also \code{double}: the second -argument is internaly coerced to 'long double' and the result of the -multiplication is returned as \code{integer64}. - -The division \code{\link[=/.integer64]{/}} and power \code{\link[=^.integer64]{^}} operators also -coerce their first argument to \code{integer64} and coerce internally their second -argument to 'long double', they return as \code{double}, like +Our operators \code{\link[=ops64]{+}}, \code{\link[=ops64]{-}}, \code{\link[=ops64]{\%/\%}}, and \code{\link[=ops64]{\%\%}} coerce +their arguments to \code{integer64} and return \code{integer64} if they are \code{integer}, +\code{double} or \code{logical}. Otherwise the \code{integer64} argument is coerced to double and +the R base method for the other class is called. + +Our operators \code{\link[=ops64]{*}} and \code{\link[=ops64]{^}} coerce their first argument to +\code{integer64} and possibly the second to \code{integer64} if it is not \code{double} and +return \code{integer64} if they are \code{integer}, \code{double} or \code{logical}. Otherwise the +\code{integer64} argument is coerced to double and the R base method for the other +class is called. + +The division \code{\link[=ops64]{/}} operator also coerces its first argument to \code{integer64} +and possibly the second to \code{integer64} if it is not \code{double} and returns +\code{integer64} if they are \code{integer}, \code{double} or \code{logical}. Otherwise the \code{integer64} +argument is coerced to double and the R base method for the other class is called. + \code{\link[=sqrt.integer64]{sqrt()}}, \code{\link[=log.integer64]{log()}}, -\code{\link[=log2.integer64]{log2()}}, and \code{\link[=log10.integer64]{log10()}} do.\tabular{ccccccccc}{ +\code{\link[=log2.integer64]{log2()}}, and \code{\link[=log10.integer64]{log10()}} coerce their first +argument to \code{integer64} and coerce internally their second argument to +'long double', they return as \code{double}\tabular{ccccccccc}{ \strong{argument1} \tab \strong{op} \tab \strong{argument2} \tab \strong{->} \tab \strong{coerced1} \tab \strong{op} \tab \strong{coerced2} \tab \strong{->} \tab \strong{result} \cr integer64 \tab + \tab double \tab -> \tab integer64 \tab + \tab integer64 \tab -> \tab integer64 \cr double \tab + \tab integer64 \tab -> \tab integer64 \tab + \tab integer64 \tab -> \tab integer64 \cr + integer64 \tab + \tab complex \tab -> \tab double \tab + \tab complex \tab -> \tab complex \cr + complex \tab + \tab integer64 \tab -> \tab complex \tab + \tab double \tab -> \tab complex \cr integer64 \tab - \tab double \tab -> \tab integer64 \tab - \tab integer64 \tab -> \tab integer64 \cr double \tab - \tab integer64 \tab -> \tab integer64 \tab - \tab integer64 \tab -> \tab integer64 \cr + integer64 \tab - \tab complex \tab -> \tab double \tab - \tab complex \tab -> \tab complex \cr + complex \tab - \tab integer64 \tab -> \tab complex \tab - \tab double \tab -> \tab complex \cr integer64 \tab \%/\% \tab double \tab -> \tab integer64 \tab \%/\% \tab integer64 \tab -> \tab integer64 \cr double \tab \%/\% \tab integer64 \tab -> \tab integer64 \tab \%/\% \tab integer64 \tab -> \tab integer64 \cr + integer64 \tab \%/\% \tab complex \tab -> \tab double \tab \%/\% \tab complex \tab -> \tab complex \cr + complex \tab \%/\% \tab integer64 \tab -> \tab complex \tab \%/\% \tab double \tab -> \tab complex \cr integer64 \tab \%\% \tab double \tab -> \tab integer64 \tab \%\% \tab integer64 \tab -> \tab integer64 \cr double \tab \%\% \tab integer64 \tab -> \tab integer64 \tab \%\% \tab integer64 \tab -> \tab integer64 \cr + integer64 \tab \%\% \tab complex \tab -> \tab double \tab \%\% \tab complex \tab -> \tab complex \cr + complex \tab \%\% \tab integer64 \tab -> \tab complex \tab \%\% \tab double \tab -> \tab complex \cr integer64 \tab * \tab double \tab -> \tab integer64 \tab * \tab long double \tab -> \tab integer64 \cr double \tab * \tab integer64 \tab -> \tab integer64 \tab * \tab integer64 \tab -> \tab integer64 \cr + integer64 \tab * \tab complex \tab -> \tab double \tab * \tab complex \tab -> \tab complex \cr + complex \tab * \tab integer64 \tab -> \tab complex \tab * \tab double \tab -> \tab complex \cr integer64 \tab / \tab double \tab -> \tab integer64 \tab / \tab long double \tab -> \tab double \cr double \tab / \tab integer64 \tab -> \tab integer64 \tab / \tab long double \tab -> \tab double \cr - integer64 \tab ^ \tab double \tab -> \tab integer64 \tab / \tab long double \tab -> \tab double \cr - double \tab ^ \tab integer64 \tab -> \tab integer64 \tab / \tab long double \tab -> \tab double \cr + integer64 \tab / \tab complex \tab -> \tab double \tab / \tab complex \tab -> \tab complex \cr + complex \tab / \tab integer64 \tab -> \tab complex \tab / \tab double \tab -> \tab complex \cr + integer64 \tab ^ \tab double \tab -> \tab integer64 \tab ^ \tab long double \tab -> \tab double \cr + double \tab ^ \tab integer64 \tab -> \tab integer64 \tab ^ \tab long double \tab -> \tab double \cr + integer64 \tab ^ \tab complex \tab -> \tab double \tab ^ \tab complex \tab -> \tab complex \cr + complex \tab ^ \tab integer64 \tab -> \tab complex \tab ^ \tab double \tab -> \tab complex \cr integer64 \tab \%*\% \tab double \tab -> \tab integer64 \tab \%*\% \tab integer64 \tab -> \tab integer64 \cr double \tab \%*\% \tab integer64 \tab -> \tab integer64 \tab \%*\% \tab integer64 \tab -> \tab integer64 \cr integer64 \tab \%*\% \tab complex \tab -> \tab double \tab \%*\% \tab complex \tab -> \tab complex \cr @@ -286,8 +306,8 @@ For all available methods on \code{integer64} vectors see the index below and th \code{\link{*.integer64}} \tab \code{\link{*}} \tab returns integer64 \cr \code{\link{^.integer64}} \tab \code{\link{^}} \tab returns double \cr \code{\link{/.integer64}} \tab \code{\link{/}} \tab returns double \cr - \code{\link[=xor.integer64]{\%/\%}} \tab \code{\link[=Arithmetic]{\%/\%}} \tab returns integer64 \cr - \code{\link[=xor.integer64]{\%\%}} \tab \code{\link[=Arithmetic]{\%\%}} \tab returns integer64 \cr + \code{\link[=ops64]{\%/\%}} \tab \code{\link[=Arithmetic]{\%/\%}} \tab returns integer64 \cr + \code{\link[=ops64]{\%\%}} \tab \code{\link[=Arithmetic]{\%\%}} \tab returns integer64 \cr } \tabular{rrl}{ \strong{comparison operators} \tab \strong{see also} \tab \strong{description} \cr @@ -304,8 +324,7 @@ For all available methods on \code{integer64} vectors see the index below and th \strong{logical operators} \tab \strong{see also} \tab \strong{description} \cr \code{\link{!.integer64}} \tab \code{\link{!}} \tab \cr \code{\link{&.integer64}} \tab \code{\link{&}} \tab \cr -\code{\link[=xor.integer64]{|.integer64}} \tab \code{\link[base:Logic]{|}} \tab \cr -\code{\link{xor.integer64}} \tab \code{\link[=xor]{xor()}} \tab \cr +\code{\link{|.integer64}} \tab \code{\link[base:Logic]{|}} \tab \cr }\tabular{rrl}{ \strong{math functions} \tab \strong{see also} \tab \strong{description} \cr \code{\link[=is.na.integer64]{is.na.integer64()}} \tab \code{\link[=is.na]{is.na()}} \tab returns logical \cr @@ -420,18 +439,6 @@ and it will return \code{FALSE} on \code{integer64}. and it does not recursively dispatch the proper method when called with argument \code{recursive=TRUE}. Therefore \code{c(list(integer64, integer64))} does not work and for now you can only call \code{c.integer64(list(x, x))}. -\item \strong{generic binary operators} fail to dispatch \emph{any} user-defined S3 method -if the two arguments have two different S3 classes. For example we have two -classes \code{\link[bit:bit]{bit::bit}} and \code{\link[bit:bitwhich]{bit::bitwhich}} sparsely representing boolean vectors -and we have methods \code{\link[bit:xor]{&.bit}} and -\code{\link[bit:xor]{&.bitwhich}}. For an expression involving both as in -\code{bit & bitwhich}, none of the two methods is dispatched. Instead a standard -method is dispatched, which neither handles \code{bit} nor \code{bitwhich}. Although -it lacks symmetry, the better choice would be to dispatch simply the method -of the class of the first argument in case of class conflict. This choice would -allow authors of extension packages providing coherent behaviour at least within -their contributed classes. But as long as none of the package author's methods is -dispatched, they cannot handle the conflicting classes at all. \item \strong{\code{\link[=unlist]{unlist()}}} is not generic and if it were, we would face similar problems as with \code{\link[=c]{c()}} \item \strong{\code{\link[=vector]{vector()}}} with argument \code{mode='integer64'} cannot work without adjustment @@ -741,6 +748,7 @@ Other contributors: \itemize{ \item Leonardo Silvestri [contributor] \item Ofek Shilon [contributor] + \item Christian Ullerich [contributor] } } diff --git a/man/format.integer64.Rd b/man/format.integer64.Rd index 729d1c62..e48c0588 100644 --- a/man/format.integer64.Rd +++ b/man/format.integer64.Rd @@ -18,7 +18,6 @@ \alias{is.finite.integer64} \alias{is.infinite.integer64} \alias{is.nan.integer64} -\alias{!.integer64} \title{Unary operators and functions for integer64 vectors} \usage{ \method{format}{integer64}(x, justify = "right", ...) @@ -54,8 +53,6 @@ \method{is.infinite}{integer64}(x) \method{is.nan}{integer64}(x) - -\method{!}{integer64}(x) } \arguments{ \item{x}{an atomic vector of class 'integer64'} @@ -95,7 +92,7 @@ Unary operators and functions for integer64 vectors. sqrt(as.integer64(1:12)) } \seealso{ -\code{\link[=xor.integer64]{xor.integer64()}} \code{\link[=integer64]{integer64()}} +\link{ops64} \code{\link[=integer64]{integer64()}} } \keyword{classes} \keyword{manip} diff --git a/man/xor.integer64.Rd b/man/ops64.Rd similarity index 64% rename from man/xor.integer64.Rd rename to man/ops64.Rd index 4f2e3b83..7bad525e 100644 --- a/man/xor.integer64.Rd +++ b/man/ops64.Rd @@ -1,7 +1,7 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/integer64.R -\name{xor.integer64} -\alias{xor.integer64} +% Please edit documentation in R/ops64.R +\name{ops64} +\alias{ops64} \alias{binattr} \alias{+.integer64} \alias{-.integer64} @@ -18,6 +18,7 @@ \alias{>=.integer64} \alias{&.integer64} \alias{|.integer64} +\alias{!.integer64} \title{Binary operators for integer64 vectors} \usage{ binattr(e1, e2) @@ -52,25 +53,17 @@ binattr(e1, e2) \method{|}{integer64}(e1, e2) -\method{xor}{integer64}(x, y) +\method{!}{integer64}(x) } \arguments{ -\item{e1}{an atomic vector of class 'integer64'} - -\item{e2}{an atomic vector of class 'integer64'} - -\item{x}{an atomic vector of class 'integer64'} - -\item{y}{an atomic vector of class 'integer64'} +\item{e1, e2, x}{numeric or complex vectors or objects which can be coerced to such, or other objects for which methods have been written for - especially 'integer64' vectors.} } \value{ -\code{\link{&}}, \code{\link{|}}, \code{\link[bit:xor]{bit::xor()}}, \code{\link{!=}}, \code{\link{==}}, -\code{\link{<}}, \code{\link{<=}}, \code{\link{>}}, \code{\link{>=}} return a logical vector +\code{\link{&}}, \code{\link{|}}, \code{\link{!}}, \code{\link{!=}}, \code{\link{==}}, \code{\link{<}}, \code{\link{<=}}, \code{\link{>}}, \code{\link{>=}} return a logical vector -\code{\link{^}} and \code{\link{/}} return a double vector +\code{\link{/}} returns a double vector -\code{\link{+}}, \code{\link{-}}, \code{\link{*}}, \code{\link[=Arithmetic]{\%/\%}}, \code{\link[=Arithmetic]{\%\%}} -return a vector of class 'integer64' +\code{\link{+}}, \code{\link{-}}, \code{\link{*}}, \code{\link[=Arithmetic]{\%/\%}}, \code{\link[=Arithmetic]{\%\%}}, \code{\link{^}} return a vector of class 'integer64' or different class depending on the operands } \description{ Binary operators for integer64 vectors. @@ -89,7 +82,7 @@ Binary operators for integer64 vectors. i*d # old: 13 } \seealso{ -\code{\link[=format.integer64]{format.integer64()}} \code{\link[=integer64]{integer64()}} +\code{\link[=integer64]{integer64()}} } \keyword{classes} \keyword{manip} diff --git a/tests/testthat/test-bit64-package.R b/tests/testthat/test-bit64-package.R index 20f6fc32..40e7c0f5 100644 --- a/tests/testthat/test-bit64-package.R +++ b/tests/testthat/test-bit64-package.R @@ -19,40 +19,6 @@ test_that("Dispatch on the second argument fails and we want to be notified once expect_false(identical.integer64(c(NA, integer64(0L)), as.integer64(NA))) }) -test_that("Minus and plus", { - d64 = c( - -.Machine$double.base^.Machine$double.digits, - -.Machine$integer.max, - -1.0, 0.0, 1.0, - .Machine$integer.max, - .Machine$double.base^.Machine$double.digits - ) - i64 = as.integer64(d64) - expect_true(identical.integer64(i64 - 1.0 + 1.0, i64)) - expect_true(identical.integer64(i64 + 1.0 - 1.0, i64)) -}) - -test_that("Minus and plus edge cases and 'rev'", { - # UBSAN signed integer overflow expected for type 'long long int' - # This is a false UBSAN alarm because overflow is detected and NA returned - expect_warning( - expect_true( - identical.integer64(lim.integer64() + 1.0 - 1.0, - c(lim.integer64()[1L], NA)) - ), - "NAs produced by integer64 overflow", - fixed = TRUE - ) - expect_warning( - expect_true( - identical.integer64(rev(lim.integer64()) - 1.0 + 1.0, - c(lim.integer64()[2L], NA)) - ), - "NAs produced by integer64 overflow", - fixed = TRUE - ) -}) - test_that("'range.integer64', multiplication, integer division, sqrt, power, and log", { i64 = integer64(63L) i64[1L] = 1.0 @@ -314,36 +280,6 @@ test_that("Coercion works for cases requiring recent R", { ) }) -test_that("Logical operators", { - expect_true(identical.integer64( - !c(NA, -1:1), - !c(as.integer64(NA), -1:1) - )) - - xi = rep(c(NA, -1:1), 4L) - xi64 = as.integer64(xi) - yi = rep(c(NA, -1:1), each=4L) - yi64 = as.integer64(yi) - - expect_true(identical.integer64(xi64 & yi64, xi & yi)) - expect_true(identical.integer64(xi64 | yi64, xi | yi)) - expect_true(identical.integer64(xor(xi64, yi64), xor(xi, yi))) -}) - -test_that("Comparison operators", { - xi = rep(c(NA, -1:1), 4L) - xi64 = as.integer64(xi) - yi = rep(c(NA, -1:1), each=4L) - yi64 = as.integer64(yi) - - expect_true(identical.integer64(xi64 == yi64, xi == yi)) - expect_true(identical.integer64(xi64 != yi64, xi != yi)) - expect_true(identical.integer64(xi64 > yi64, xi > yi)) - expect_true(identical.integer64(xi64 >= yi64, xi >= yi)) - expect_true(identical.integer64(xi64 < yi64, xi < yi)) - expect_true(identical.integer64(xi64 <= yi64, xi <= yi)) -}) - test_that("Vector functions", { xi = c(NA, -1:1) xi64 = as.integer64(xi) diff --git a/tests/testthat/test-integer64.R b/tests/testthat/test-integer64.R index 93a865c5..7420398b 100644 --- a/tests/testthat/test-integer64.R +++ b/tests/testthat/test-integer64.R @@ -243,17 +243,6 @@ test_that("arithmetic & basic math works", { x = as.integer64(1:10) y = as.integer64(10:1) - expect_identical(x + y, as.integer64(rep(11L, 10L))) - expect_identical(y - x, as.integer64(seq(9L, -9L, by=-2L))) - expect_identical(x * y, as.integer64(c(10L, 18L, 24L, 28L, 30L, 30L, 28L, 24L, 18L, 10L))) - # output is double even though it fits in integer [and integer64] - expect_identical(x[seq(2L, 10L, by=2L)] / 2L, as.double(1:5)) - expect_identical(x ^ 2L, as.integer64((1:10)^2L)) - expect_identical(-x, as.integer64(-(1:10))) - - expect_identical(x %/% 2L, as.integer64(c(0L, 1L, 1L, 2L, 2L, 3L, 3L, 4L, 4L, 5L))) - expect_identical(x %% 2L, as.integer64(rep_len(c(1L, 0L), 10L))) - expect_identical(sign(x - 6L), as.integer64(rep(c(-1L, 0L, 1L), c(5L, 1L, 4L)))) expect_identical(abs(x - 6.0), as.integer64(c(5:0, 1:4))) @@ -270,10 +259,6 @@ test_that("arithmetic & basic math works", { expect_identical(round(x), x) expect_identical(round(x, -1L), as.integer64(rep(c(0L, 10L), each=5L))) - - # regression snuck through, caught by #149 - expect_identical(as.integer64(1L) * 1:5, as.integer64(1:5)) - expect_identical(1:5 * as.integer64(1L), as.integer64(1:5)) }) test_that("basic statistics work", { @@ -653,105 +638,12 @@ test_that("empty inputs give empty outputs for arithmetic", { x = integer64(1L) empty = integer64(0L) - expect_identical(x+empty, integer64()) - expect_identical(empty+x, integer64()) - - expect_identical(x-empty, integer64()) - expect_identical(empty-x, integer64()) - - expect_identical(+empty, integer64()) - expect_identical(-empty, integer64()) - - expect_identical(x*empty, integer64()) - expect_identical(empty*x, integer64()) - - expect_identical(x/empty, double()) - expect_identical(empty/x, double()) - - expect_identical(x^empty, integer64()) - expect_identical(empty^x, integer64()) - - expect_identical(x %/% empty, integer64()) - expect_identical(empty %/% x, integer64()) - - expect_identical(x%%empty, integer64()) - expect_identical(empty%%x, integer64()) - expect_identical(log(x, base=empty), double()) expect_identical(log(empty, base=x), double()) expect_identical( log(`attr<-`(empty, "asdf", "jkl")), `attr<-`(double(), "asdf", "jkl") ) - - expect_identical(x==empty, logical()) - expect_identical(empty==x, logical()) - - expect_identical(x!=empty, logical()) - expect_identical(empty!=x, logical()) - - expect_identical(x>=empty, logical()) - expect_identical(empty>=x, logical()) - - expect_identical(x<=empty, logical()) - expect_identical(empty<=x, logical()) - - expect_identical(x>empty, logical()) - expect_identical(empty>x, logical()) - - expect_identical(x=empty, logical()) + expect_identical(empty>=x, logical()) + + expect_identical(x<=empty, logical()) + expect_identical(empty<=x, logical()) + + expect_identical(x>empty, logical()) + expect_identical(empty>x, logical()) + + expect_identical(x yi64, xi > yi)) + expect_true(identical.integer64(xi64 >= yi64, xi >= yi)) + expect_true(identical.integer64(xi64 < yi64, xi < yi)) + expect_true(identical.integer64(xi64 <= yi64, xi <= yi)) +}) + +with_parameters_test_that("ops with different classes in combination with integer64 (returning integer64):", local({ + + # TODO(#248): uncomment when fixed: as.integer64(-10L)%%7L = -3L vs. as.integer(-10L)%%7L = 4L + # x32 = c(-10:-1, 1:10) + x32 = 1:10 + x64 = as.integer64(x32) + set.seed(42) + y = sample(x32) + eval(parse(text=paste0("y = as.", class, "(y)"))) + + eval(parse(text=paste0("test_e = tryCatch(`", operator, "`", "(x32, y), error=conditionMessage)"))) + eval(parse(text=paste0("test_a = tryCatch(`", operator, "`", "(x64, y), error=conditionMessage)"))) + if (operator %in% c("/", "<", "<=", "==", ">=", ">", "!=", "&", "|", "xor")) + expect_identical(test_a, test_e) + else + expect_identical(test_a, as.integer64(test_e)) + + eval(parse(text=paste0("test_e = tryCatch(`", operator, "`", "(y, x32), error=conditionMessage)"))) + eval(parse(text=paste0("test_a = tryCatch(`", operator, "`", "(y, x64), error=conditionMessage)"))) + if (operator %in% c("/", "<", "<=", "==", ">=", ">", "!=", "&", "|", "xor")) + expect_identical(test_a, test_e) + else + expect_identical(test_a, as.integer64(test_e)) + + }), + .cases=expand.grid(operator=c("+", "-", "*", "/", "^", "%%", "%/%", "<", "<=", "==", ">=", ">", "!=", "&", "|", "xor"), class=c("integer", "double", "logical")) +) + +with_parameters_test_that("ops with different classes in combination with integer64 (not returning integer64):", local({ + + if (getRversion() >= "4.3.0") { + # TODO(#248): uncomment when fixed: as.integer64(-10L)%%7L = -3L vs. as.integer(-10L)%%7L = 4L + # x32 = c(-10:-1, 1:10) + x32 = 1:10 + x64 = as.integer64(x32) + set.seed(42) + y = sample(x32) + eval(parse(text=paste0("y = as.", class, "(as.double(y)", if (class == "difftime") ", units = \"secs\"", ")"))) + + eval(parse(text=paste0("test_e = tryCatch(`", operator, "`", "(x32, y), error=conditionMessage)"))) + eval(parse(text=paste0("test_a = tryCatch(`", operator, "`", "(x64, y), error=conditionMessage)"))) + expect_identical(test_a, test_e) + + eval(parse(text=paste0("test_e = tryCatch(`", operator, "`", "(y, x32), error=conditionMessage)"))) + eval(parse(text=paste0("test_a = tryCatch(`", operator, "`", "(y, x64), error=conditionMessage)"))) + expect_identical(test_a, test_e) + } + + }), + .cases = expand.grid(operator = c("+", "-", "*", "/", "^", "%%", "%/%", "<", "<=", "==", ">=", ">", "!=", "&", "|", "xor"), class = c("complex", "Date", "POSIXct", "POSIXlt", "difftime")) +) + +test_that("!.integer64", { + x = c(-1:1, NA) + expect_identical(!as.integer64(x), !x) +})