Reshape an array or a matrix by permuting and/or joining dimensions.

A useful application of this is to reshape a multidimensional array to a matrix, which then can be saved to file using for instance write.table().

# S3 method for array
wrap(x, map=list(NA), sep=".", ...)

Arguments

x

An array or a matrix.

map

A list of length equal to the number of dimensions in the reshaped array. Each element should be an integer vectors specifying the dimensions to be joined in corresponding new dimension. One element may equal NA to indicate that that dimension should be a join of all non-specified (remaining) dimensions. Default is to wrap everything into a vector.

sep

A character pasting joined dimension names.

...

Not used.

Value

Returns an array of length(map) dimensions, where the first dimension is of size prod(map[[1]]), the second

prod(map[[2]]), and so on.

Details

If the indices in unlist(map) is in a non-increasing order, aperm() will be called, which requires reshuffling of array elements in memory. In all other cases, the reshaping of the array does not require this, but only fast modifications of attributes dim and dimnames.

Author

Henrik Bengtsson

See also

Examples


# Create a 3x2x3 array
dim <- c(3,2,3)
ndim <- length(dim)
dimnames <- list()
for (kk in 1:ndim)
  dimnames[[kk]] <- sprintf("%s%d", letters[kk], 1:dim[kk])
x <- 1:prod(dim)
x <- array(x, dim=dim, dimnames=dimnames)


cat("Array 'x':\n")
#> Array 'x':
print(x)
#> , , c1
#> 
#>    b1 b2
#> a1  1  4
#> a2  2  5
#> a3  3  6
#> 
#> , , c2
#> 
#>    b1 b2
#> a1  7 10
#> a2  8 11
#> a3  9 12
#> 
#> , , c3
#> 
#>    b1 b2
#> a1 13 16
#> a2 14 17
#> a3 15 18
#> 


cat("\nReshape 'x' to its identity:\n")
#> 
#> Reshape 'x' to its identity:
y <- wrap(x, map=list(1, 2, 3))
print(y)
#> , , c1
#> 
#>    b1 b2
#> a1  1  4
#> a2  2  5
#> a3  3  6
#> 
#> , , c2
#> 
#>    b1 b2
#> a1  7 10
#> a2  8 11
#> a3  9 12
#> 
#> , , c3
#> 
#>    b1 b2
#> a1 13 16
#> a2 14 17
#> a3 15 18
#> 
# Assert correctness of reshaping
stopifnot(identical(y, x))


cat("\nReshape 'x' by swapping dimensions 2 and 3, i.e. aperm(x, perm=c(1,3,2)):\n")
#> 
#> Reshape 'x' by swapping dimensions 2 and 3, i.e. aperm(x, perm=c(1,3,2)):
y <- wrap(x, map=list(1, 3, 2))
print(y)
#> , , b1
#> 
#>    c1 c2 c3
#> a1  1  7 13
#> a2  2  8 14
#> a3  3  9 15
#> 
#> , , b2
#> 
#>    c1 c2 c3
#> a1  4 10 16
#> a2  5 11 17
#> a3  6 12 18
#> 
# Assert correctness of reshaping
stopifnot(identical(y, aperm(x, perm=c(1,3,2))))


cat("\nWrap 'x' to a matrix 'y' by keeping dimension 1 and joining the others:\n")
#> 
#> Wrap 'x' to a matrix 'y' by keeping dimension 1 and joining the others:
y <- wrap(x, map=list(1, NA))
print(y)
#>    b1.c1 b2.c1 b1.c2 b2.c2 b1.c3 b2.c3
#> a1     1     4     7    10    13    16
#> a2     2     5     8    11    14    17
#> a3     3     6     9    12    15    18
# Assert correctness of reshaping
for (aa in dimnames(x)[[1]]) {
  for (bb in dimnames(x)[[2]]) {
    for (cc in dimnames(x)[[3]]) {
      tt <- paste(bb, cc, sep=".")
      stopifnot(identical(y[aa,tt], x[aa,bb,cc]))
    }
  }
}


cat("\nUnwrap matrix 'y' back to array 'x':\n")
#> 
#> Unwrap matrix 'y' back to array 'x':
z <- unwrap(y)
print(z)
#> , , c1
#> 
#>    b1 b2
#> a1  1  4
#> a2  2  5
#> a3  3  6
#> 
#> , , c2
#> 
#>    b1 b2
#> a1  7 10
#> a2  8 11
#> a3  9 12
#> 
#> , , c3
#> 
#>    b1 b2
#> a1 13 16
#> a2 14 17
#> a3 15 18
#> 
stopifnot(identical(z,x))


cat("\nWrap a matrix 'y' to a vector and back again:\n")
#> 
#> Wrap a matrix 'y' to a vector and back again:
x <- matrix(1:8, nrow=2, dimnames=list(letters[1:2], 1:4))
y <- wrap(x)
z <- unwrap(y)
print(z)
#>   1 2 3 4
#> a 1 3 5 7
#> b 2 4 6 8
stopifnot(identical(z,x))


cat("\nWrap and unwrap a randomly sized and shaped array 'x2':\n")
#> 
#> Wrap and unwrap a randomly sized and shaped array 'x2':
maxdim <- 5
dim <- sample(1:maxdim, size=sample(2:maxdim, size=1))
ndim <- length(dim)
dimnames <- list()
for (kk in 1:ndim)
  dimnames[[kk]] <- sprintf("%s%d", letters[kk], 1:dim[kk])
x2 <- 1:prod(dim)
x2 <- array(x, dim=dim, dimnames=dimnames)

cat("\nArray 'x2':\n")
#> 
#> Array 'x2':
print(x)
#>   1 2 3 4
#> a 1 3 5 7
#> b 2 4 6 8

# Number of dimensions of wrapped array
ndim2 <- sample(1:(ndim-1), size=1)

# Create a random map for joining dimensions
splits <- NULL
if (ndim > 2)
  splits <- sort(sample(2:(ndim-1), size=ndim2-1))
splits <- c(0, splits, ndim)
map <- list()
for (kk in 1:ndim2)
  map[[kk]] <- (splits[kk]+1):splits[kk+1]

cat("\nRandom 'map':\n")
#> 
#> Random 'map':
print(map)
#> [[1]]
#> [1] 1 2
#> 

cat("\nArray 'y2':\n")
#> 
#> Array 'y2':
y2 <- wrap(x2, map=map)
print(y2)
#> a1.b1 a2.b1 a1.b2 a2.b2 a1.b3 a2.b3 a1.b4 a2.b4 
#>     1     2     3     4     5     6     7     8 

cat("\nArray 'x2':\n")
#> 
#> Array 'x2':
z2 <- unwrap(y2)
print(z2)
#>    b1 b2 b3 b4
#> a1  1  3  5  7
#> a2  2  4  6  8

stopifnot(identical(z2,x2))