Add matrix, array and matrix multiplication for integer64

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)

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
 

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

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))) {
+            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(obj_dim, function(el) if (el < 2L) as.character(el) else paste0("1:", el), "")), "] ")
+            }
+          }
+        )
+      }
+    },
+    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.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) {