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