tensor_predictors/tensorPredictors/R/matricize.R

95 lines
2.5 KiB
R

#' Matricization
#'
#' @param T multi-dimensional array
#' @param modes axis indices along to matricize
#' @param dims dimension of \code{T} befor matricization
#' @param inv boolean to determin if the inverse operation should be performed
#'
#' @returns matrix of dimensions \code{dims[modes]} by \code{prod(dims)[-modes]}
#' or tensor of dimensions \code{dims} iff \code{inv} is true.
#'
#' @examples
#' A <- array(rnorm(2 * 3 * 5), dim = c(2, 3, 5))
#' stopifnot(exprs = {
#' all.equal(A, mat(mat(A, 1), 1, dim(A), TRUE))
#' all.equal(A, mat(mat(A, 2), 2, dim(A), TRUE))
#' all.equal(A, mat(mat(A, 3), 3, dim(A), TRUE))
#' all.equal(A, mat(mat(A, c(1, 2)), c(1, 2), dim(A), TRUE))
#' all.equal(A, mat(mat(A, c(1, 3)), c(1, 3), dim(A), TRUE))
#' all.equal(A, mat(mat(A, c(2, 3)), c(2, 3), dim(A), TRUE))
#'
#' all.equal(t(mat(A, 1)), mat(A, c(2, 3)))
#' all.equal(t(mat(A, 3)), mat(A, c(1, 2)))
#' })
#'
#' stopifnot(all.equal(
#' mat(1:12, 2, dims = c(2, 3, 2)),
#' matrix(c(
#' 1, 2, 7, 8,
#' 3, 4, 9, 10,
#' 5, 6, 11, 12
#' ), 3, 4, byrow = TRUE)
#' ))
#'
#' @export
mat <- function(T, modes, dims = dim(T), inv = FALSE) {
modes <- as.integer(modes)
stopifnot(exprs = {
length(T) == prod(dims)
all(modes <= length(dims))
})
perm <- c(modes, seq_along(dims)[-modes])
if (inv) {
dim(T) <- dims[perm]
perm <- order(perm)
} else {
dim(T) <- dims
}
T <- aperm(T, perm)
if (inv) {
dim(T) <- dims
} else {
dim(T) <- c(prod(dims[modes]), prod(dims[-modes]))
}
T
}
# #' Inverse Matricization
# #'
# #' @param T matrix of dimensions \code{dims[mode]} by \code{prod(dims[-mode])}
# #' @param mode axis along the original matricization
# #' @param dims dimension of the original tensor
# #'
# #' @returns multi-dimensional array of dimensions \code{dims}
# #'
# #' @examples
# #' p <- c(2, 3, 5)
# #' A <- array(rnorm(prod(p)), dim = p)
# #' stopifnot(expr = {
# #' all.equal(A, mat.inv(mat(A, 1), 1, p))
# #' all.equal(A, mat.inv(mat(A, 2), 2, p))
# #' all.equal(A, mat.inv(mat(A, 3), 3, p))
# #' })
# #'
# #' @export
# mat.inv <- function(T, modes, dims) {
# modes <- as.integer(modes)
# stopifnot(exprs = {
# length(T) == prod(dims)
# any(length(dims) < modes)
# })
# dim(T) <- c(dims[modes], dims[-modes])
# T <- aperm(T, order(c(modes, seq_along(dims)[-modes])))
# dim(T) <- c(prod(dims[modes]), prod(dims[-modes]))
# T
# }