Efektywne podobieństwo jaccard DocumentTermMatrix

Question

Chciałbym skutecznie obliczyć podobieństwo Jaccard między dokumentami tm::DocumentTermMatrix. Mogę zrobić coś podobnego do podobieństwa cosinus poprzez pakiet slam jak pokazano w this answer. natknąłem się na another question and response na CrossValidated, który był specyficzny dla R, ale o algebrę macierzy niekoniecznie najbardziej wydajną. Próbowałem zaimplementować to rozwiązanie z bardziej wydajnymi funkcjami slam, ale nie mam takiego samego rozwiązania, jak w przypadku mniej efektywnego podejścia do wymuszania DTM na macierzy i używania proxy::dist.

Jak mogę skutecznie obliczyć podobieństwo Jaccard między dokumentami dużego DocumentTermMatrix w R?

#data & Pacages

library(Matrix);library(proxy);library(tm);library(slam);library(Matrix) 

mat <- structure(list(i = c(1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 3L, 1L, 
    2L, 3L, 3L, 3L, 4L, 4L, 4L, 4L), j = c(1L, 1L, 2L, 2L, 3L, 3L, 
    4L, 4L, 4L, 5L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L), v = c(1, 
    1, 1, 1, 2, 2, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1), nrow = 4L, 
     ncol = 12L, dimnames = structure(list(Docs = c("1", "2", 
     "3", "4"), Terms = c("computer", "is", "fun", "not", "too", 
     "no", "it's", "dumb", "what", "should", "we", "do")), .Names = c("Docs", 
     "Terms"))), .Names = c("i", "j", "v", "nrow", "ncol", "dimnames" 
    ), class = c("DocumentTermMatrix", "simple_triplet_matrix"), weighting = c("term frequency", 
    "tf")) 

#Inefficient obliczania (oczekiwany wynik)

proxy::dist(as.matrix(mat), method = 'jaccard') 

##  1  2  3 
## 2 0.000    
## 3 0.875 0.875  
## 4 1.000 1.000 1.000 

#My Próba

A <- slam::tcrossprod_simple_triplet_matrix(mat) 
im <- which(A > 0, arr.ind=TRUE) 
b <- slam::row_sums(mat) 
Aim <- A[im] 

stats::as.dist(Matrix::sparseMatrix(
     i = im[,1], 
     j = im[,2], 
     x = Aim/(b[im[,1]] + b[im[,2]] - Aim), 
     dims = dim(A) 
)) 

##  1 2 3 
## 2 2.0   
## 3 0.1 0.1  
## 4 0.0 0.0 0.0 

Wyjścia nie są zgodne.

FYI Oto oryginalny tekst:

c("Computer is fun. Not too fun.", "Computer is fun. Not too fun.", 
    "No it's not, it's dumb.", "What should we do?") 

będę oczekiwać elementy 1 & 2 będzie 0 i odległość elementu 3, aby być bliżej niż elementu elementu 1 1 i 4 (Spodziewam najdalej odległość jako brak słów są wspólne), jak widać w rozwiązaniu proxy::dist.

EDIT

Należy pamiętać, że nawet w średniej wielkości DTM matryca staje się ogromna. Oto przykład z pakietem wegańska. Uwaga 4 minuty na rozwiązanie, gdy podobieństwo cosinusa wynosi ~ 5 sekund.

library(qdap); library(quanteda);library(vegan);library(slam) 
x <- quanteda::convert(quanteda::dfm(rep(pres_debates2012$dialogue), stem = FALSE, 
     verbose = FALSE, removeNumbers = FALSE), to = 'tm') 


## <<DocumentTermMatrix (documents: 2912, terms: 3368)>> 
## Non-/sparse entries: 37836/9769780 
## Sparsity   : 100% 
## Maximal term length: 16 
## Weighting   : term frequency (tf) 

tic <- Sys.time() 
jaccard_dist_mat <- vegan::vegdist(as.matrix(x), method = 'jaccard') 
Sys.time() - tiC#Time difference of 4.01837 mins 

tic <- Sys.time() 
tdm <- t(x) 
cosine_dist_mat <- 1 - crossprod_simple_triplet_matrix(tdm)/(sqrt(col_sums(tdm^2) %*% t(col_sums(tdm^2)))) 
Sys.time() - tiC#Time difference of 5.024992 secs 

Answer 1

Jaccard środek jest środkiem między ZESTAWÓW i matrycy wejściowej należy binarny. very first line mówi:

## common values: 
A = tcrossprod(m) 

W przypadku bag-of-słów DTM nie jest to liczba wspólnych wartościach!

library(text2vec) 
library(magrittr) 
library(Matrix) 

jaccard_similarity <- function(m) { 
    A <- tcrossprod(m) 
    im <- which(A > 0, arr.ind=TRUE, useNames = F) 
    b <- rowSums(m) 
    Aim <- A[im] 
    sparseMatrix(
    i = im[,1], 
    j = im[,2], 
    x = Aim/(b[im[,1]] + b[im[,2]] - Aim), 
    dims = dim(A) 
) 
} 

jaccard_distance <- function(m) { 
    1 - jaccard_similarity(m) 
} 

cosine <- function(m) { 
    m_normalized <- m/sqrt(rowSums(m^2)) 
    tcrossprod(m_normalized) 
} 

Benchmarki:

data("movie_review") 
tokens <- movie_review$review %>% tolower %>% word_tokenizer 

dtm <- create_dtm(itoken(tokens), hash_vectorizer(hash_size = 2**16)) 
dim(dtm) 
# 5000 65536 

system.time(dmt_cos <- cosine(dtm)) 
# user system elapsed 
# 2.524 0.169 2.693 

system.time({ 
    dtm_binary <- transform_binary(dtm) 
    # or simply 
    # dtm_binary <- sign(dtm) 
    dtm_jac <- jaccard_similarity(dtm_binary) 
}) 
# user system elapsed 
# 11.398 1.599 12.996 
max(dtm_jac) 
# 1 
dim(dtm_jac) 
# 5000 5000 

EDIT 1.07.2016:

Zobacz jeszcze szybszą wersję z text2vec 0.4 (~ 2.85x kiedy nie trzeba konwertować z dgCMatrix do dgTMatrix i ~ 1.75x whe n potrzebna kolumna główna dgCMatrix)

jaccard_dist_text2vec_04 <- function(x, y = NULL, format = 'dgCMatrix') { 
    if (!inherits(x, 'sparseMatrix')) 
    stop("at the moment jaccard distance defined only for sparse matrices") 
    # union x 
    rs_x = rowSums(x) 
    if (is.null(y)) { 
    # intersect x 
    RESULT = tcrossprod(x) 
    rs_y = rs_x 
    } else { 
    if (!inherits(y, 'sparseMatrix')) 
     stop("at the moment jaccard distance defined only for sparse matrices") 
    # intersect x y 
    RESULT = tcrossprod(x, y) 
    # union y 
    rs_y = rowSums(y) 
    } 
    RESULT = as(RESULT, 'dgTMatrix') 
    # add 1 to indices because of zero-based indices in sparse matrices 
    # 1 - (...) because we calculate distance, not similarity 
    RESULT@x <- 1 - RESULT@x/(rs_x[RESULT@i + 1L] + rs_y[RESULT@j + 1L] - RESULT@x) 
    if (!inherits(RESULT, format)) 
    RESULT = as(RESULT, format) 
    RESULT 
} 
system.time({ 
    dtm_binary <- transform_binary(dtm) 
    dtm_jac <-jaccard_dist(dtm_binary, format = 'dgTMatrix') 
}) 
# user system elapsed 
# 4.075 0.517 4.593 
system.time({ 
    dtm_binary <- transform_binary(dtm) 
    dtm_jac <-jaccard_dist(dtm_binary, format = 'dgCMatrix') 
}) 
# user system elapsed 
# 6.571 0.939 7.516 

Answer 2

Jak o vegdist() z pakietu vegan? Używa C-Code i jest ok. 10x szybciej niż pełnomocnika:

library(vegan) 
vegdist(as.matrix(mat), method = 'jaccard') 
## 1 2 3 
## 2 0.0   
## 3 0.9 0.9  
## 4 1.0 1.0 1.0 

library(microbenchmark) 
matt <- as.matrix(mat) 
microbenchmark(proxy::dist(matt, method = 'jaccard'), 
       vegdist(matt, method = 'jaccard')) 

## Unit: microseconds 
##         expr  min  lq  mean 
## proxy::dist(matt, method = "jaccard") 4879.338 4995.2755 5133.9305 
##  vegdist(matt, method = "jaccard") 587.935 633.2625 703.8335 
## median  uq  max neval 
## 5069.203 5157.520 7549.346 100 
## 671.466 723.569 1305.357 100 

Answer 3

Korzystanie stringdistmatrix z pakietu stringdist i używając opcji nthread uruchomić go równolegle, przyspiesza go całkiem sporo. średnio sześć sekund wolniej niż testy z podobieństwem cosinusów.

library(qdap) 
library(slam) 
library(stringdist) 
data(pres_debates2012) 

x <- quanteda::convert(quanteda::dfm(rep(pres_debates2012$dialogue), stem = FALSE, 
            verbose = FALSE, removeNumbers = FALSE), to = 'tm') 

tic <- Sys.time() 
tdm <- t(x) 
cosine_dist_mat <- 1 - crossprod_simple_triplet_matrix(tdm)/(sqrt(col_sums(tdm^2) %*% t(col_sums(tdm^2)))) 
Sys.time() - tiC#Time difference of 4.069233 secs 

tic <- Sys.time() 
t <- stringdistmatrix(pres_debates2012$dialogue, method = "jaccard", nthread = 4) 
Sys.time() - tiC#Time difference of 10.18158 secs