Adding column or row in 3D array

Question

I've got 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, filled with 0, to finally have this :

, , 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 a simple 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 another one:

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

Answer 2

You could also try something like (though its a bit manual but should be faster than the other base R solution)

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

Some benchmarks

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 unless I've 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 David Arenburg's data:

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