Multidimensional vectorization of a for loop in R for two 2D arrays? I tried multiApply

Viewed 34

I am trying to perform a multidimensional vectorization in R instead of using a for loop. I have two 2D matrices A and W, that I pass to crit.func(A, W).

The original for loop effectively iterates over versions of A and W:

for(current.couple in 1:nrow(couples)){
  a_current <- current.rows[-which(current.rows == couples$current[current.couple])]
  a_candidate <- couples$candidate[current.couple]
  
  A <- A.use[ c(a_current, a_candidate),]
  W <- W.use[ c(a_current, a_candidate), c(a_current, a_candidate)]
  couples$D[ current.couple] <- crit.func(A, W)
}

What I would like to do instead for speed is create a vectorized version. My idea is to stack all versions of A and W to form two 3D arrays and then use the 3rd dimension, the depth, as the vectorized dimension. For example, let's say I have the following A and W matrices:

A1 <- matrix(c(2.4, 5.2, 8.4, 3.1, 6.05, 9.25), nrow = 2,ncol = 3, byrow = TRUE)
A2 <- matrix(c(4.5, 7.5, 10.5, 3.2, 6.2, 9.2), nrow = 2, ncol = 3, byrow = TRUE)
A3 <- matrix(c(2.1, 5, 8.2, 3.05, 6.02, 9.1), nrow = 2,ncol = 3, byrow = TRUE)
A4 <- matrix(c(4.12, 7.31, 10.3, 3.23, 6.1, 9), nrow = 2, ncol = 3, byrow = TRUE)

W1 <- matrix(c(1, 4, 2, 5), nrow = 2, ncol = 2, byrow = TRUE)
W2 <- matrix(c(9, 6, 8, 5), nrow = 2, ncol = 2, byrow = TRUE)
W3 <- matrix(c(1, 4.2, 2.2, 5.2), nrow = 2, ncol = 2, byrow = TRUE)
W4 <- matrix(c(9.05, 6.011, 8.3, 5.2), nrow = 2, ncol = 2, byrow = TRUE)

I would then form the 3D arrays with:

# Z stack all of the A options
A_append <- array(c(A1, A2, A3, A4), c(2, 3, 4))
# Z stack all of the W options 
W_append <- array(c(W1, W2, A3, A4), c(2, 2, 4))

If crit.func() takes the determinant so that:

crit.func <- function( A, W){
  return( det( t(A) %*% W %*% A))
}

The expected result for a vectorized solution will be:

[2.095476e-12, 0, -7.067261e-12, 7.461713e-12].

What I have tried to do is use the package multiApply

library(multiApply)

A_append <- provideDimnames(A_append ,sep = "_", base = list('row','col','lev'))
W_append <- provideDimnames(W_append ,sep = "_", base = list('row','col','lev'))

# multiApply
D <- Apply(data = list(A_append, W_append), target_dims = c(1, 2, NULL), margins = 3, fun = crit.func)$output1

but I do not get the correct output (see below). I believe that first using list(A_append, W_append) as I did is not giving the behavior I want, and I somehow have to name the dimensions in another way as I get the following warning:

"Guessed names for some unnamed dimensions of equal
length found across different inputs in 'data'. Please
check carefully the assumed names below are correct, or
provide dimension names for safety, or disable the 
parameter guess_dim_names."

    Input 1:
        _unnamed_dim_1_ _unnamed_dim_2_ _unnamed_dim_3_ 
                      2               3               4 
    Input 2:
        _unnamed_dim_1_ _unnamed_dim_4_ _unnamed_dim_3_ 
                      2               2               4 
[1] "The output of multiApply:"
[1]  2.095476e-12  0.000000e+00  4.562232e-12 -1.450281e-11

Does anybody know of either a better way to vectorize this for loop to get the expected behavior? Or, can you see how to change the arguments I provided to multiApply's Apply() to correctly pass (A_append[, ,i], W_append[,,i]) to crit.func()?

1 Answers

It may be simpler to use lists to store your matrices:

A <- list(A1, A2, A3, A4)
W <- list(W1, W2, W3, W4)
mapply(crit.func, A, W)
# [1]  1.850935e-12  0.000000e+00  6.025116e-12 -8.291046e-13

These numbers do not match your expected values, but they seem to be correct for your data:

crit.func(A1, W1)
# [1] 1.850935e-12
crit.func(A2, W2)
# [1] 0
crit.func(A3, W3)
# [1] 6.025116e-12
crit.func(A4, W4)
# [1] -8.291046e-13
Related