r - 提高矩阵或数组的计算性能

Question

我想优化我的矩阵计算。

我的代码生成一个数组 (p x q x n x n)。

令x:n x p矩阵，v:q x 1向量

 
f1 <- function(i){
  sapply(seq_along(1:n), function(j) outer(x[i,]-x[j,], v, "*")^2, simplify = "array") 
}

sapply(seq_along(1:n), FUN = f1, simplify = "array")

由于数组很大，我发现这段代码应该花费很多内存空间。

然后，其性能的提高受到并行计算或其他apply方法的限制。

如何提高计算性能？

Answer 1

以下方法将我的机器上的执行时间减少了 40%:

• 避免冗余计算(无论是x[i,]-x[j,]还是v. v.进入方程，平方外积都是相同的)
• 为平方外积提供零矩阵，其中 i == j
• 预先确定结果数组的尺寸并...
• 最终在正确的位置填充结果数组

原函数:

f_original <- function(){
  f1 <- function(i){
    sapply(seq_along(1:n), function(j) outer(x[i,]-x[j,], v, "*")^2,
           simplify = "array") 
  }
  sapply(seq_along(1:n), FUN = f1, simplify = "array")
}

替代方案:

f_alternative <- function(){
  ## dimension the resulting array in advance:
  res = array(NA, c(p, q, n, n))
  ## these are the possible outcomes, because
  ## the order of i and j does not matter: 
  values <- combn(1:n,
                  m = 2,
                  FUN = function(ab){
                    a = ab[1]; b = ab[2]
                    outer(x[a,] - x[b,], v, '*')^2
                  }
                  )
  ## create all combinations of i and j, where i != j
  indices <- t(combn(1:n, m = 2))
  ## fill the result array at the positions ,,i,j and ,,j,i:
  for(r in 1:nrow(indices)){
    a = indices[r, 1]
    b = indices[r, 2]
    res[, , a, b] = res[ , , b , a] = values[ , , r]
  }
  ## fill the positions ,,i,j and ,,j,i with a zero matrix,
  ## (results from i == j):
  for(r in 1:n) res[, , r, r] = array(0, p * q)

  return(res)
}

基准测试:

library(microbenchmark)

## initialize:
n = 30
p = 2
q = 5
x = matrix(rnorm(n * p), n, p)
v = rnorm(q)

microbenchmark(f_original(), times = 1e3)
## Unit: milliseconds
##          expr    min      lq     mean  median      uq    max neval
##  f_original() 7.4636 8.10685 9.274144 9.08785 9.97285 74.976  1000

microbenchmark(f_alternative(), times = 1e3)
## Unit: milliseconds
##             expr    min      lq     mean median     uq     max neval
## f_alternative() 4.7369 5.08235 5.941499 5.3563 6.7484 60.7656  1000