Question

我想加快以下R函数的速度。对于矩阵“ A”中的每一列，找到索引（不是自身），该索引与向量的另一个元素以及对称相关矩阵R中的各个元素的乘积最大。

当前，在计算外积时存在一些冗余，因为它不必要地生成完整矩阵。同样，循环（即“应用”）在理想情况下应进行矢量化处理。

以下示例数据。

    set.seed(123)
    A <- matrix(rexp(30000, rate=.1), nrow=3000, ncol=2000)/100
    R <- matrix( runif(10000), 3000 , 3000 )
    diag(R) <- 1
    R[upper.tri(R)] <- R[lower.tri(R)]

    function_which_is_too_slow <- function(index){
        aar <- outer(A[,index], A[,index]) * R
        diag(aar) <- 0
        return(max.col(aar, 'first'))
    }

    out <- apply(matrix(1:dim(A)[2]), 1, function_which_is_too_slow)

Answer 1

将您的代码作为具有较小问题大小的基线：

set.seed(123)
A <- matrix(rexp(30000, rate=.1), nrow=3000, ncol=40)/100
R <- matrix( runif(10000), 3000 , 3000 )
diag(R) <- 1
R[upper.tri(R)] <- R[lower.tri(R)]

function_which_is_too_slow <- function(index){
  aar <- outer(A[,index], A[,index]) * R
  diag(aar) <- 0
  return(max.col(aar, 'first'))
}

system.time(apply(matrix(1:dim(A)[2]), 1, function_which_is_too_slow))
#>        User      System verstrichen 
#>      12.001      11.388      10.348

如果我们使用对角线设置为零的相关矩阵的副本，则每次都不需要将对角线设置为零。使用lapply代替apply看起来更好：

Rp <- R
diag(Rp) <- 0

faster_function <- function(index){
  aar <- outer(A[,index], A[,index]) * Rp
  return(max.col(aar, 'first'))
}
system.time(lapply(1:ncol(A), faster_function))
#>        User      System verstrichen 
#>      11.156      10.306       8.334

我们还可以使用RcppArmadillo在C ++中进行相同的计算

Rcpp::cppFunction(code = "
arma::uvec arma_function(const arma::mat &A, const arma::mat &Rp, int index) {
  arma::mat aar = A.col(index-1) * A.col(index-1).t() % Rp;
  return index_max(aar, 1) + 1;
} 
", depends ="RcppArmadillo")
system.time(lapply(1:ncol(A), arma_function, A = A, Rp = Rp))
#>        User      System verstrichen 
#>       7.382      10.578       4.874

我们可以并行化计算，尽管RcppArmadillo已使用OpenMP（如果可用）：

system.time(parallel::mclapply(1:ncol(A), arma_function, A = A, Rp = Rp))
#>        User      System verstrichen 
#>       0.008       0.010       3.903

总体来说，快3倍左右，这不是很多。

加快向量乘法

1 个答案: