tensor_predictors/tensorPredictors/R/ttm.R

33 lines
1.1 KiB
R
Raw Normal View History

2022-04-29 14:50:51 +00:00
#' 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]}.
2022-04-29 14:50:51 +00:00
#' @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}
2022-04-29 14:50:51 +00:00
#'
#' @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.
2022-04-29 14:50:51 +00:00
#'
#' @export
ttm <- function(T, M, mode = length(dim(T)), transposed = FALSE) {
2022-04-29 14:50:51 +00:00
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))
2022-04-29 14:50:51 +00:00
}
#' @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)