tensor_predictors/tensorPredictors/R/kronperm.R

37 lines
1.2 KiB
R
Raw Normal View History

#' Kronecker Permutation of an array
#'
#' Computes a permutation and reshaping of `A` such that
#' kronperm(B %o% C) == kronecker(B, C)
#'
#' @param A multi-dimensional array
#' @param dims dimensions `A` should have overwriting the actuall dimensions
#' @param ncomp number of "components" counting the elements of an outer product
#' used to generate `A` if it is the result of an outer product.
#'
#' @examples
#' A <- array(rnorm(24), dim = c(2, 3, 4))
#' B <- array(rnorm(15), dim = c(5, 3, 1))
#' C <- array(rnorm(84), dim = c(7, 4, 3))
#'
#' all.equal(
#' kronperm(outer(A, B)),
#' kronecker(A, B)
#' )
#' all.equal(
#' kronperm(Reduce(outer, list(A, B, C)), ncomp = 3L),
#' Reduce(kronecker, list(A, B, C))
#' )
#'
#' @export
kronperm <- function(A, dims = dim(A), ncomp = 2L) {
# force `A` to have a multiple of `ncomp` dimensions
dim(A) <- c(dims, rep(1L, length(dims) %% ncomp))
# compute axis permutation
perm <- as.vector(t(matrix(seq_along(dim(A)), ncol = ncomp)[, ncomp:1]))
# permute elements of A
K <- aperm(A, perm, resize = FALSE)
# collapse/set dimensions
dim(K) <- apply(matrix(dim(K), ncol = ncomp), 1, prod)
K
}