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()?