将一行中的项目与所有其他行进行比较，并使用 data.table - R 遍历所有行

Posted 2023-04-18

【中文标题】将一行中的项目与所有其他行进行比较，并使用 data.table - R 遍历所有行

【英文标题】：Compare item in one row against all other rows and loop through all rows using data.table - R

【发布时间】：2016-04-29 20:23:34

【问题描述】：

我正在使用 stringdist() 组合相似的名称，并使用 lapply 使其工作，但运行 500k 行需要 11 个小时，我想看看 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\")"         

【参考方案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

【讨论】：

我想避免使用距离矩阵方法（内存限制）和拆分数据集。拆分它可以在每个矩阵中工作，但随后在多个矩阵中识别匹配会带来额外的挑战。例如，假设 2 个名称在一个矩阵中匹配，2 个非常相似的名称在另一个矩阵中匹配。在最终数据集中将这 4 个相似的名称放在一起将是一项挑战。此外，有时一个名称会匹配另外 3 个名称，但其他名称中的一个不会与原始名称匹配，这是我可以用原始方法处理的问题，但使用多个矩阵会更难。