一般的な単語を数え、結果を行列に格納する方法は？

Question

私は比較したいテキスト文章の多くを持っていますが、ここで赤ずきんちゃんは、例えばだ

text1 <- "Once upon a time" 
text2 <- "there was a dear little girl" 
text3 <- "who was loved by everyone who looked at her" 

私はちょうどこの

text1_split <- unlist(strsplit(text1, " ")) 
text2_split <- unlist(strsplit(text2, " ")) 
text3_split <- unlist(strsplit(text3, " ")) 

length(intersect(text1_split, text2_split)) 
length(intersect(text2_split, text3_split)) 

texts <- c("text1","text2","text3") 
data <- data.frame(texts) 
data[, texts] <- NA 
rownames(data) <- texts 
data <- data[,-1] 

data[1,1] <- length(intersect(text1_split, text1_split)) 
data[1,2] <- length(intersect(text1_split, text2_split)) 
data[1,3] <- length(intersect(text1_split, text3_split)) 

のような一般的な単語をカウントマトリックスを作成したいですマトリックスの結果は

 text1 text2 text3 
text1  4  1  0 
text2 NA NA NA 
text3 NA NA NA 

効率的な方法でマトリックスを完成させる方法はありますか？私は100以上の文章を比較しています。 Count common words in two strings in R

Answer 1

これを試してみてください：

CommonWordsMatrixOld <- function(vList) { 
    v <- lapply(vList, tolower) 
    do.call(rbind, lapply(v, function(x) { 
      xSplit <- strsplit(x, " ")[[1]] 
      do.call(c, lapply(v, function(y) length(intersect(xSplit, strsplit(y, " ")[[1]])))) 
     })) 
} 

myText <- list(text1, text2, text3) 

がそれを呼び出す我々が持っている：

CommonWordsMatrixOld(myText) 
    [,1] [,2] [,3] 
[1,] 4 1 0 
[2,] 1 6 1 
[3,] 0 1 8 

そして、それはデータのための高速ちゃんとOPがあるサイズですこれは似ていますが、同じではない何かを持つの投稿です要求する。データはhereを得た。

test1[1:10,1:10] 
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] 
[1,] 9 3 5 1 3 4 4 2 2  1 
[2,] 3 5 3 1 1 3 3 0 0  1 
[3,] 5 3 12 0 3 8 4 3 2  1 
[4,] 1 1 0 1 0 0 1 0 0  0 
[5,] 3 1 3 0 4 2 1 1 1  0 
[6,] 4 3 8 0 2 13 7 4 1  1 
[7,] 4 3 4 1 1 7 10 4 1  1 
[8,] 2 0 3 0 1 4 4 7 3  0 
[9,] 2 0 2 0 1 1 1 3 4  0 
[10,] 1 1 1 0 0 1 1 0 0  2 

更新

ここでは、多くの不要な動作をカットし、lower.triしばらくを活用してはるかに高速なアルゴリズムである：ここでは

testWords <- read.csv("4000-most-common-english-words-csv.csv", stringsAsFactors = FALSE) 

set.seed(1111) 
myTestText <- lapply(1:100, function(x) { 
     paste(testWords[sample(1000:1020, sample(30, 1), replace = TRUE),],collapse = " ") 
    }) 

myTestText[[15]] 
[1] "access restaurant video opinion video eventually fresh eventually 
reform credit publish judge Senate publish fresh restaurant publish 
version Senate critical release recall relation version" 

system.time(test1 <- CommonWordsMatrixOld(myTestText)) 
user system elapsed 
0.625 0.009 0.646 

が出力されています非常に一般的なままです。

CommonWordsMatrixNew <- function(vList) { 
    v <- lapply(vList, function(x) tolower(strsplit(x, " ")[[1]])) 
    s <- length(v) 
    m <- do.call(rbind, lapply(1L:s, function(x) { 
     c(rep(0L,(x-1L)), do.call(c, lapply(x:s, function(y) length(intersect(v[[x]], v[[y]]))))) 
    })) 
    m[lower.tri(m)] <- t(m)[lower.tri(m)] 
    m 
} 

はあなたに性能向上のアイデアを与えるために、ここでいくつかのベンチマークです。（それは本当の比較ではありませんので、OPのソリューションは、ベクトルを分割されていないことに留意すべきです）。 New algoはOPのソリューションのほぼ2倍の速さです。

microbenchmark(New=CommonWordsMatrixNew(myTestText), 
       Old=CommonWordsMatrixOld(myTestText), 
       Pach=CommonWordsMatrixPach(PreSplit1), times = 10) 
Unit: milliseconds 
expr  min  lq  mean median  uq  max neval 
New 78.64434 79.07127 86.10754 79.72828 81.39679 137.0695 10 
Old 321.49031 323.89835 326.61801 325.75221 328.50877 335.3306 10 
Pach 138.34742 143.00504 145.35147 145.17376 148.34699 151.5535 10 

identical(CommonWordsMatrixNew(myTestText), CommonWordsMatrixOld(myTestText), CommonWordsMatrixPach(PreSplit1)) 
[1] TRUE 

新しいアルゴリズムは、（例えば、上記の例では、strplitは、元アルゴで10000回呼び出され、そして更新されたバージョンでのみ100回）n^2 - n倍strsplitにコールの数を減少させます。さらに、得られた行列は対称であるので、各文間の相互作用を2回以上計算する必要はないので、lapply関数内のx = 1:sおよびy = x:s関数。これらのループの計算の数は、から5050までの例では、n^2からnth triangle number= (n*(n+1)/2)に減少します。その後、私たちはRのインデックス作成の力に頼っています。これは一般的に手作業よりもはるかに高速です。

Answer 2

私は私が何かを掲載している下の

CommonWordsMatrix <- function(vList) { 
    v <- lapply(vList, tolower) 
    do.call(rbind, lapply(v, function(x) { 
    do.call(c, lapply(v, function(y) length(intersect(x, y)))) 
    })) 
} 

は、