#' Tensor Times Matrix (n-mode tensor matrix product) #' #' @param T array of order at least \code{mode} #' @param M matrix, the right hand side of the mode product such that #' \code{ncol(M)} equals \code{dim(T)[mode]} if \code{transposed} is false, #' otherwise the dimension matching is \code{nrow(M)} to \code{dim(T)[mode]}. #' @param mode the mode of the product in the range \code{1:length(dim(T))} #' @param transposed boolean to multiply with the transposed of \code{M} #' #' @returns multi-dimensional array of the same order as \code{T} with #' \code{mode} dimension equal to \code{nrow(M)} or \code{ncol(M)} if #' \code{transposed} is true. #' #' @examples #' for (mode in 1:4) { #' dimA <- sample.int(10, 4, replace = TRUE) #' A <- array(rnorm(prod(dimA)), dim = dimA) #' nrowB <- sample.int(10, 1) #' B <- matrix(rnorm(nrowB * dimA[mode]), nrowB) #' #' C <- ttm(A, B, mode) #' #' dimC <- ifelse(seq_along(dims) != mode, dimA, nrowB) #' C.ref <- mat(B %*% mat(A, mode), mode, dims = dimC, inv = TRUE) #' #' stopifnot(all.equal(C, C.ref)) #' } #' #' for (mode in 1:4) { #' dimA <- sample.int(10, 4, replace = TRUE) #' A <- array(rnorm(prod(dimA)), dim = dimA) #' ncolB <- sample.int(10, 1) #' B <- matrix(rnorm(dimA[mode] * ncolB), dimA[mode]) #' #' C <- ttm(A, B, mode, transposed = TRUE) #' #' C.ref <- ttm(A, t(B), mode) #' #' stopifnot(all.equal(C, C.ref)) #' } #' #' @export ttm <- function(T, M, mode = length(dim(T)), transposed = FALSE) { storage.mode(T) <- storage.mode(M) <- "double" dim(M) <- c(NROW(M), NCOL(M)) .Call("C_ttm", T, M, as.integer(mode), as.logical(transposed)) } #' @rdname ttm #' @export `%x_1%` <- function(T, M) ttm(T, M, 1L) #' @rdname ttm #' @export `%x_2%` <- function(T, M) ttm(T, M, 2L) #' @rdname ttm #' @export `%x_3%` <- function(T, M) ttm(T, M, 3L) #' @rdname ttm #' @export `%x_4%` <- function(T, M) ttm(T, M, 4L)