outer() equivalent for non-vector lists in R

后端 未结 3 1115
孤独总比滥情好
孤独总比滥情好 2020-12-31 15:38

I understand how outer() works in R:

> outer(c(1,2,4),c(8,16,32), \"*\")

     [,1] [,2] [,3]
[1,]    8   16   32
[2,]   16   32   64
[3,]   32   64  128
         


        
相关标签:
3条回答
  • 2020-12-31 15:40

    Just use the for loop. Any built-in functions will degenerate to that anyway, and you'll lose clarity of expression, unless you carefully build a function that generalises outer to work with lists.

    The biggest improvement you could make would be to preallocate the matrix:

    M <- list()
    length(M) <- numElements ^ 2
    dim(M) <- c(numElements, numElements)
    

    PS. A list is a vector.

    0 讨论(0)
  • 2020-12-31 16:01

    Although this is an old question, here is another solution that is more in the spirit of the outer function. The idea is to apply outer along the indices of list1 and list2:

    cor2 <- Vectorize(function(x,y) {
       vec1 <- list1[[x]]
       vec2 <- list2[[y]]
       cor(vec1,vec2,method="spearman")
    })
    outer(1:length(list1), 1:length(list2), cor2)
    
    0 讨论(0)
  • 2020-12-31 16:03

    The outer function actually DOES work on lists, but the function that you provide gets the two input vectors repeated so that they contain all possible combinations...

    As for which is faster, combining outer with vapply is 3x faster than the double for-loop on my machine. If the actual kernel function does "real work", the difference in looping speed is probably not so important.

    f1 <- function(a,b, fun) {
      outer(a, b, function(x,y) vapply(seq_along(x), function(i) fun(x[[i]], y[[i]]), numeric(1)))
    }
    
    f2 <- function(a,b, fun) {
        kernelMatrix <- matrix(0L, length(a), length(b))
        for (i in seq_along(a))
        {
           for (j in seq_along(b))
           {
              kernelMatrix[i,j] = fun(a[[i]], b[[j]])
           }
        }
        kernelMatrix
    }
    
    n <- 300
    m <- 2
    a <- lapply(1:n, function(x) matrix(runif(m*m),m))
    b <- lapply(1:n, function(x) matrix(runif(m*m),m))
    kernelFunction <- function(x,y) 0 # dummy, so we only measure the loop overhead
    
    > system.time( r1 <- f1(a,b, kernelFunction) )
       user  system elapsed 
       0.08    0.00    0.07 
    > system.time( r2 <- f2(a,b, kernelFunction) )
       user  system elapsed 
       0.23    0.00    0.23 
    > identical(r1, r2)
    [1] TRUE
    
    0 讨论(0)
提交回复
热议问题