Question

我需要计算一个相似性度量，在R中用大矩阵（600,000 x 500）的二进制向量调用Dice系数。对于速度，我使用C / Rcpp。该功能运行良好但由于我不是背景的计算机科学家，我想知道它是否可以运行得更快。此代码适用于并行化，但我没有经验并行化C代码。

骰子系数是相似性/不相似性的简单度量（取决于你如何看待它）。它旨在比较不对称二元向量，意味着组合中的一个（通常为0-0）不重要，并且协议（1-1对）具有比不一致（1-0或0-1对）更多的权重。想象一下下面的列联表：

   1    0
1  a    b
0  c    d

骰子系数为：（2 * a）/（2 * a + b + c）

这是我的Rcpp实现：

library(Rcpp)
cppFunction('
    NumericMatrix dice(NumericMatrix binaryMat){
        int nrows = binaryMat.nrow(), ncols = binaryMat.ncol();
        NumericMatrix results(ncols, ncols);
        for(int i=0; i < ncols-1; i++){ // columns fixed
            for(int j=i+1; j < ncols; j++){ // columns moving
                double a = 0;
                double d = 0;
                for (int l = 0; l < nrows; l++) {
                    if(binaryMat(l, i)>0){
                        if(binaryMat(l, j)>0){
                            a++;
                        }
                    }else{
                        if(binaryMat(l, j)<1){
                            d++;
                        }
                    }
                }
                // compute Dice coefficient         
                double abc = nrows - d;
                double bc = abc - a;
                results(j,i) = (2*a) / (2*a + bc);          
            }
        }
        return wrap(results);
    }
')

这是一个正在运行的例子：

x <- rbinom(1:200000, 1, 0.5)
X <- matrix(x, nrow = 200, ncol = 1000)
system.time(dice(X))
  user  system elapsed
  0.814   0.000   0.814

Answer 1

Roland提出的解决方案对我的用例并不完全令人满意。因此，基于arules包中的源代码，我实现了更快的版本。 arules中的代码依赖于Leisch（2005）使用R中的tcrossproduct()函数的算法。

首先，我写了crossprod的Rcpp / RcppEigen版本，速度提高了2-3倍。这基于RcppEigen插图中的示例代码。

library(Rcpp)
library(RcppEigen)
library(inline)
crossprodCpp <- '
using Eigen::Map;
using Eigen::MatrixXi;
using Eigen::Lower;

const Map<MatrixXi> A(as<Map<MatrixXi> >(AA));

const int m(A.rows()), n(A.cols());

MatrixXi AtA(MatrixXi(n, n).setZero().selfadjointView<Lower>().rankUpdate(A.adjoint()));

return wrap(AtA);
'

fcprd <- cxxfunction(signature(AA = "matrix"), crossprodCpp, "RcppEigen")

然后我写了一个小R函数来计算Dice系数。

diceR <- function(X){
    a <- fcprd(X)

nx <- ncol(X)
rsx <- colSums(X)

c <- matrix(rsx, nrow = nx, ncol = nx) - a
# b <- matrix(rsx, nrow = nx, ncol = nx, byrow = TRUE) - a
b <- t(c)

m <- (2 * a) / (2*a + b + c)
return(m)
}

这个新函数比旧函数快8倍，比arules快〜3倍。

m <- microbenchmark(dice(X), diceR(X), dissimilarity(t(X), method="dice"), times=100)
m
# Unit: milliseconds
#                                  expr       min       lq    median       uq      max neval
#                               dice(X) 791.34558 809.8396 812.19480 814.6735 910.1635   100
#                              diceR(X)  62.98642  76.5510  92.02528 159.2557 507.1662   100
#  dissimilarity(t(X), method = "dice") 264.07997 342.0484 352.59870 357.4632 520.0492   100

Answer 2

我无法在工作中运行您的功能，但结果与此相同吗？

library(arules)
plot(dissimilarity(X,method="dice"))

system.time(dissimilarity(X,method="dice"))
#user  system elapsed 
#0.04    0.00    0.04

enter image description here

加快C / Rcpp中Dice系数的计算

2 个答案: