37 lines
1.2 KiB
R
37 lines
1.2 KiB
R
|
#' 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
|
||
|
|
}
|