#' Multi Linear Multiplication #' #' C = A x { B1, ..., Br } #' #' @param A tensor (multi-linear array) #' @param B matrix or list of matrices #' @param ... further matrices, concatenated with \code{B} #' @param modes integer sequence of the same length as number of matrices #' supplied (in \code{B} and \code{...}) #' #' @examples #' # general usage #' dimA <- c(3, 17, 19, 2) #' dimC <- c(7, 11, 13, 5) #' A <- array(rnorm(prod(dimA)), dim = dimA) #' B <- Map(function(p, q) matrix(rnorm(p * q), p, q), dimC, dimA) #' C1 <- mlm(A, B) #' C2 <- mlm(A, B[[1]], B[[2]], B[[3]], B[[4]]) #' C3 <- mlm(A, B[[3]], B[[1]], B[[2]], B[[4]], modes = c(3, 1, 2, 4)) #' C4 <- mlm(A, B[1:3], B[[4]]) #' stopifnot(all.equal(C1, C2)) #' stopifnot(all.equal(C1, C3)) #' stopifnot(all.equal(C1, C4)) #' #' # selected modes #' C1 <- mlm(A, B, modes = 2:3) #' C2 <- mlm(A, B[[2]], B[[3]], modes = 2:3) #' C3 <- ttm(ttm(A, B[[2]], 2), B[[3]], 3) #' stopifnot(all.equal(C1, C2)) #' stopifnot(all.equal(C1, C3)) #' #' # analog to matrix multiplication #' A <- matrix(rnorm( 6), 2, 3) #' B <- matrix(rnorm(12), 3, 4) #' C <- matrix(rnorm(20), 4, 5) #' stopifnot(all.equal( #' A %*% B %*% t(C), #' mlm(B, list(A, C)) #' )) #' #' # usage with repeated modes (non commutative) #' dimA <- c(3, 17, 19, 2) #' A <- array(rnorm(prod(dimA)), dim = dimA) #' B1 <- matrix(rnorm(9), 3, 3) #' B2 <- matrix(rnorm(9), 3, 3) #' C <- matrix(rnorm(4), 2, 2) #' # same modes do NOT commute #' all.equal( #' mlm(A, B1, B2, C, modes = c(1, 1, 4)), # NOT equal! #' mlm(A, B2, B1, C, modes = c(1, 1, 4)) #' ) #' # but different modes do commute #' P1 <- mlm(A, C, B1, B2, modes = c(4, 1, 1)) #' P2 <- mlm(A, B1, C, B2, modes = c(1, 4, 1)) #' P3 <- mlm(A, B1, B2, C, modes = c(1, 1, 4)) #' stopifnot(all.equal(P1, P2)) #' stopifnot(all.equal(P1, P3)) #' #' @export mlm <- function(A, B, ..., modes = seq_along(B)) { # Collect all matrices in `B` B <- c(if (is.matrix(B)) list(B) else B, list(...)) # iteratively apply Tensor Times Matrix multiplication over modes for (i in seq_along(modes)) { A <- ttm(A, B[[i]], modes[i]) } # return result tensor A }