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
 | 
						|
}
 |