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

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)使用tcrossproduct()R中的函数的算法.

首先,我写了一个Rcpp/RcppEigen版本,crossprod这个版本要快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倍,比原来快3倍arules.

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