Somiglianza jaccard efficiente DocumentTermMatrix

Question

Desidero un modo per calcolare in modo efficiente la somiglianza Jaccard tra i documenti di uno tm::DocumentTermMatrix. Posso fare qualcosa di simile per la somiglianza del coseno tramite il pacchetto slam come mostrato in this answer. Mi sono imbattuto in another question and response su CrossValidated che era R specifico ma sull'algebra della matrice non è necessariamente il percorso più efficiente. Ho provato ad implementare questa soluzione con le più efficienti funzioni slam ma non ottengo la stessa soluzione di quando utilizzo un approccio meno efficiente di forzare il DTM a una matrice e di usare proxy::dist.

Come è possibile calcolare in modo efficiente la somiglianza Jaccard tra i documenti di una grande DocumentTermMatrix in 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 Calcolo (risultati attesi)

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 Tentativo

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 

Le uscite non corrispondono.

FYI Ecco il testo originale:

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

mi aspetto elementi 1 & 2 da 0 a distanza e l'elemento 3 per essere più vicino a Elemento 1 di elemento 1 e 4 (mi aspetto più lontana distanza in quanto nessuna parola è condivisa) come visto nella soluzione proxy::dist.

EDIT

Si noti che anche su un DTM di medie dimensioni della matrice diventa enorme. Ecco un esempio con il pacchetto vegan. Nota 4 minuti per risolvere dove la somiglianza del coseno è ~ 5 secondi.

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

misura Jaccard è una misura tra SET e matrice di ingresso dovrebbe essere binario. Il very first line dice:

## common values: 
A = tcrossprod(m) 

In caso di bag-of-parole DTM questo non è il numero di valori comuni!

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) 
} 

Benchmark:

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 2016/07/01:

Vedi versione ancora più veloce da text2vec 0.4 (~ 2.85x quando non c'è bisogno di convertire da dgCMatrix a dgTMatrix e ~ 1,75x whe n bisogno colonna principale dgCMatrix)

Answer 2

Come circa vegdist() dal pacchetto vegan? Usa C-Code ed è di ca. 10 volte più veloce di delega:

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

Utilizzando stringdistmatrix dal pacchetto stringdist e utilizzando l'opzione nthread per farlo funzionare in parallelo, lo accelera un po '. in media sei secondi più lento dei test con similarità del coseno.

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