[R] filling an array, vectorized

[Robin Hankin]

Hello again everyone.


I've further added to Martin and Gabor's suggestion an ellipsis to
pass additional arguments to f().   Cut-n-paste below.

BUT.....do.index() comes with a Warning: function arow() of the magic
package is much much much  faster; use it if at  all possible:




  a <- array(0, c(2, 3, 4, 2, 3, 3, 2, 3, 2, 3))

  f1 <- function(i) {   arow(a, i)}
f2 <- function(x) {  sum(x) }

  "++" <- function(x, ...) if (nargs() == 1) x else x +
     Recall(...)


 > system.time(ignore1 <- do.call("++", sapply(1:4, f1,
     simplify = FALSE)))
[1] 0.041 0.013 0.054 0.000 0.000

 > system.time(ignore1 <- do.call("++", sapply(1:4, f1,
     simplify = FALSE)))
[1] 0.029 0.009 0.040 0.000 0.000

 > system.time(ignore1 <- do.call("++", sapply(1:4, f1,
     simplify = FALSE)))
[1] 0.028 0.009 0.038 0.000 0.000

 > system.time(ignore2 <- do.index(a, f2))
[1] 0.387 0.028 0.440 0.000 0.000

 > system.time(ignore2 <- do.index(a, f2))
[1] 0.380 0.025 0.406 0.000 0.000

 > system.time(ignore2 <- do.index(a, f2))
[1] 0.376 0.029 0.422 0.000 0.000
 >










  do.index <-
function (a, f, ...)
{
     jj <- function(i) {
         seq_len(dim(a)[i])
     }
     index <- as.matrix(expand.grid(lapply(seq_len(length(dim(a))),
         jj), KEEP.OUT.ATTRS = FALSE))
     a[index] <- apply(index, 1, f, ...)
     return(a)
}

arow <-
function (a, i)
{
     p <- 1:prod(dim(a))
     n <- length(dim(a))
     d <- dim(a)[i]
     permute <- c(i, (1:n)[-i])
     a <- aperm(a, permute)
     a[] <- p
     permute[permute] <- 1:n
     return(force.integer(aperm(process(a, d), permute)))
}






--
Robin Hankin
Uncertainty Analyst
National Oceanography Centre, Southampton
European Way, Southampton SO14 3ZH, UK
  tel  023-8059-7743