Adding a column or row in a three-dimensional array

Question

I have an array like this:

, , 1 [,1] [,2] [,3] [1,] 1 4 7 [2,] 2 5 8 [3,] 3 6 9 , , 2 [,1] [,2] [,3] [1,] 10 13 16 [2,] 11 14 17 [3,] 12 15 18 , , 3 [,1] [,2] [,3] [1,] 19 22 25 [2,] 20 23 26 [3,] 21 24 27 

And I would like to add a column for each component populated with 0 to finally get the following:

 , , 1 [,1] [,2] [,3] [,4] [1,] 1 4 7 0 [2,] 2 5 8 0 [3,] 3 6 9 0 , , 2 [,1] [,2] [,3] [,4] [1,] 10 13 16 0 [2,] 11 14 17 0 [3,] 12 15 18 0 , , 3 [,1] [,2] [,3] [,4] [1,] 19 22 25 0 [2,] 20 23 26 0 [3,] 21 24 27 0 

Is there an easy way to do this using R?

Answer 1

Here is a way:

 library(abind) abind(x, array(0, replace(dim(x), 2, 1)), along = 2) 

And one more:

 aperm(apply(x, c(1, 3), c, 0), c(2, 1, 3)) 

Answer 2

You can also try something like (although it is a little tame, but should be faster than another basic R solution)

 indx <- dim(df) + c(0, 1, 0) array(sapply(1:indx[3], function(x) cbind(df[,,x], 0)), indx) 

Some tests

 n <- 1e5 df <- array(1:27, c(3, 3, n)) library(abind) library(microbenchmark) flodel1 <- function(x) abind(x, array(0, replace(dim(x), 2, 1)), along = 2) flodel2 <- function(x) aperm(apply(x, c(1, 3), c, 0), c(2, 1, 3)) David <- function(x) {indx <- dim(x) + c(0, 1, 0) ; array(sapply(seq_len(indx[3]), function(y) cbind(x[,,y], 0)), indx)} Res <- microbenchmark(flodel1(df), flodel2(df), David(df)) # Unit: milliseconds # expr min lq mean median uq max neval # flodel1(df) 45.8943 65.37496 90.68902 90.24751 107.5991 159.9881 100 # flodel2(df) 553.4831 634.73127 673.95636 679.79709 710.0540 808.6248 100 # David(df) 434.9524 531.85597 576.77011 555.46865 626.3344 757.9358 100 

Answer 3

Just for the challenge, another idea (with some extra sauce) that seems valid if I haven't missed something:

 add_col_or_row = function(x, n = 1, add_col = T, fill = 0) { m1 = matrix(x, ncol = if(add_col) nrow(x) * ncol(x) else nrow(x), byrow = T) m2 = matrix(fill, nrow = if(add_col) dim(x)[3] else prod(dim(x)[-1]), ncol = if(add_col) nrow(x) * n else n) array(t(cbind(m1, m2)), c(nrow(x) + ((!add_col) * n), ncol(x) + (add_col * n), dim(x)[3])) } aa = array(1:24, c(3, 4, 2)) aa #, , 1 # # [,1] [,2] [,3] [,4] #[1,] 1 4 7 10 #[2,] 2 5 8 11 #[3,] 3 6 9 12 # #, , 2 # # [,1] [,2] [,3] [,4] #[1,] 13 16 19 22 #[2,] 14 17 20 23 #[3,] 15 18 21 24 add_col_or_row(aa, 2, T) #, , 1 # # [,1] [,2] [,3] [,4] [,5] [,6] #[1,] 1 4 7 10 0 0 #[2,] 2 5 8 11 0 0 #[3,] 3 6 9 12 0 0 # #, , 2 # # [,1] [,2] [,3] [,4] [,5] [,6] #[1,] 13 16 19 22 0 0 #[2,] 14 17 20 23 0 0 #[3,] 15 18 21 24 0 0 # add_col_or_row(aa, 2, F) #, , 1 # # [,1] [,2] [,3] [,4] #[1,] 1 4 7 10 #[2,] 2 5 8 11 #[3,] 3 6 9 12 #[4,] 0 0 0 0 #[5,] 0 0 0 0 # #, , 2 # # [,1] [,2] [,3] [,4] #[1,] 13 16 19 22 #[2,] 14 17 20 23 #[3,] 15 18 21 24 #[4,] 0 0 0 0 #[5,] 0 0 0 0 

And a benchmark using data from David Arenburg:

 microbenchmark(flodel1(df), add_col_or_row(df), times = 20) #Unit: milliseconds # expr min lq median uq max neval # flodel1(df) 35.69158 54.88014 55.58363 56.40300 58.31250 20 # add_col_or_row(df) 19.87134 38.57792 39.11297 39.58347 44.59873 20 identical("dimnames<-"(flodel1(df), NULL), add_col_or_row(df)) #[1] TRUE