Przyspieszenie obliczeń współczynnika Dice w C/Rcpp

Question

Muszę obliczyć miarę podobieństwa, wywołując współczynnik Dice na dużych macierzach (600 000 x 500) wektorów binarnych w R. Dla prędkości używam C/Rcpp. Ta funkcja działa świetnie, ale ponieważ nie jestem informatykiem w tle, chciałabym wiedzieć, czy mogłaby działać szybciej. Ten kod jest odpowiedni do równoległości, ale nie mam doświadczenia z równoległym kodowaniem C.

Współczynnik kości jest prostą miarą podobieństwa/odmienności (w zależności od tego, jak ją bierzesz). Ma on na celu porównanie asymetrycznych wektorów binarnych, co oznacza, że ​​jedna z kombinacji (zwykle 0-0) nie jest ważna, a zgodność (1-1 par) ma większą wagę niż różnica zdań (1-0 lub 0-1 par). Wyobraźmy sobie następującą tabelę awaryjnych:

1 0 
1 a b 
0 c d 

Dice COEF jest: (2 * a)/(2 * a + b + c)

Oto moja realizacja 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); 
    } 
') 

i tu jest uruchomiony przykład:

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

Proponowana przez Roland rozwiązanie nie było całkowicie satysfakcjonujące dla mojego przypadku użycia. Tak więc na podstawie kodu źródłowego z pakietu arules implementuję znacznie szybszą wersję. Kod w arules polegać na algorytmie z Leisch (2005) za pomocą funkcji tcrossproduct() w R.

Najpierw napisałem wersję RCPP/RcppEigen o crossprod że jest 2-3 razy szybsze. Jest to oparte na przykładowym kodzie winiety RcppEigen.

Potem napisałem małą funkcję R do obliczenia współczynnika 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) 
} 

Ta nowa funkcja jest ~ 8 razy szybsze niż stary i ~ 3 razy szybsze niż w 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

nie mogę uruchomić funkcję w pracy, ale to wynik taki sam, jak ten?

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

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