66 lines
2.1 KiB
R
66 lines
2.1 KiB
R
#' Tensor Mode Crossproduct
|
|
#'
|
|
#' C = A_(m) t(B_(m))
|
|
#'
|
|
#' For a matrices `A`, `B`, the first mode is `mcrossprod(A, B, 1)` equivalent
|
|
#' to `A %*% t(B)` (`tcrossprod`). On the other hand for mode two
|
|
#' `mcrossprod(A, 2)` the equivalence is `t(A) %*% B` (`crossprod`).
|
|
#'
|
|
#' @param A multi-dimensional array
|
|
#' @param B multi-dimensional array (allowed missing, defaults to `A`)
|
|
#' @param mode index (1-indexed)
|
|
#'
|
|
#' @returns matrix of dimensions \code{dim(A)[mode] by dim(B)[mode]}.
|
|
#'
|
|
#' @note equivalent to \code{tcrossprod(mat(A, mode), mat(B, mode))} with around
|
|
#' the same performance but only allocates the result matrix.
|
|
#'
|
|
#' @examples
|
|
#' dimA <- c(2, 5, 7, 11)
|
|
#' A <- array(rnorm(prod(dimA)), dim = dimA)
|
|
#' stopifnot(exprs = {
|
|
#' all.equal(mcrossprod(A, mode = 1), tcrossprod(mat(A, 1)))
|
|
#' all.equal(mcrossprod(A, , 2), tcrossprod(mat(A, 2)))
|
|
#' all.equal(mcrossprod(A, , mode = 3), tcrossprod(mat(A, 3)))
|
|
#' all.equal(mcrossprod(A, A, 4), tcrossprod(mat(A, 4)))
|
|
#' })
|
|
#'
|
|
#' dimA <- c(2, 5, 7, 11)
|
|
#' dimB <- c(3, 5, 7, 11) # same as dimA except 1. entry
|
|
#' A <- array(rnorm(prod(dimA)), dim = dimA)
|
|
#' B <- array(rnorm(prod(dimB)), dim = dimB)
|
|
#' stopifnot(all.equal(
|
|
#' mcrossprod(A, B, 1),
|
|
#' tcrossprod(mat(A, 1), mat(B, 1))
|
|
#' ))
|
|
#'
|
|
#' dimA <- c(5, 2, 7, 11)
|
|
#' dimB <- c(5, 3, 7, 11) # same as dimA except 2. entry
|
|
#' A <- array(rnorm(prod(dimA)), dim = dimA)
|
|
#' B <- array(rnorm(prod(dimB)), dim = dimB)
|
|
#' stopifnot(all.equal(
|
|
#' mcrossprod(A, B, mode = 2L),
|
|
#' tcrossprod(mat(A, 2), mat(B, 2))
|
|
#' ))
|
|
#'
|
|
#' @export
|
|
mcrossprod <- function(A, B, mode, dimA = dim(A), dimB = dim(B)) {
|
|
storage.mode(A) <- "double"
|
|
if (!missing(dimA)) {
|
|
dim(A) <- dimA
|
|
} else if (is.null(dim(A))) {
|
|
dim(A) <- length(A)
|
|
}
|
|
if (missing(B)) {
|
|
.Call("C_mcrossprod_sym", A, as.integer(mode))
|
|
} else {
|
|
storage.mode(B) <- "double"
|
|
if (!missing(dimB)) {
|
|
dim(B) <- dimB
|
|
} else if (is.null(dim(B))) {
|
|
dim(B) <- length(B)
|
|
}
|
|
.Call("C_mcrossprod", A, B, as.integer(mode))
|
|
}
|
|
}
|