How to generalize outer to n dimensions?

前端 未结 3 1870
独厮守ぢ
独厮守ぢ 2020-12-03 08:58

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

相关标签:
3条回答
  • 2020-12-03 09:21

    I think we can do this using Outer and Vectorize.

     sigm = function(a=0,b=0,x){
     return(exp(x*a+b))
     }
    
     sigm1 = Vectorize(function(a=-1:1,b=-1:1,x){
    
     outer(a,b,sigm,x)
     },SIMPLIFY = FALSE)
    

    Now, sigm1(x=1:3) gives the required output

     [[1]]
          [,1]      [,2]     [,3]
     [1,] 0.1353353 0.3678794 1.000000
     [2,] 0.3678794 1.0000000 2.718282
     [3,] 1.0000000 2.7182818 7.389056
    
    [[2]]
           [,1]      [,2]       [,3]
    [1,] 0.04978707 0.1353353  0.3678794
    [2,] 0.36787944 1.0000000  2.7182818
    [3,] 2.71828183 7.3890561 20.0855369
    
    [[3]]
           [,1]        [,2]       [,3]
    [1,] 0.01831564  0.04978707  0.1353353
    [2,] 0.36787944  1.00000000  2.7182818
    [3,] 7.38905610 20.08553692 54.5981500
    

    The only draw back with this code snippet is I am using the default values of a=-1:1 and b=-1:1. When I try to pass the same during function calling, it goes haywire. E.g.

    sigm1(-1:1,-1:1,1:3)
    
    [[1]]
          [,1]
    [1,] 0.1353353
    
    [[2]]
     [,1]
    [1,]    1
    
    [[3]]
         [,1]
    [1,] 54.59815
    

    I am unable to figure out why passing the arguments is making this difference in output.

    0 讨论(0)
  • 2020-12-03 09:25

    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"
    
    0 讨论(0)
  • 2020-12-03 09:44

    How about this:

    
    multi.outer<-function(f,...){
    
      apply(expand.grid(...),1,function(x){do.call(f,as.list(x))})
    
    }
    
    0 讨论(0)
提交回复
热议问题