|
19 | 19 | #' @param x An array of integer64 numbers. |
20 | 20 | #' @param na.rm,dims Same interpretation as in [colSums()]. |
21 | 21 | #' @param ... Passed on to subsequent methods. |
| 22 | +#' @param data,nrow,ncol,byrow,dimnames,dim Arguments for `matrix()` and `array()`. |
22 | 23 | #' @examples |
23 | | -#' A = as.integer64(1:6) |
24 | | -#' dim(A) = 3:2 |
| 24 | +#' A = matrix(as.integer64(1:6), 3) |
25 | 25 | #' |
26 | 26 | #' colSums(A) |
27 | 27 | #' rowSums(A) |
28 | 28 | #' aperm(A, 2:1) |
29 | 29 | #' @name matrix64 |
30 | 30 | NULL |
31 | 31 |
|
32 | | -#' @rdname matrix64 |
33 | | -#' @export |
34 | | -colSums = function(x, na.rm=FALSE, dims=1L) UseMethod("colSums") |
35 | | -#' @rdname matrix64 |
36 | | -#' @export |
37 | | -colSums.default = function(x, na.rm=FALSE, dims=1L) base::colSums(x, na.rm, dims) |
38 | 32 |
|
39 | 33 | #' @rdname matrix64 |
40 | | -#' @export |
41 | | -colSums.integer64 = function(x, na.rm=FALSE, dims=1L) { |
42 | | - n_dim = length(dim(x)) |
43 | | - stopifnot( |
44 | | - `dims= should be a length-1 integer between 1 and length(dim(x))-1L` = |
45 | | - length(dims) == 1L && dims > 0L && dims < n_dim |
46 | | - ) |
47 | | - MARGIN = tail(seq_len(n_dim), -dims) |
48 | | - ret = apply(x, MARGIN, sum, na.rm = na.rm) |
49 | | - class(ret) = "integer64" |
| 34 | +#' @exportS3Method matrix integer64 |
| 35 | +matrix.integer64 = function(data=NA_integer64_, ...) { |
| 36 | + if (!length(data)) data = NA_integer64_ |
| 37 | + ret = withCallingHandlers_and_choose_call( |
| 38 | + base::matrix(data=data, ...), |
| 39 | + c("matrix", "matrix.integer64") |
| 40 | + ) |
| 41 | + class(ret) = class(data) |
50 | 42 | ret |
51 | 43 | } |
52 | 44 |
|
53 | 45 | #' @rdname matrix64 |
54 | | -#' @export |
55 | | -rowSums = function(x, na.rm=FALSE, dims=1L) UseMethod("rowSums") |
| 46 | +#' @exportS3Method array integer64 |
| 47 | +array.integer64 = function(data=NA_integer64_, ...) { |
| 48 | + if (!length(data)) data = NA_integer64_ |
| 49 | + ret = withCallingHandlers_and_choose_call( |
| 50 | + base::array(data=data, ...), |
| 51 | + c("array", "array.integer64") |
| 52 | + ) |
| 53 | + class(ret) = class(data) |
| 54 | + ret |
| 55 | +} |
| 56 | + |
56 | 57 | #' @rdname matrix64 |
57 | 58 | #' @export |
58 | | -rowSums.default = function(x, na.rm=FALSE, dims=1L) base::rowSums(x, na.rm, dims) |
| 59 | +colSums.integer64 = function(x, na.rm=FALSE, dims=1L) { |
| 60 | + dn = dim(x) |
| 61 | + if (!is.array(x) || length(dn) < 2L) |
| 62 | + stop(errorCondition(gettext("'x' must be an array of at least two dimensions", domain="R-base"), call=choose_sys_call(c("colSums", "colSums.integer64")))) |
| 63 | + if (length(dims) != 1L || dims < 1L || dims > length(dn) - 1L) |
| 64 | + stop(errorCondition(gettext("invalid 'dims'", domain="R-base"), call=choose_sys_call(c("colSums", "colSums.integer64")))) |
| 65 | + |
| 66 | + ret = apply(x, seq_along(dn)[-seq_len(dims)], sum, na.rm=na.rm) |
| 67 | + class(ret) = class(x) |
| 68 | + ret |
| 69 | +} |
59 | 70 |
|
60 | 71 | #' @rdname matrix64 |
61 | 72 | #' @export |
62 | 73 | rowSums.integer64 = function(x, na.rm=FALSE, dims=1L) { |
63 | | - n_dim = length(dim(x)) |
64 | | - stopifnot( |
65 | | - `dims= should be a length-1 integer between 1 and length(dim(x))-1L` = |
66 | | - length(dims) == 1L && dims > 0L && dims < n_dim |
67 | | - ) |
68 | | - MARGIN = seq_len(dims) |
69 | | - ret = apply(x, MARGIN, sum, na.rm = na.rm) |
70 | | - class(ret) = "integer64" |
| 74 | + dn = dim(x) |
| 75 | + if (!is.array(x) || length(dn) < 2L) |
| 76 | + stop(errorCondition(gettext("'x' must be an array of at least two dimensions", domain="R-base"), call=choose_sys_call(c("rowSums", "rowSums.integer64")))) |
| 77 | + if (length(dims) != 1L || dims < 1L || dims > length(dn) - 1L) |
| 78 | + stop(errorCondition(gettext("invalid 'dims'", domain="R-base"), call=choose_sys_call(c("rowSums", "rowSums.integer64")))) |
| 79 | + |
| 80 | + ret = apply(x, seq_len(dims), sum, na.rm=na.rm) |
| 81 | + class(ret) = class(x) |
71 | 82 | ret |
72 | 83 | } |
73 | 84 |
|
74 | 85 | #' @rdname matrix64 |
75 | 86 | #' @param a,perm Passed on to [aperm()]. |
76 | | -#' @export |
| 87 | +#' @exportS3Method base::aperm integer64 |
77 | 88 | aperm.integer64 = function(a, perm, ...) { |
78 | | - class(a) = minusclass(class(a), "integer64") |
79 | | - ret = aperm(a, perm, ...) |
80 | | - class(ret) = plusclass(class(a), "integer64") |
| 89 | + ret = NextMethod() |
| 90 | + class(ret) = class(a) |
81 | 91 | ret |
82 | 92 | } |
| 93 | + |
| 94 | +#' @exportS3Method base::`%*%` integer64 |
| 95 | +`%*%.integer64` = function(x, y) { |
| 96 | + if (!is.integer64(x) && !is.integer64(y)) |
| 97 | + return(x%*%y) |
| 98 | + |
| 99 | + target_class = target_class_for_Ops(x, y) |
| 100 | + if (target_class != "integer64") { |
| 101 | + if (is.integer64(x)) { |
| 102 | + for (cc in class(y)) { |
| 103 | + f = getS3method("%*%", cc, optional=TRUE) |
| 104 | + if (!is.null(f)) |
| 105 | + return(f(.as_double_integer64(x, keep.attributes=TRUE), y)) |
| 106 | + } |
| 107 | + x = .as_double_integer64(x, keep.attributes=TRUE) |
| 108 | + } else { |
| 109 | + y = .as_double_integer64(y, keep.attributes=TRUE) |
| 110 | + } |
| 111 | + return(x%*%y) |
| 112 | + } |
| 113 | + |
| 114 | + dx = dim(x) |
| 115 | + dy = dim(y) |
| 116 | + if (length(dx) > 2L || length(dy) > 2L) |
| 117 | + stop("non-conformable arguments", domain="R") |
| 118 | + if (length(dx) <= 1L && length(dy) <= 1L) { |
| 119 | + dx = c(1L, length(x)) |
| 120 | + if (length(x) == length(y)) { |
| 121 | + dy = c(length(y), 1L) |
| 122 | + } else { |
| 123 | + dy = c(1L, length(y)) |
| 124 | + } |
| 125 | + } |
| 126 | + if (length(dx) <= 1L) |
| 127 | + dx = c(1L, dy[1L]) |
| 128 | + if (length(dy) <= 1L) |
| 129 | + dy = c(dx[2L], 1L) |
| 130 | + if (dx[2L] != dy[1L]) |
| 131 | + stop("non-conformable arguments", domain="R") |
| 132 | + dim(x) = dx |
| 133 | + dim(y) = dy |
| 134 | + |
| 135 | + if (is.double(x)) { |
| 136 | + ret = .Call(C_matmult_double_integer64, x, structure(as.integer64(y), dim=dy), double(dx[1L]*dy[2L])) |
| 137 | + } else if (is.double(y)) { |
| 138 | + ret = .Call(C_matmult_integer64_double, structure(as.integer64(x), dim=dx), y, double(dx[1L]*dy[2L])) |
| 139 | + } else { |
| 140 | + ret = .Call(C_matmult_integer64_integer64, structure(as.integer64(x), dim=dx), structure(as.integer64(y), dim=dy), double(dx[1L]*dy[2L])) |
| 141 | + } |
| 142 | + dim(ret) = c(dx[1L], dy[2L]) |
| 143 | + oldClass(ret) = "integer64" |
| 144 | + ret |
| 145 | +} |
| 146 | + |
| 147 | +#' @exportS3Method base::as.matrix integer64 |
| 148 | +as.matrix.integer64 = function(x, ...) { |
| 149 | + if (is.matrix(x)) { |
| 150 | + x |
| 151 | + } else { |
| 152 | + array(x, c(length(x), 1L), if (!is.null(names(x))) list(names(x), NULL)) |
| 153 | + } |
| 154 | +} |
0 commit comments