1行のアイテムを他のすべての行と比較し、data.tableを使用してすべての行をループする - R

Question

stringdist()を使用して同様の名前を組み合わせて、lapplyを使用していますが、私は、data.tableソリューションがより速く動作するかどうかを見たいと思います。ここでは一例だと、私の未遂ソリューションは、これまでの測定値here、here、here、here、およびhereから構築されたが、私はかなりそれをオフに引っ張っていないよ：

library(stringdist) 
library(data.table) 
data("mtcars") 
mtcars$cartype <- rownames(mtcars) 
mtcars$id <- seq_len(nrow(mtcars)) 

私は現在を循環するlapply()を使用しています文字列をcartype列に追加し、指定された値（.08）より近い名前の行を集めてください。

output <- lapply(1:length(mtcars$cartype), function(x) mtcars[which(stringdist(mtcars$cartype[x], mtcars$cartype, method ="jw", p=0.08)<.08), ]) 

> output[1:3] 
[[1]] 
       mpg cyl disp hp drat wt qsec vs am gear carb  cartype id 
Mazda RX4  21 6 160 110 3.9 2.620 16.46 0 1 4 4  Mazda RX4 1 
Mazda RX4 Wag 21 6 160 110 3.9 2.875 17.02 0 1 4 4 Mazda RX4 Wag 2 

[[2]] 
       mpg cyl disp hp drat wt qsec vs am gear carb  cartype id 
Mazda RX4  21 6 160 110 3.9 2.620 16.46 0 1 4 4  Mazda RX4 1 
Mazda RX4 Wag 21 6 160 110 3.9 2.875 17.02 0 1 4 4 Mazda RX4 Wag 2 

[[3]] 
      mpg cyl disp hp drat wt qsec vs am gear carb cartype id 
Datsun 710 22.8 4 108 93 3.85 2.32 18.61 1 1 4 1 Datsun 710 3 

データテーブル試み：

mtcarsdt <- as.data.table(mtcars)  
myfun <- function(x) mtcars[which(stringdist(mtcars$cartype[x], mtcars$cartype, method ="jw", p=0.08)<.08), ] 

中間工程：このコードは、私が手動myfun()差し込む行の値に基づいて、類似した名前を引き出し、それは、すべての行について、その値を繰り返します。

res <- mtcarsdt[,.(vlist = list(myfun(1))),by=id] 
res$vlist[[1]] #correctly combines the 2 mazda names 
res$vlist[[6]] #but it's repeated down the line 

私は現在set()を使用してすべての行を循環しようとしています。私は近いんだけど、コードが正しく、それは最初の列、mpgから値を返すの12列（cartype）からテキストをマッチングするように見えるが：

今

for (i in 1:32) set(mtcarsdt,i ,12L, myfun(i)) 
> mtcarsdt 
    mpg cyl disp hp drat wt qsec vs am gear carb     cartype id 
1: 21.0 6 160.0 110 3.90 2.620 16.46 0 1 4 4     c(21, 21) 1 
2: 21.0 6 160.0 110 3.90 2.875 17.02 0 1 4 4     c(21, 21) 2 
3: 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1      22.8 3 

、これは、かなりハックですが、私もし私がcartypeカラムのコピーを作成し、それを最初のカラムに置くとかなりうまくいくが、これを行うにはよりクリーンな方法が必要であることが分かった。また、上記のlapply()出力のようなリスト形式で出力を保存することは、他の後処理ステップがそのフォーマットに設定されているので便利です。

mtcars$cartypeorig <- mtcars$cartype 
mtcars <- mtcars[,c(14,1:13)] 
mtcarsdt <- as.data.table(mtcars) 
for (i in 1:32) set(mtcarsdt,i ,13L, myfun(i)) 

> mtcarsdt[1:14,cartype] 
[1] "c(\"Mazda RX4\", \"Mazda RX4 Wag\")"       
[2] "c(\"Mazda RX4\", \"Mazda RX4 Wag\")"       
[3] "Datsun 710"             
[4] "Hornet 4 Drive"            
[5] "Hornet Sportabout"           
[6] "Valiant"              
[7] "Duster 360"             
[8] "c(\"Merc 240D\", \"Merc 230\", \"Merc 280\")"    
[9] "c(\"Merc 240D\", \"Merc 230\", \"Merc 280\", \"Merc 280C\")" 
[10] "c(\"Merc 240D\", \"Merc 230\", \"Merc 280\", \"Merc 280C\")" 
[11] "c(\"Merc 230\", \"Merc 280\", \"Merc 280C\")"    
[12] "c(\"Merc 450SE\", \"Merc 450SL\", \"Merc 450SLC\")"   
[13] "c(\"Merc 450SE\", \"Merc 450SL\", \"Merc 450SLC\")"   
[14] "c(\"Merc 450SE\", \"Merc 450SL\", \"Merc 450SLC\")"   

Answer 1

stringdistの行列バージョンを使用してみましたか？

res = stringdistmatrix(mtcars$cartype, mtcars$cartype, method = 'jw', p = 0.08) 

out = as.data.table(which(res < 0.08, arr.ind = T))[, .(list(mtcars[row,])), by = col]$V1 

identical(out, output) 
#[1] TRUE 

さて、あなたはおそらくちょうど500K X 500K行列については、上記を実行することはできませんが、あなたは小さな断片（データ/メモリサイズに適したサイズを選ぶ）に分割することができます

size = 4 # dividing into pieces of size 4x4 
     # I picked a divisible number, a little more work will be needed 
     # if you have a residue (nrow(mtcars) = 32) 
setDT(mtcars) 

grid = CJ(seq_len(nrow(mtcars)/4), seq_len(nrow(mtcars)/4)) 

indices = grid[, { 
      res = stringdistmatrix(mtcars[seq((V1-1)*size+1, (V1-1)*size + size), cartype], 
            mtcars[seq((V2-1)*size+1, (V2-1)*size + size), cartype], 
            method = 'jw', p = 0.08) 
      out = as.data.table(which(res < 0.08, arr.ind = T)) 
      if (nrow(out) > 0) 
       out[, .(row = (V1-1)*size+row, col = (V2-1)*size +col)] 
      }, by = .(V1, V2)] 

identical(indices[, .(list(mtcars[row])), by = col]$V1, lapply(output, setDT)) 
#[1] TRUE