How to generalize outer to n dimensions?

Question

The standard R expression outer(X, Y, f) evaluates to a matrix whose (i, j)-th entry has the value f(X[i], Y[j]).

I would like to implement the function multi.outer, an n-dimensional generalization of outer: multi.outer(f, X_1, ..., X_n), where f is some n-ary function, would produce a (length(X_1) * ... * length(X_n)) array whose (i_1,...,i_n)-th entry has the value f(X_1[i_1], ..., X_n[i_n]) for all valid index sets (i_1,...,i_n). Clearly, for each i in {1, ..., n}, all the elements of X_i in multi.outer(f, X_1,...,X_i,..., X_n) must be allowable i-th arguments for the function f. For the case n=2, multi.outer would do the same thing as outer, although it would have a different signature (IOW, multi.outer(f, X, Y) would be equivalent to outer(X, Y, f)).

It is important to note that, although the arguments X_1, ..., X_n of multi.outer are all vectors, they don't necessarily all have the same mode. E.g. X_1 and X_2 could be c(1, 2, 3) and LETTERS[10:20], respectively.

Thanks!

Answer 1

This is one way: First use Vectorize and outer to define a function that creates an n-dimensional matrix where each entry is a list of arguments on which the given function will be applied:

list_args <- Vectorize( function(a,b) c( as.list(a), as.list(b) ), 
                        SIMPLIFY = FALSE)


make_args_mtx <- function( alist ) {
  Reduce(function(x, y) outer(x, y, list_args), alist)
}

Now multi.outer just needs to invoke apply and do.call on this "args-matrix" :

multi.outer <- function(f, ... ) {
  args <- make_args_mtx(list(...))
  apply(args, 1:length(dim(args)), function(a) do.call(f, a[[1]] ) )
}

Let's try this with an example function:

fun <- function(a,b,c) paste(a,b,c)

ans <- multi.outer(fun, LETTERS[1:2], c(3, 4, 5), letters[6:7] )

> ans
, , 1

     [,1]    [,2]    [,3]   
[1,] "A 3 f" "A 4 f" "A 5 f"
[2,] "B 3 f" "B 4 f" "B 5 f"

, , 2

     [,1]    [,2]    [,3]   
[1,] "A 3 g" "A 4 g" "A 5 g"
[2,] "B 3 g" "B 4 g" "B 5 g"

Answer 2

How about this:

multi.outer<-function(f,...){

  apply(expand.grid(...),1,function(x){do.call(f,as.list(x))})

}