#' 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)) } }