使用apply从矩阵构建特征张量

Question

Consider the following code:

EmbedFeatures <- function(x,w) {
     c_rev <- seq(from=w,to=1,by=-1)
     em <- embed(x,w)
     em <- em[,c_rev]
     return(em)
}

m=matrix(1:1400,100,14)

X.tr<-c()
F<-dim(m)[2]
W=16
for(i in 1:F){ X.tr<-abind(list(X.tr,EmbedFeatures(m[,i],W)),along=3)}

this builds an array of features, each row has W=16 timesteps. The dimensions are:

> dim(X.tr)
[1] 85 16 14

The following are the first samples:

> X.tr[1,,1]
 [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
> X.tr[1,,2]
 [1] 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
> X.tr[1,,3]
 [1] 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216

I would like to use apply to build this array, but the following code does not work:

X.tr <- apply(m,2,EmbedFeatures, w=W)

since it gives me the following dimensions:

> dim(X.tr)
[1] 1360   14

How can I do it?

Answer 1

Firstly, thanks for providing a great reproducible example!

Now, as far as I know, you can't do this with apply . You can, however, do it with a combination of plyr::aaply , which allows you to return multidimensional arrays, and base::aperm , which allows you to transpose multidimensional arrays.

See here for aaply function details and here for aperm function details.

After running your code above, you can do:

library(plyr)
Y.tr <- plyr::aaply(m, 2, EmbedFeatures, w=W)
Z.tr <- aperm(Y.tr, c(2,3,1))

dim(Y.tr)
[1] 14 85 16

dim(Z.tr)
[1] 85 16 14

I turned those two lines of code into a function.

using_aaply <- function(m = m) {
    Y.tr <- aaply(m, 2, EmbedFeatures, w=W)
    Z.tr <- aperm(Y.tr, c(2,3,1))
    return(Z.tr)
}

Then I did some microbenchmarking.

library(microbenchmark)
microbenchmark(for(i in 1:F){ X.tr<-abind(list(X.tr,EmbedFeatures(m[,i],W)),along=3)}, times=100)

Unit: milliseconds
                                                                                  expr
 for (i in 1:F) {     X.tr <- abind(list(X.tr, EmbedFeatures(m[, i], W)), along = 3) }
      min       lq     mean   median       uq      max neval
 405.0095 574.9824 706.0845 684.8531 802.4413 1189.845   100

microbenchmark(using_aaply(m=m), times=100)

Unit: milliseconds
               expr      min       lq     mean   median       uq      max
 using_aaply(m = m) 4.873627 5.670474 7.797129 7.083925 9.674041 19.74449
 neval
   100

It seems like it's loads faster using aaply and aperm compared to abind in a for-loop.