比较项目通过对所有列等行和环 - R的

Question

我使用stringdist()合并相似的名字，并有工作用lapply，但它采取11小时通过50万行运行，我想看看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()。我很接近，但尽管出现代码从12列（cartype）的文本被正确匹配是从第一列返回值，mpg：

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列的副本并将其放置在第一列中，它几乎可以工作，但必须有一个更简洁的方法来执行此操作。此外，将输出保持为上述输出的列表形式会很好，因为我为该格式设置了其他后处理步骤。

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 500K X矩阵，但可以将其分解成小片（挑大小适合您的数据/存储容量）：

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