From b40f6c11a44477b2b012e66334cb89cf83bbd2ad Mon Sep 17 00:00:00 2001 From: hcirellu Date: Tue, 25 Nov 2025 16:17:22 +0100 Subject: [PATCH 01/14] add matrix, array, %*%.integer64 refactor str.integer64 for consistent display of matrices refactor colSums and rowSums to be consistent to base --- NAMESPACE | 11 +- NEWS.md | 1 + R/bit64-package.R | 2 +- R/integer64.R | 91 +++++++++++--- R/matrix64.R | 210 ++++++++++++++++++++++++++----- man/extract.replace.integer64.Rd | 5 +- man/matrix64.Rd | 19 ++- src/init.c | 6 + src/integer64.c | 142 +++++++++++++++++++-- tests/testthat/helper.R | 14 +-- tests/testthat/test-matrix64.R | 180 +++++++++++++++++++++++++- 11 files changed, 597 insertions(+), 84 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index c7d7bd5..3034abc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -29,7 +29,8 @@ S3method(abs,integer64) S3method(all,integer64) S3method(all.equal,integer64) S3method(any,integer64) -S3method(aperm,integer64) +S3method(array,default) +S3method(array,integer64) S3method(as.bitstring,integer64) S3method(as.character,integer64) S3method(as.data.frame,integer64) @@ -45,7 +46,10 @@ S3method(as.integer64,integer64) S3method(as.integer64,logical) S3method(as.list,integer64) S3method(as.logical,integer64) +S3method(base::`%*%`,integer64) S3method(base::anyNA,integer64) +S3method(base::aperm,integer64) +S3method(base::as.matrix,integer64) S3method(c,integer64) S3method(cbind,integer64) S3method(ceiling,integer64) @@ -87,6 +91,8 @@ S3method(log10,integer64) S3method(log2,integer64) S3method(match,default) S3method(match,integer64) +S3method(matrix,default) +S3method(matrix,integer64) S3method(max,integer64) S3method(mean,integer64) S3method(median,integer64) @@ -181,6 +187,7 @@ export(abs.integer64) export(all.equal.integer64) export(all.integer64) export(any.integer64) +export(array) export(as.bitstring) export(as.bitstring.integer64) export(as.character.integer64) @@ -255,6 +262,7 @@ export(log.integer64) export(match) export(match.default) export(match.integer64) +export(matrix) export(max.integer64) export(mean.integer64) export(median.integer64) @@ -403,6 +411,7 @@ importFrom(methods,is) importFrom(stats,cor) importFrom(stats,median) importFrom(stats,quantile) +importFrom(utils,getS3method) importFrom(utils,head) importFrom(utils,packageDescription) importFrom(utils,strOptions) diff --git a/NEWS.md b/NEWS.md index 056cc06..188a738 100644 --- a/NEWS.md +++ b/NEWS.md @@ -42,6 +42,7 @@ ## NEW FEATURES 1. `anyNA` gets an `integer64` method. Thanks @hcirellu. +1. `matrix`, `array`, `%*%` and `as.matrix` get an `integer64` method. (#45) ## BUG FIXES diff --git a/R/bit64-package.R b/R/bit64-package.R index d32b917..3e436ad 100644 --- a/R/bit64-package.R +++ b/R/bit64-package.R @@ -697,7 +697,7 @@ #' @importFrom graphics barplot par title #' @importFrom methods as is #' @importFrom stats cor median quantile -#' @importFrom utils head packageDescription strOptions tail +#' @importFrom utils head packageDescription strOptions tail getS3method #' @export : :.default :.integer64 #' @export [.integer64 [[.integer64 [[<-.integer64 [<-.integer64 #' @export %in% %in%.default diff --git a/R/integer64.R b/R/integer64.R index 46c70a1..1f16f4e 100644 --- a/R/integer64.R +++ b/R/integer64.R @@ -116,8 +116,7 @@ NULL #' @seealso [`[`][base::Extract] [integer64()] #' @examples #' as.integer64(1:12)[1:3] -#' x <- as.integer64(1:12) -#' dim(x) <- c(3, 4) +#' x <- matrix(as.integer64(1:12), nrow = 3L) #' x #' x[] #' x[, 2:3] @@ -709,15 +708,25 @@ as.integer64.character <- function(x, ...) { #' @export as.integer64.factor <- function(x, ...) as.integer64(unclass(x), ...) -#' @rdname as.character.integer64 -#' @export -as.double.integer64 <- function(x, keep.names=FALSE, ...) { - ret <- .Call(C_as_double_integer64, x, double(length(x))) - if (keep.names) - names(ret) <- names(x) +.as_double_integer64 = function(x, keep.names=FALSE, keep.attributes=FALSE, ...) { + ret = .Call(C_as_double_integer64, x, double(length(x))) + if (isTRUE(keep.attributes)) { + # like dimensions for matrix operations + a = attributes(x) + a$class = NULL + attributes(ret) = a + keep.names = FALSE # names are already included + } + if (isTRUE(keep.names)) + names(ret) = names(x) ret } +#' @rdname as.character.integer64 +#' @export +as.double.integer64 = function(x, keep.names=FALSE, ...) + .as_double_integer64(x, keep.names, keep.attributes=FALSE, ...) + #' @rdname as.character.integer64 #' @export as.integer.integer64 <- function(x, ...) { @@ -824,19 +833,35 @@ print.integer64 <- function(x, quote=FALSE, ...) { #' @param object an integer64 vector #' @param vec.len,give.head,give.length see [utils::str()] #' @export -str.integer64 <- function(object, - vec.len = strO$vec.len, - give.head = TRUE, - give.length = give.head, - ...) { - strO <- strOptions() - vec.len <- 2L*vec.len - n <- length(object) - if (n > vec.len) - object <- object[seq_len(vec.len)] +str.integer64 = function(object, vec.len=strO$vec.len, give.head=TRUE, give.length=give.head, ...) { + strO = strOptions() + vec.len = 2L*vec.len + n = length(object) + displayObject = object[seq_len(min(vec.len, length(object)))] + cat( - if (give.head) paste0("integer64 ", if (give.length && n>1L) paste0("[1:", n, "] ")), - paste(as.character(object), collapse=" "), + if (isTRUE(give.head)) { + if (length(object) == 0L && is.null(dim(object))) { + "integer64(0)" + } else { + paste0( + "integer64 ", + if (length(object) > 1L && is.null(dim(object))) { + if (isTRUE(give.length)) paste0("[1:", n, "] ") else " " + } else if (!is.null(dim(object))) { + dimO = dim(object) + if (prod(dimO) != n) + stop(gettextf("dims [product %d] do not match the length of object [%d]", prod(dimO), n, domain="R")) + if (length(dimO) == 1L) { + paste0("[", n, "(1d)] ") + } else { + paste0("[", paste(vapply(dimO, function(el) {if (el < 2L) as.character(el) else paste0("1:", el)}, ""), collapse = ", "), "] ") + } + } + ) + } + }, + paste(as.character(displayObject), collapse=" "), if (n > vec.len) " ...", " \n", sep="" @@ -1067,6 +1092,32 @@ seq.integer64 <- function(from=NULL, to=NULL, by=NULL, length.out=NULL, along.wi return(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.calls()[[1]])) + + 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.calls()[[1]])) + if (!is.numeric(unclass(e2)) && !is.logical(e2) && !is.complex(e2)) + stop(errorCondition(gettext("non-numeric argument to binary operator", domain = "R"), call=sys.calls()[[1]])) + + if (is.complex(e1) || is.complex(e2)) { + "complex" + } else { + "integer64" + } + } +} + #' @rdname xor.integer64 #' @export `+.integer64` <- function(e1, e2) { diff --git a/R/matrix64.R b/R/matrix64.R index ee18988..9fd2378 100644 --- a/R/matrix64.R +++ b/R/matrix64.R @@ -19,9 +19,9 @@ #' @param x An array of integer64 numbers. #' @param na.rm,dims Same interpretation as in [colSums()]. #' @param ... Passed on to subsequent methods. +#' @param data,nrow,ncol,byrow,dimnames,dim Arguments for `matrix()` and `array()`. #' @examples -#' A = as.integer64(1:6) -#' dim(A) = 3:2 +#' A = matrix(as.integer64(1:6), 3) #' #' colSums(A) #' rowSums(A) @@ -29,54 +29,206 @@ #' @name matrix64 NULL + +#' @rdname matrix64 +#' @export matrix +matrix = function(data=NA, nrow=1L, ncol=1L, byrow=FALSE, dimnames=NULL) UseMethod("matrix") +#' @exportS3Method matrix default +matrix.default = function(...) { + withCallingHandlers({ + base::matrix(...) + }, warning = function(w) { + sc = sys.call(sys.nframe() - 8L) + if (!is.symbol(sc[[1L]]) || sc[[1L]] != as.symbol("matrix")) + sc = sys.call(sys.nframe() - 7L) + warning(warningCondition(w$message, call=sc)) + invokeRestart("muffleWarning") + }, error = function(e) { + sc = sys.call(sys.nframe() - 5L) + if (!is.symbol(sc[[1L]]) || sc[[1L]] != as.symbol("matrix")) + sc = sys.call(sys.nframe() - 4L) + stop(errorCondition(e$message, call=sc)) + }) +} + +#' @exportS3Method matrix integer64 +matrix.integer64 = function(data=NA_integer64_, ...) { + if (!length(data)) data = NA_integer64_ + ret = withCallingHandlers({ + base::matrix(data, ...) + }, warning = function(w) { + sc = sys.call(sys.nframe() - 8L) + if (!is.symbol(sc[[1L]]) || sc[[1L]] != as.symbol("matrix")) + sc = sys.call(sys.nframe() - 7L) + warning(warningCondition(w$message, call=sc)) + invokeRestart("muffleWarning") + }, error = function(e) { + sc = sys.call(sys.nframe() - 5L) + if (!is.symbol(sc[[1L]]) || sc[[1L]] != as.symbol("matrix")) + sc = sys.call(sys.nframe() - 4L) + stop(errorCondition(e$message, call=sc)) + }) + class(ret) = class(data) + ret +} + + +#' @rdname matrix64 +#' @export array +array = function(data=NA, dim=length(data), dimnames=NULL) UseMethod("array") +#' @exportS3Method array default +array.default = function(...) { + withCallingHandlers({ + base::array(...) + }, warning = function(w) { + sc = sys.call(sys.nframe() - 8L) + if (!is.symbol(sc[[1L]]) || sc[[1L]] != as.symbol("matrix")) + sc = sys.call(sys.nframe() - 7L) + warning(warningCondition(w$message, call=sc)) + invokeRestart("muffleWarning") + }, error = function(e) { + sc = sys.call(sys.nframe() - 5L) + if (!is.symbol(sc[[1L]]) || sc[[1L]] != as.symbol("matrix")) + sc = sys.call(sys.nframe() - 4L) + stop(errorCondition(e$message, call=sc)) + }) +} + +#' @exportS3Method array integer64 +array.integer64 = function(data=NA_integer64_, ...) { + if (!length(data)) data = NA_integer64_ + ret = withCallingHandlers({ + base::array(data, ...) + }, warning = function(w) { + sc = sys.call(sys.nframe() - 8L) + if (!is.symbol(sc[[1L]]) || sc[[1L]] != as.symbol("matrix")) + sc = sys.call(sys.nframe() - 7L) + warning(warningCondition(w$message, call=sc)) + invokeRestart("muffleWarning") + }, error = function(e) { + sc = sys.call(sys.nframe() - 5L) + if (!is.symbol(sc[[1L]]) || sc[[1L]] != as.symbol("matrix")) + sc = sys.call(sys.nframe() - 4L) + stop(errorCondition(e$message, call=sc)) + }) + class(ret) = class(data) + ret +} + + #' @rdname matrix64 #' @export -colSums <- function(x, na.rm=FALSE, dims=1L) UseMethod("colSums") +colSums = function(x, na.rm=FALSE, dims=1L) UseMethod("colSums") #' @rdname matrix64 #' @export -colSums.default <- function(x, na.rm=FALSE, dims=1L) base::colSums(x, na.rm, dims) +colSums.default = function(...) base::colSums(...) #' @rdname matrix64 #' @export -colSums.integer64 <- function(x, na.rm=FALSE, dims=1L) { - n_dim <- length(dim(x)) - stopifnot( - `dims= should be a length-1 integer between 1 and length(dim(x))-1L` = - length(dims) == 1L && dims > 0L && dims < n_dim - ) - MARGIN = tail(seq_len(n_dim), -dims) - ret = apply(x, MARGIN, sum, na.rm = na.rm) - class(ret) = "integer64" +colSums.integer64 = function(x, na.rm=FALSE, dims=1L) { + dn = dim(x) + if (!is.array(x) || length(dn) < 2L) + stop("'x' must be an array of at least two dimensions", domain="R-base") + if (length(dims) != 1L || dims < 1L || dims > length(dn) - 1L) + stop("invalid 'dims'", domain="R-base") + + ret = apply(x, seq_along(dn)[-seq_len(dims)], sum, na.rm=na.rm) + class(ret) = class(x) ret } + #' @rdname matrix64 #' @export -rowSums <- function(x, na.rm=FALSE, dims=1L) UseMethod("rowSums") +rowSums = function(x, na.rm=FALSE, dims=1L) UseMethod("rowSums") #' @rdname matrix64 #' @export -rowSums.default <- function(x, na.rm=FALSE, dims=1L) base::rowSums(x, na.rm, dims) +rowSums.default = function(...) base::rowSums(...) #' @rdname matrix64 #' @export -rowSums.integer64 <- function(x, na.rm=FALSE, dims=1L) { - n_dim <- length(dim(x)) - stopifnot( - `dims= should be a length-1 integer between 1 and length(dim(x))-1L` = - length(dims) == 1L && dims > 0L && dims < n_dim - ) - MARGIN = seq_len(dims) - ret = apply(x, MARGIN, sum, na.rm = na.rm) - class(ret) = "integer64" +rowSums.integer64 = function(x, na.rm=FALSE, dims=1L) { + dn = dim(x) + if (!is.array(x) || length(dn) < 2L) + stop("'x' must be an array of at least two dimensions", domain="R-base") + if (length(dims) != 1L || dims < 1L || dims > length(dn) - 1L) + stop("invalid 'dims'", domain="R-base") + + ret = apply(x, seq_len(dims), sum, na.rm=na.rm) + class(ret) = class(x) ret } + #' @rdname matrix64 #' @param a,perm Passed on to [aperm()]. -#' @export -aperm.integer64 <- function(a, perm, ...) { - class(a) = minusclass(class(a), "integer64") - ret <- aperm(a, perm, ...) - class(ret) = plusclass(class(a), "integer64") +#' @exportS3Method base::aperm integer64 +aperm.integer64 = function(a, perm, ...) { + ret = NextMethod() + class(ret) = class(a) + ret +} + + +#' @exportS3Method base::`%*%` integer64 +`%*%.integer64` = function(x, y) { + if (!is.integer64(x) && !is.integer64(y)) + return(x%*%y) + + target_class = target_class_for_Ops(x, y) + if (target_class != "integer64") { + if (is.integer64(x)) { + for (cc in class(y)) { + f = getS3method("%*%", cc, optional=TRUE) + if (!is.null(f)) + return(f(.as_double_integer64(x, keep.attributes=TRUE), y)) + } + x = .as_double_integer64(x, keep.attributes=TRUE) + } else { + y = .as_double_integer64(y, keep.attributes=TRUE) + } + return(x%*%y) + } + + dx = dim(x) + dy = dim(y) + if (length(dx) > 2L || length(dy) > 2L) + stop("non-conformable arguments", domain="R") + if (length(dx) <= 1L && length(dy) <= 1L) { + dx = c(1L, length(x)) + if (length(x) == length(y)) { + dy = c(length(y), 1L) + } else { + dy = c(1L, length(y)) + } + } + if (length(dx) <= 1L) + dx = c(1L, dy[1L]) + if (length(dy) <= 1L) + dy = c(dx[2L], 1L) + if (dx[2L] != dy[1L]) + stop("non-conformable arguments", domain="R") + dim(x) = dx + dim(y) = dy + + if (is.double(x)) { + ret = .Call(C_matmult_double_integer64, x, structure(as.integer64(y), dim=dy), double(dx[1L]*dy[2L])) + } else if (is.double(y)) { + ret = .Call(C_matmult_integer64_double, structure(as.integer64(x), dim=dx), y, double(dx[1L]*dy[2L])) + } else { + ret = .Call(C_matmult_integer64_integer64, structure(as.integer64(x), dim=dx), structure(as.integer64(y), dim=dy), double(dx[1L]*dy[2L])) + } + dim(ret) = c(dx[1L], dy[2L]) + oldClass(ret) = "integer64" ret } + + +#' @exportS3Method base::as.matrix integer64 +as.matrix.integer64 = function(x, ...) { + if (is.matrix(x)) { + x + } else { + array(x, c(length(x), 1L), {if (!is.null(names(x))) list(names(x), NULL) else NULL}) + } +} diff --git a/man/extract.replace.integer64.Rd b/man/extract.replace.integer64.Rd index 78b0166..eeb420a 100644 --- a/man/extract.replace.integer64.Rd +++ b/man/extract.replace.integer64.Rd @@ -37,11 +37,10 @@ The current implementation returns \code{9218868437227407266} instead of \code{N } \examples{ as.integer64(1:12)[1:3] - x <- as.integer64(1:12) - dim(x) <- c(3,4) + x <- matrix(as.integer64(1:12), nrow = 3L) x x[] - x[,2:3] + x[, 2:3] } \seealso{ \code{\link[base:Extract]{[}} \code{\link[=integer64]{integer64()}} diff --git a/man/matrix64.Rd b/man/matrix64.Rd index 85fd995..f5bf58e 100644 --- a/man/matrix64.Rd +++ b/man/matrix64.Rd @@ -2,6 +2,8 @@ % Please edit documentation in R/matrix64.R \name{matrix64} \alias{matrix64} +\alias{matrix} +\alias{array} \alias{colSums} \alias{colSums.default} \alias{colSums.integer64} @@ -11,28 +13,34 @@ \alias{aperm.integer64} \title{Working with integer64 arrays and matrices} \usage{ +matrix(data = NA, nrow = 1L, ncol = 1L, byrow = FALSE, dimnames = NULL) + +array(data = NA, dim = length(data), dimnames = NULL) + colSums(x, na.rm = FALSE, dims = 1L) -\method{colSums}{default}(x, na.rm = FALSE, dims = 1L) +\method{colSums}{default}(...) \method{colSums}{integer64}(x, na.rm = FALSE, dims = 1L) rowSums(x, na.rm = FALSE, dims = 1L) -\method{rowSums}{default}(x, na.rm = FALSE, dims = 1L) +\method{rowSums}{default}(...) \method{rowSums}{integer64}(x, na.rm = FALSE, dims = 1L) \method{aperm}{integer64}(a, perm, ...) } \arguments{ +\item{data, nrow, ncol, byrow, dimnames, dim}{Arguments for \code{matrix()} and \code{array()}.} + \item{x}{An array of integer64 numbers.} \item{na.rm, dims}{Same interpretation as in \code{\link[=colSums]{colSums()}}.} -\item{a, perm}{Passed on to \code{\link[=aperm]{aperm()}}.} - \item{...}{Passed on to subsequent methods.} + +\item{a, perm}{Passed on to \code{\link[=aperm]{aperm()}}.} } \description{ These functions and methods facilitate working with integer64 @@ -53,8 +61,7 @@ that of \code{colSums()} for integers; feature requests and PRs welcome. \code{FUN} gets applied to a class-stripped version of the input. } \examples{ -A = as.integer64(1:6) -dim(A) = 3:2 +A = matrix(as.integer64(1:6), 3) colSums(A) rowSums(A) diff --git a/src/init.c b/src/init.c index dd67350..3ec0d22 100644 --- a/src/init.c +++ b/src/init.c @@ -51,6 +51,9 @@ extern SEXP logbase_integer64(SEXP, SEXP, SEXP); extern SEXP log_integer64(SEXP, SEXP); extern SEXP logvect_integer64(SEXP, SEXP, SEXP); extern SEXP LT_integer64(SEXP, SEXP, SEXP); +extern SEXP matmult_double_integer64(SEXP, SEXP, SEXP); +extern SEXP matmult_integer64_double(SEXP, SEXP, SEXP); +extern SEXP matmult_integer64_integer64(SEXP, SEXP, SEXP); extern SEXP max_integer64(SEXP, SEXP, SEXP); extern SEXP mean_integer64(SEXP, SEXP, SEXP); extern SEXP min_integer64(SEXP, SEXP, SEXP); @@ -166,6 +169,9 @@ static const R_CallMethodDef CallEntries[] = { {"log_integer64", (DL_FUNC) &log_integer64, 2}, {"logvect_integer64", (DL_FUNC) &logvect_integer64, 3}, {"LT_integer64", (DL_FUNC) <_integer64, 3}, + {"matmult_double_integer64", (DL_FUNC) &matmult_double_integer64, 3}, + {"matmult_integer64_double", (DL_FUNC) &matmult_integer64_double, 3}, + {"matmult_integer64_integer64", (DL_FUNC) &matmult_integer64_integer64, 3}, {"max_integer64", (DL_FUNC) &max_integer64, 3}, {"mean_integer64", (DL_FUNC) &mean_integer64, 3}, {"min_integer64", (DL_FUNC) &min_integer64, 3}, diff --git a/src/integer64.c b/src/integer64.c index bb51aa6..a080167 100644 --- a/src/integer64.c +++ b/src/integer64.c @@ -1003,6 +1003,18 @@ SEXP runif_integer64(SEXP n_, SEXP min_, SEXP max_){ UNPROTECT(1); return ret_; } +/* +require(bit64) +require(microbenchmark) +microbenchmark(runif64(1e6)) + +sort(runif64(1e2)) + + +Unit: milliseconds + expr min lq mean median uq max neval + runif64(1e+06) 24.62306 25.60286 25.61903 25.61369 25.62032 26.40202 100 +*/ SEXP as_list_integer64(SEXP x_){ long long i, n = LENGTH(x_); @@ -1018,15 +1030,127 @@ SEXP as_list_integer64(SEXP x_){ return x_; } -/* -require(bit64) -require(microbenchmark) -microbenchmark(runif64(1e6)) +__attribute__((no_sanitize("signed-integer-overflow"))) SEXP matmult_integer64_integer64(SEXP x_, SEXP y_, SEXP ret_){ + long long i, j, k; + // get dimension of e1 + SEXP dim1 = getAttrib(x_, R_DimSymbol); + long long nrow1 = INTEGER(dim1)[0]; + long long ncol1 = INTEGER(dim1)[1]; + // get dimension of e2 + SEXP dim2 = getAttrib(y_, R_DimSymbol); + long long nrow2 = INTEGER(dim2)[0]; + long long ncol2 = INTEGER(dim2)[1]; -sort(runif64(1e2)) + long long * x = (long long *) REAL(x_); + long long * y = (long long *) REAL(y_); + long long * ret = (long long *) REAL(ret_); + Rboolean naflag = FALSE; + long long cumsum, tempsum, addValue; + + for(i=0; i different error expect_error( rowSums(A64, dims=4L), - "dims= should be a length-1 integer", + "invalid 'dims'", fixed = TRUE ) expect_error( colSums(A64, dims=4L), - "dims= should be a length-1 integer", + "invalid 'dims'", fixed = TRUE ) }) @@ -62,6 +166,26 @@ test_that("out-of-integer-range inputs are handled correctly", { expect_identical(colSums(A64), as.integer64(2L^30L*c(1L+2L+4L, 8L+16L+32L))) }) +test_that("dimnames with colSums and rowSums", { + M32 = matrix(as.integer(1:(3*2)), nrow=3L, ncol=2L, dimnames=list(LETTERS[1:3], letters[1:2])) + A32 = array(as.integer(1:(2*5*3)), dim=c(2, 5, 3), dimnames=list(LETTERS[1:2], letters[1:5], rev(LETTERS)[1:3])) + M64 = matrix(as.integer64(1:(3*2)), nrow=3L, ncol=2L, dimnames=list(LETTERS[1:3], letters[1:2])) + A64 = array(as.integer64(1:(2*5*3)), dim=c(2, 5, 3), dimnames=list(LETTERS[1:2], letters[1:5], rev(LETTERS)[1:3])) + + expect_no_warning(expect_identical(names(colSums(M32)), names(colSums(M64)))) + expect_no_warning(expect_identical(dimnames(colSums(M32)), dimnames(colSums(M64)))) + expect_no_warning(expect_identical(names(colSums(A32)), names(colSums(A64)))) + expect_no_warning(expect_identical(dimnames(colSums(A32)), dimnames(colSums(A64)))) + expect_no_warning(expect_identical(names(colSums(A32, dims=2L)), names(colSums(A64, dims=2L)))) + expect_no_warning(expect_identical(dimnames(colSums(A32, dims=2L)), dimnames(colSums(A64, dims=2L)))) + expect_no_warning(expect_identical(names(rowSums(M32)), names(rowSums(M64)))) + expect_no_warning(expect_identical(dimnames(rowSums(M32)), dimnames(rowSums(M64)))) + expect_no_warning(expect_identical(names(rowSums(A32)), names(rowSums(A64)))) + expect_no_warning(expect_identical(dimnames(rowSums(A32)), dimnames(rowSums(A64)))) + expect_no_warning(expect_identical(names(rowSums(A32, dims=2L)), names(rowSums(A64, dims=2L)))) + expect_no_warning(expect_identical(dimnames(rowSums(A32, dims=2L)), dimnames(rowSums(A64, dims=2L)))) +}) + test_that("aperm works in simple cases", { # example from ?aperm A = array64(1:24, 2:4) @@ -71,3 +195,53 @@ test_that("aperm works in simple cases", { expect_identical(t(B[, , 3L]), A[, , 3L], ignore_attr="class") expect_identical(t(B[, , 4L]), A[, , 4L], ignore_attr="class") }) + +test_that("matrix multiplication", { + m32 = matrix(1:10, 2) + m64 = matrix(as.integer64(m32), nrow(m32)) + mDo = matrix(as.numeric(m32), nrow(m32)) + mCo = matrix(as.complex(m32), nrow(m32)) + expect_error(m32%*%m32, "non-conformable arguments") + expect_error(m64%*%m64, "non-conformable arguments") + expect_identical(m64%*%t(m64), matrix(as.integer64(m32%*%t(m32)), nrow=nrow(m32))) + expect_identical(t(m64)%*%m64, matrix(as.integer64(t(m32)%*%m32), ncol=ncol(m32))) + expect_identical((1:2)%*%m64, matrix(as.integer64((1:2)%*%m32), ncol=ncol(m32))) + expect_identical(m64%*%(1:5), matrix(as.integer64(m32%*%(1:5)), nrow=nrow(m32))) + expect_error((1:2)%*%3L, "non-conformable arguments") + expect_error(as.integer64(1:2)%*%as.integer64(3L), "non-conformable arguments") + expect_identical(as.integer64(1L)%*%(3:4), matrix(as.integer64(3:4), nrow=1L)) + expect_identical(as.integer64(1:2)%*%(3:4), matrix(as.integer64(11L), nrow=1L)) + + expect_identical(m64%*%t(m32), matrix(as.integer64(m32%*%t(m32)), nrow=nrow(m32))) + expect_identical(m32%*%t(m64), matrix(as.integer64(m32%*%t(m32)), nrow=nrow(m32))) + expect_identical(m64%*%t(mDo), matrix(as.integer64(m32%*%t(m32)), nrow=nrow(m32))) + expect_identical(mDo%*%t(m64), matrix(as.integer64(m32%*%t(m32)), nrow=nrow(m32))) + expect_identical(m64%*%t(mCo), matrix(as.complex(m32%*%t(m32)), nrow=nrow(m32))) + expect_identical(mCo%*%t(m64), matrix(as.complex(m32%*%t(m32)), nrow=nrow(m32))) + + expect_error(m64%*%LETTERS[1:5], "non-numeric argument to binary operator", fixed=TRUE) + expect_error(m64%*%as.raw(1:5), "non-numeric argument to binary operator", fixed=TRUE) + + # warning in multiplication part + x = as.integer64("4000000000") + expect_warning(expect_identical(matrix(x, 1)%*%matrix(x, ncol=1), matrix(NA_integer64_, 1, 1)), "NAs produced by integer64 overflow") + # warning in summation part + x = rep_len(as.integer64("3000000000"), 2) + expect_warning(expect_identical(matrix(x, 1)%*%matrix(x, ncol=1), matrix(NA_integer64_, 1, 1)), "NAs produced by integer64 overflow") + +}) + + +test_that("coercion to matrix and array", { + + i32 = 1:10 + i64 = as.integer64(i32) + m64 = matrix(as.integer64(i32), 2L) + + expect_identical(as.matrix(i64), structure(i64, dim = c(length(i64), 1L))) + expect_identical(as.matrix(m64), m64) + + expect_identical(as.array(i64), structure(i64, dim = c(length(i64)))) + expect_identical(as.array(m64), m64) + +}) From e781e137679270393e97a4e26f2411dc9cd443c2 Mon Sep 17 00:00:00 2001 From: hcirellu Date: Wed, 26 Nov 2025 11:31:03 +0100 Subject: [PATCH 02/14] fix sys.call level in target_class_for_Ops --- R/integer64.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/integer64.R b/R/integer64.R index 1f16f4e..54991c3 100644 --- a/R/integer64.R +++ b/R/integer64.R @@ -1097,7 +1097,7 @@ seq.integer64 <- function(from=NULL, to=NULL, by=NULL, length.out=NULL, along.wi 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.calls()[[1]])) + stop(errorCondition(gettext("non-numeric argument to mathematical function", domain = "R"), call=sys.call(sys.nframe() - 1L))) if (is.complex(e1)) { "complex" @@ -1106,9 +1106,9 @@ target_class_for_Ops = function(e1, e2) { } } 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.calls()[[1]])) + 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.calls()[[1]])) + 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" From 400fb45d437cac83b2c2cb9d79f20671cefc7d78 Mon Sep 17 00:00:00 2001 From: hcirellu Date: Wed, 26 Nov 2025 14:33:23 +0100 Subject: [PATCH 03/14] fix tests to run with ubuntu-latest (3.6) and macos-latest (release) --- tests/testthat/test-matrix64.R | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-matrix64.R b/tests/testthat/test-matrix64.R index 500f163..1e1118e 100644 --- a/tests/testthat/test-matrix64.R +++ b/tests/testthat/test-matrix64.R @@ -1,7 +1,7 @@ test_that("matrix works still on simple integer input", { x = as.integer(1:10) - expect_identical(class(matrix(x)), c("matrix", "array")) + expect_identical(class(matrix(x))[1L], "matrix") expect_no_warning(expect_identical(matrix(x)[seq_along(x)], x)) expect_no_warning(expect_identical(dim(matrix(x)), c(10L, 1L))) expect_no_warning(expect_identical(matrix(x, byrow=TRUE)[seq_along(x)], x)) @@ -89,9 +89,9 @@ test_that("array works on simple integer64 input", { expect_no_warning(expect_identical(dim(array(x)), c(10L))) expect_no_warning(expect_identical(array(x, c(2,5))[seq_along(x)], x)) expect_no_warning(expect_identical(dim(array(x, c(2,5))), c(2L,5L))) - expect_no_warning(expect_identical(array(x, c(1,2,3))[seq_len(1*2*3)], rep_len(x, 1*2*3))) + expect_no_warning(expect_identical(array(x, c(1,2,3))[seq_len(1*2*3)], x[1:6])) expect_no_warning(expect_identical(dim(array(x, c(1,2,3))), c(1L,2L,3L))) - expect_no_warning(expect_identical(array(x, c(3,2,3))[seq_len(3*2*3)], rep_len(x, 3*2*3))) + expect_no_warning(expect_identical(array(x, c(3,2,3))[seq_len(3*2*3)], c(x, x[1:8]))) expect_no_warning(expect_identical(array(NA_integer64_, c(2,1))[1:2], c(NA_integer64_, NA_integer64_))) expect_no_warning(expect_identical(array(integer64(), c(2,1))[1:2], c(NA_integer64_, NA_integer64_))) expect_no_warning(expect_identical(dimnames(array(x, c(2,5), dimnames=list(NULL, letters[1:5]))), list(NULL, letters[1:5]))) @@ -197,6 +197,7 @@ test_that("aperm works in simple cases", { }) test_that("matrix multiplication", { + skip_if_not_r_version("4.0.0") # it does not work with ubuntu-latest (3.6), because a double vector is returned m32 = matrix(1:10, 2) m64 = matrix(as.integer64(m32), nrow(m32)) mDo = matrix(as.numeric(m32), nrow(m32)) @@ -225,10 +226,12 @@ test_that("matrix multiplication", { # warning in multiplication part x = as.integer64("4000000000") expect_warning(expect_identical(matrix(x, 1)%*%matrix(x, ncol=1), matrix(NA_integer64_, 1, 1)), "NAs produced by integer64 overflow") + + expect_warning(expect_identical(as.integer64("9000000000000000000") + as.integer64("9000000000000000000"), NA_integer64_), "NAs produced by integer64 overflow") # warning in summation part x = rep_len(as.integer64("3000000000"), 2) expect_warning(expect_identical(matrix(x, 1)%*%matrix(x, ncol=1), matrix(NA_integer64_, 1, 1)), "NAs produced by integer64 overflow") - + }) From d9e0f7d7cb3e6435248fcfa6e4715d7e6f586fd5 Mon Sep 17 00:00:00 2001 From: hcirellu Date: Wed, 26 Nov 2025 15:36:57 +0100 Subject: [PATCH 04/14] fix matrix multiplication for macos --- src/integer64.c | 26 +++++++++----------------- tests/testthat/test-matrix64.R | 1 + 2 files changed, 10 insertions(+), 17 deletions(-) diff --git a/src/integer64.c b/src/integer64.c index a080167..5760ef5 100644 --- a/src/integer64.c +++ b/src/integer64.c @@ -1032,11 +1032,11 @@ SEXP as_list_integer64(SEXP x_){ __attribute__((no_sanitize("signed-integer-overflow"))) SEXP matmult_integer64_integer64(SEXP x_, SEXP y_, SEXP ret_){ long long i, j, k; - // get dimension of e1 + // get dimension of x SEXP dim1 = getAttrib(x_, R_DimSymbol); long long nrow1 = INTEGER(dim1)[0]; long long ncol1 = INTEGER(dim1)[1]; - // get dimension of e2 + // get dimension of y SEXP dim2 = getAttrib(y_, R_DimSymbol); long long nrow2 = INTEGER(dim2)[0]; long long ncol2 = INTEGER(dim2)[1]; @@ -1050,18 +1050,9 @@ __attribute__((no_sanitize("signed-integer-overflow"))) SEXP matmult_integer64_i for(i=0; i Date: Wed, 26 Nov 2025 16:40:50 +0100 Subject: [PATCH 05/14] manual debug macos --- src/integer64.c | 19 +++++++++++++-- tests/testthat/test-matrix64.R | 44 +++++++++++++++++----------------- 2 files changed, 39 insertions(+), 24 deletions(-) diff --git a/src/integer64.c b/src/integer64.c index 5760ef5..169773c 100644 --- a/src/integer64.c +++ b/src/integer64.c @@ -1050,11 +1050,26 @@ __attribute__((no_sanitize("signed-integer-overflow"))) SEXP matmult_integer64_i for(i=0; i Date: Wed, 26 Nov 2025 17:13:59 +0100 Subject: [PATCH 06/14] debug macos --- src/integer64.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/integer64.c b/src/integer64.c index 169773c..ec3dd7c 100644 --- a/src/integer64.c +++ b/src/integer64.c @@ -1060,7 +1060,9 @@ __attribute__((no_sanitize("signed-integer-overflow"))) SEXP matmult_integer64_i warning("second value is %lld - %d\n", cumsum,naflag); tempsum = cumsum + addValue; warning("third value is %lld - %d\n", tempsum,naflag); + if(((cumsum) > 0) ? ((addValue) < (tempsum)) : ! ((addValue) < (tempsum))) warning("GOODISUM64 is true"); if(!GOODISUM64(cumsum, addValue, tempsum)){ + warning("GOODISUM64 is false"); naflag = TRUE; cumsum = NA_INTEGER64; break; @@ -1145,7 +1147,7 @@ SEXP matmult_integer64_double(SEXP x_, SEXP y_, SEXP ret_){ PROD64REAL(x[i + k*nrow1],y[k + j*nrow2],addValue,naflag,longret) if(addValue == NA_INTEGER64){ cumsum = NA_INTEGER64; - break; + break; } tempsum = cumsum + addValue; if(!GOODISUM64(cumsum, addValue, tempsum)){ From e48e746699296fee5fe95539851fd3ab30356781 Mon Sep 17 00:00:00 2001 From: hcirellu Date: Wed, 26 Nov 2025 17:44:45 +0100 Subject: [PATCH 07/14] debug macos --- src/integer64.c | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/integer64.c b/src/integer64.c index ec3dd7c..36dca0e 100644 --- a/src/integer64.c +++ b/src/integer64.c @@ -1055,17 +1055,19 @@ __attribute__((no_sanitize("signed-integer-overflow"))) SEXP matmult_integer64_i warning("first value is %lld - %d\n", addValue,naflag); if(addValue == NA_INTEGER64){ cumsum = NA_INTEGER64; - break; + break; } warning("second value is %lld - %d\n", cumsum,naflag); tempsum = cumsum + addValue; warning("third value is %lld - %d\n", tempsum,naflag); if(((cumsum) > 0) ? ((addValue) < (tempsum)) : ! ((addValue) < (tempsum))) warning("GOODISUM64 is true"); + if(((cumsum) > 0)) warning("(cumsum) > 0 is true"); + if(((addValue) < (tempsum))) warning("(addValue) < (tempsum) is true"); if(!GOODISUM64(cumsum, addValue, tempsum)){ warning("GOODISUM64 is false"); naflag = TRUE; cumsum = NA_INTEGER64; - break; + break; } warning("fourth value is %lld - %d\n", tempsum,naflag); cumsum = tempsum; @@ -1105,7 +1107,7 @@ SEXP matmult_double_integer64(SEXP x_, SEXP y_, SEXP ret_){ PROD64REAL(y[k + j*nrow2],x[i + k*nrow1],addValue,naflag,longret) if(addValue == NA_INTEGER64){ cumsum = NA_INTEGER64; - break; + break; } tempsum = cumsum + addValue; if(!GOODISUM64(cumsum, addValue, tempsum)){ From c6aa44fd760e4200b62f65eb5e82a0efa501dc40 Mon Sep 17 00:00:00 2001 From: hcirellu Date: Wed, 26 Nov 2025 17:59:06 +0100 Subject: [PATCH 08/14] debug macos --- src/integer64.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/integer64.c b/src/integer64.c index 36dca0e..e3924cf 100644 --- a/src/integer64.c +++ b/src/integer64.c @@ -1062,7 +1062,7 @@ __attribute__((no_sanitize("signed-integer-overflow"))) SEXP matmult_integer64_i warning("third value is %lld - %d\n", tempsum,naflag); if(((cumsum) > 0) ? ((addValue) < (tempsum)) : ! ((addValue) < (tempsum))) warning("GOODISUM64 is true"); if(((cumsum) > 0)) warning("(cumsum) > 0 is true"); - if(((addValue) < (tempsum))) warning("(addValue) < (tempsum) is true"); + if((((long double) (addValue)) < ((long double) (tempsum)))) warning("(addValue) < (tempsum) is true"); if(!GOODISUM64(cumsum, addValue, tempsum)){ warning("GOODISUM64 is false"); naflag = TRUE; From df8a02db44c66e483b38f6843a00cc6e05ef1d72 Mon Sep 17 00:00:00 2001 From: hcirellu Date: Wed, 26 Nov 2025 18:09:46 +0100 Subject: [PATCH 09/14] debug macos --- src/integer64.c | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/integer64.c b/src/integer64.c index e3924cf..3dade7d 100644 --- a/src/integer64.c +++ b/src/integer64.c @@ -1062,8 +1062,12 @@ __attribute__((no_sanitize("signed-integer-overflow"))) SEXP matmult_integer64_i warning("third value is %lld - %d\n", tempsum,naflag); if(((cumsum) > 0) ? ((addValue) < (tempsum)) : ! ((addValue) < (tempsum))) warning("GOODISUM64 is true"); if(((cumsum) > 0)) warning("(cumsum) > 0 is true"); - if((((long double) (addValue)) < ((long double) (tempsum)))) warning("(addValue) < (tempsum) is true"); - if(!GOODISUM64(cumsum, addValue, tempsum)){ + if((((long long) (addValue)) < ((long long) (tempsum)))) warning("(addValue) < (tempsum) is true1"); + if((((long double) (addValue)) < ((long double) (tempsum)))) warning("(addValue) < (tempsum) is true2"); + // for some reason GOODISUM64(cumsum, addValue, tempsum) does not work properly on macos-latest, compared to the others + // therefore a workaround is tried here + // if(!GOODISUM64(cumsum, addValue, tempsum)){ + if(!((cumsum > 0) ? (((long double) addValue) < ((long double) tempsum)) : ! (((long double) addValue) < ((long double) tempsum)))){ warning("GOODISUM64 is false"); naflag = TRUE; cumsum = NA_INTEGER64; From 58532f2073073258bff045465f620d72d0ef8259 Mon Sep 17 00:00:00 2001 From: hcirellu Date: Wed, 26 Nov 2025 18:19:59 +0100 Subject: [PATCH 10/14] fix for macos --- src/integer64.c | 17 +++---------- tests/testthat/test-matrix64.R | 46 ++++++++++++++++------------------ 2 files changed, 25 insertions(+), 38 deletions(-) diff --git a/src/integer64.c b/src/integer64.c index 3dade7d..5c7b41a 100644 --- a/src/integer64.c +++ b/src/integer64.c @@ -1052,32 +1052,21 @@ __attribute__((no_sanitize("signed-integer-overflow"))) SEXP matmult_integer64_i cumsum = 0; for(k=0; k 0) ? ((addValue) < (tempsum)) : ! ((addValue) < (tempsum))) warning("GOODISUM64 is true"); - if(((cumsum) > 0)) warning("(cumsum) > 0 is true"); - if((((long long) (addValue)) < ((long long) (tempsum)))) warning("(addValue) < (tempsum) is true1"); - if((((long double) (addValue)) < ((long double) (tempsum)))) warning("(addValue) < (tempsum) is true2"); // for some reason GOODISUM64(cumsum, addValue, tempsum) does not work properly on macos-latest, compared to the others - // therefore a workaround is tried here - // if(!GOODISUM64(cumsum, addValue, tempsum)){ - if(!((cumsum > 0) ? (((long double) addValue) < ((long double) tempsum)) : ! (((long double) addValue) < ((long double) tempsum)))){ - warning("GOODISUM64 is false"); + // therefore a workaround is tried here by adding the GOODISUM64 logic with long double casting + if(!GOODISUM64(cumsum, addValue, tempsum) || + !((cumsum > 0) ? (((long double) addValue) < ((long double) tempsum)) : ! (((long double) addValue) < ((long double) tempsum)))){ naflag = TRUE; cumsum = NA_INTEGER64; break; } - warning("fourth value is %lld - %d\n", tempsum,naflag); cumsum = tempsum; - warning("fifth value is %lld - %d\n", cumsum,naflag); } - warning("sixth value is %lld - %d\n", cumsum,naflag); ret[i + j*nrow1] = cumsum; } } diff --git a/tests/testthat/test-matrix64.R b/tests/testthat/test-matrix64.R index 43ad994..4351524 100644 --- a/tests/testthat/test-matrix64.R +++ b/tests/testthat/test-matrix64.R @@ -202,33 +202,31 @@ test_that("matrix multiplication", { m64 = matrix(as.integer64(m32), nrow(m32)) mDo = matrix(as.numeric(m32), nrow(m32)) mCo = matrix(as.complex(m32), nrow(m32)) - # expect_error(m32%*%m32, "non-conformable arguments") - # expect_error(m64%*%m64, "non-conformable arguments") - # expect_identical(m64%*%t(m64), matrix(as.integer64(m32%*%t(m32)), nrow=nrow(m32))) - # expect_identical(t(m64)%*%m64, matrix(as.integer64(t(m32)%*%m32), ncol=ncol(m32))) - # expect_identical((1:2)%*%m64, matrix(as.integer64((1:2)%*%m32), ncol=ncol(m32))) - # expect_identical(m64%*%(1:5), matrix(as.integer64(m32%*%(1:5)), nrow=nrow(m32))) - # expect_error((1:2)%*%3L, "non-conformable arguments") - # expect_error(as.integer64(1:2)%*%as.integer64(3L), "non-conformable arguments") - # expect_identical(as.integer64(1L)%*%(3:4), matrix(as.integer64(3:4), nrow=1L)) - # expect_identical(as.integer64(1:2)%*%(3:4), matrix(as.integer64(11L), nrow=1L)) - - # expect_identical(m64%*%t(m32), matrix(as.integer64(m32%*%t(m32)), nrow=nrow(m32))) - # expect_identical(m32%*%t(m64), matrix(as.integer64(m32%*%t(m32)), nrow=nrow(m32))) - # expect_identical(m64%*%t(mDo), matrix(as.integer64(m32%*%t(m32)), nrow=nrow(m32))) - # expect_identical(mDo%*%t(m64), matrix(as.integer64(m32%*%t(m32)), nrow=nrow(m32))) - # expect_identical(m64%*%t(mCo), matrix(as.complex(m32%*%t(m32)), nrow=nrow(m32))) - # expect_identical(mCo%*%t(m64), matrix(as.complex(m32%*%t(m32)), nrow=nrow(m32))) - - # expect_error(m64%*%LETTERS[1:5], "non-numeric argument to binary operator", fixed=TRUE) - # expect_error(m64%*%as.raw(1:5), "non-numeric argument to binary operator", fixed=TRUE) + expect_error(m32%*%m32, "non-conformable arguments") + expect_error(m64%*%m64, "non-conformable arguments") + expect_identical(m64%*%t(m64), matrix(as.integer64(m32%*%t(m32)), nrow=nrow(m32))) + expect_identical(t(m64)%*%m64, matrix(as.integer64(t(m32)%*%m32), ncol=ncol(m32))) + expect_identical((1:2)%*%m64, matrix(as.integer64((1:2)%*%m32), ncol=ncol(m32))) + expect_identical(m64%*%(1:5), matrix(as.integer64(m32%*%(1:5)), nrow=nrow(m32))) + expect_error((1:2)%*%3L, "non-conformable arguments") + expect_error(as.integer64(1:2)%*%as.integer64(3L), "non-conformable arguments") + expect_identical(as.integer64(1L)%*%(3:4), matrix(as.integer64(3:4), nrow=1L)) + expect_identical(as.integer64(1:2)%*%(3:4), matrix(as.integer64(11L), nrow=1L)) + + expect_identical(m64%*%t(m32), matrix(as.integer64(m32%*%t(m32)), nrow=nrow(m32))) + expect_identical(m32%*%t(m64), matrix(as.integer64(m32%*%t(m32)), nrow=nrow(m32))) + expect_identical(m64%*%t(mDo), matrix(as.integer64(m32%*%t(m32)), nrow=nrow(m32))) + expect_identical(mDo%*%t(m64), matrix(as.integer64(m32%*%t(m32)), nrow=nrow(m32))) + expect_identical(m64%*%t(mCo), matrix(as.complex(m32%*%t(m32)), nrow=nrow(m32))) + expect_identical(mCo%*%t(m64), matrix(as.complex(m32%*%t(m32)), nrow=nrow(m32))) + + expect_error(m64%*%LETTERS[1:5], "non-numeric argument to binary operator", fixed=TRUE) + expect_error(m64%*%as.raw(1:5), "non-numeric argument to binary operator", fixed=TRUE) # warning in multiplication part - # x = as.integer64("4000000000") - # expect_warning(expect_identical(matrix(x, 1)%*%matrix(x, ncol=1), matrix(NA_integer64_, 1, 1)), "NAs produced by integer64 overflow") + x = as.integer64("4000000000") + expect_warning(expect_identical(matrix(x, 1)%*%matrix(x, ncol=1), matrix(NA_integer64_, 1, 1)), "NAs produced by integer64 overflow") - expect_warning(expect_identical(as.integer64("9000000000000000000") + as.integer64("9000000000000000000"), NA_integer64_), "NAs produced by integer64 overflow") - expect_warning(expect_identical(sum(as.integer64(c("9000000000000000000", "9000000000000000000"))), NA_integer64_), "NAs produced by integer64 overflow") # warning in summation part x = rep_len(as.integer64("3000000000"), 2) expect_warning(expect_identical(matrix(x, 1)%*%matrix(x, ncol=1), matrix(NA_integer64_, 1, 1)), "NAs produced by integer64 overflow") From b334ccd1249b1eba535846d679d94b8e4fd3fc49 Mon Sep 17 00:00:00 2001 From: hcirellu <58347152+hcirellu@users.noreply.github.com> Date: Sat, 13 Dec 2025 10:17:25 +0100 Subject: [PATCH 11/14] Update R/integer64.R Co-authored-by: Michael Chirico --- R/integer64.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/integer64.R b/R/integer64.R index 54991c3..a24200c 100644 --- a/R/integer64.R +++ b/R/integer64.R @@ -851,7 +851,7 @@ str.integer64 = function(object, vec.len=strO$vec.len, give.head=TRUE, give.leng } else if (!is.null(dim(object))) { dimO = dim(object) if (prod(dimO) != n) - stop(gettextf("dims [product %d] do not match the length of object [%d]", prod(dimO), n, domain="R")) + stop(gettextf("dims [product %d] do not match the length of object [%d]", prod(dimO), n, domain="R"), domain=NA) if (length(dimO) == 1L) { paste0("[", n, "(1d)] ") } else { From c3245d1050056d40222310ebdc49c158f86e67a0 Mon Sep 17 00:00:00 2001 From: hcirellu <58347152+hcirellu@users.noreply.github.com> Date: Sat, 13 Dec 2025 10:19:14 +0100 Subject: [PATCH 12/14] Update R/integer64.R Co-authored-by: Michael Chirico --- R/integer64.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/integer64.R b/R/integer64.R index a24200c..9c2d4e3 100644 --- a/R/integer64.R +++ b/R/integer64.R @@ -855,7 +855,7 @@ str.integer64 = function(object, vec.len=strO$vec.len, give.head=TRUE, give.leng if (length(dimO) == 1L) { paste0("[", n, "(1d)] ") } else { - paste0("[", paste(vapply(dimO, function(el) {if (el < 2L) as.character(el) else paste0("1:", el)}, ""), collapse = ", "), "] ") + paste0("[", toString(vapply(dimO, function(el) if (el < 2L) as.character(el) else paste0("1:", el), "")), "] ") } } ) From 63a394c6a539928f4d08664c8b064468d4eed5f6 Mon Sep 17 00:00:00 2001 From: hcirellu Date: Sat, 13 Dec 2025 10:27:32 +0100 Subject: [PATCH 13/14] rename `dimO` to `obj_dim` --- R/integer64.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/integer64.R b/R/integer64.R index 9c2d4e3..3182694 100644 --- a/R/integer64.R +++ b/R/integer64.R @@ -849,13 +849,13 @@ str.integer64 = function(object, vec.len=strO$vec.len, give.head=TRUE, give.leng if (length(object) > 1L && is.null(dim(object))) { if (isTRUE(give.length)) paste0("[1:", n, "] ") else " " } else if (!is.null(dim(object))) { - dimO = dim(object) - if (prod(dimO) != n) - stop(gettextf("dims [product %d] do not match the length of object [%d]", prod(dimO), n, domain="R"), domain=NA) - if (length(dimO) == 1L) { + obj_dim = dim(object) + if (prod(obj_dim) != n) + stop(gettextf("dims [product %d] do not match the length of object [%d]", prod(obj_dim), n, domain="R"), domain=NA) + if (length(obj_dim) == 1L) { paste0("[", n, "(1d)] ") } else { - paste0("[", toString(vapply(dimO, function(el) if (el < 2L) as.character(el) else paste0("1:", el), "")), "] ") + paste0("[", toString(vapply(obj_dim, function(el) if (el < 2L) as.character(el) else paste0("1:", el), "")), "] ") } } ) From c765dac0df15dabe037d69b8d60cbac1613a13bf Mon Sep 17 00:00:00 2001 From: hcirellu Date: Sat, 13 Dec 2025 10:48:03 +0100 Subject: [PATCH 14/14] `dim` or `dims` is allowed in error message try fix tests for ubuntu latest --- tests/testthat/test-matrix64.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-matrix64.R b/tests/testthat/test-matrix64.R index 4351524..46f41d2 100644 --- a/tests/testthat/test-matrix64.R +++ b/tests/testthat/test-matrix64.R @@ -75,7 +75,7 @@ test_that("array works still on simple integer input", { expect_no_warning(expect_identical(dimnames(array(x, c(2,5), dimnames=list(NULL, letters[1:5]))), list(NULL, letters[1:5]))) expect_no_warning(expect_identical(dimnames(array(x, c(2,5), dimnames=list(LETTERS[1:2]))), list(LETTERS[1:2], NULL))) expect_no_warning(expect_identical(dimnames(array(x, c(2,5), dimnames=list(LETTERS[1:2], letters[1:5]))), list(LETTERS[1:2], letters[1:5]))) - expect_error(array(x, dim=NULL), "'dims' cannot be of length 0") + expect_error(array(x, dim=NULL), "'dims?' cannot be of length 0") expect_error(array(x, dim=-1), "negative length vectors are not allowed") expect_no_warning(expect_identical(array(x, dim=0), structure(integer(), dim = 0L))) @@ -97,7 +97,7 @@ test_that("array works on simple integer64 input", { expect_no_warning(expect_identical(dimnames(array(x, c(2,5), dimnames=list(NULL, letters[1:5]))), list(NULL, letters[1:5]))) expect_no_warning(expect_identical(dimnames(array(x, c(2,5), dimnames=list(LETTERS[1:2]))), list(LETTERS[1:2], NULL))) expect_no_warning(expect_identical(dimnames(array(x, c(2,5), dimnames=list(LETTERS[1:2], letters[1:5]))), list(LETTERS[1:2], letters[1:5]))) - expect_error(array(x, dim=NULL), "'dims' cannot be of length 0") + expect_error(array(x, dim=NULL), "'dims?' cannot be of length 0") expect_error(array(x, dim=-1), "negative length vectors are not allowed") expect_no_warning(expect_identical(array(x, dim=0), structure(integer64(), dim = 0L)))