Сравните элемент в одной строке со всеми остальными строками и проведите цикл по всем строкам с помощью data.table - R

Question

Я объединять похожие имена с помощью stringdist() и работать с lapply, но это занимает 11 часов, чтобы пробежать по 500k строк и Я хотел бы увидеть, будет ли решение 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 и объединить те строки, имена которых 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 

Теперь это довольно Hacky, но я что если я создаю копию столбца 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