r - 根据多列中的直接和间接相似性对变量进行分组的快速方法

Question

我有一个相对较大的数据集(1,750,000 行，5 列)，其中包含具有唯一 ID 值(第一列)的记录，由四个条件(其他 4 列)描述。一个小例子是:

# example
library(data.table)
dt <- data.table(id=c("a1","b3","c7","d5","e3","f4","g2","h1","i9","j6"), 
                 s1=c("a","b","c","l","l","v","v","v",NA,NA), 
                 s2=c("d","d","e","k","k","o","o","o",NA,NA),
                 s3=c("f","g","f","n","n","s","r","u","w","z"),
                 s4=c("h","i","j","m","m","t","t","t",NA,NA))

看起来像这样:

   id   s1   s2 s3   s4
 1: a1    a    d  f    h
 2: b3    b    d  g    i
 3: c7    c    e  f    j
 4: d5    l    k  n    m
 5: e3    l    k  n    m
 6: f4    v    o  s    t
 7: g2    v    o  r    t
 8: h1    v    o  u    t
 9: i9 <NA> <NA>  w <NA>
10: j6 <NA> <NA>  z <NA>

我的最终目标是在 上找到所有具有相同字符的记录。任何 描述列(不考虑 NA)，并将它们分组在一个新的 ID 下，以便我可以轻松识别重复的记录。这些 ID 是通过连接每一行的 ID 来构造的。

事情变得更糟了，因为我可以直接找到那些描述重复的记录 和 间接地。因此，我目前分两步进行此操作。

STEP 1 - 基于直接重复构造重复 ID

# grouping ids with duplicated info in any of the columns
#sorry, I could not find search for duplicates using multiple columns simultaneously...
dt[!is.na(dt$s1),ids1:= paste(id,collapse="|"), by = list(s1)]
dt[!is.na(dt$s1),ids2:= paste(id,collapse="|"), by = list(s2)]
dt[!is.na(dt$s1),ids3:= paste(id,collapse="|"), by = list(s3)]
dt[!is.na(dt$s1),ids4:= paste(id,collapse="|"), by = list(s4)]

# getting a unique duplicated ID for each row
dt$new.id <- apply(dt[,.(ids1,ids2,ids3,ids4)], 1, paste, collapse="|")
dt$new.id <- apply(dt[,"new.id",drop=FALSE], 1, function(x) paste(unique(strsplit(x,"\\|")[[1]]),collapse="|"))

此操作的结果如下，唯一的重复 ID 定义为“new.id”:

   id   s1   s2 s3   s4     ids1     ids2  ids3     ids4   new.id
 1: a1    a    d  f    h       a1    a1|b3 a1|c7       a1 a1|b3|c7
 2: b3    b    d  g    i       b3    a1|b3    b3       b3    b3|a1
 3: c7    c    e  f    j       c7       c7 a1|c7       c7    c7|a1
 4: d5    l    k  n    m    d5|e3    d5|e3 d5|e3    d5|e3    d5|e3
 5: e3    l    k  n    m    d5|e3    d5|e3 d5|e3    d5|e3    d5|e3
 6: f4    v    o  s    t f4|g2|h1 f4|g2|h1    f4 f4|g2|h1 f4|g2|h1
 7: g2    v    o  r    t f4|g2|h1 f4|g2|h1    g2 f4|g2|h1 f4|g2|h1
 8: h1    v    o  u    t f4|g2|h1 f4|g2|h1    h1 f4|g2|h1 f4|g2|h1
 9: i9 <NA> <NA>  w <NA>     <NA>     <NA>  <NA>     <NA>       NA
10: j6 <NA> <NA>  z <NA>     <NA>     <NA>  <NA>     <NA>       NA

请注意，记录“b3”和“c7”通过“a1”间接复制(所有其他示例都是直接复制，应该保持不变)。这就是为什么我们需要下一步。

第 2 步 - 根据间接重复更新重复的 ID

#filtering the relevant columns for the indirect search
dt = dt[,.(id,new.id)]

#creating the patterns to be used by grepl() for the look-up for each row
dt[,patt:= .(paste(paste("^",id,"\\||",sep=""),paste("\\|",id,"\\||",sep=""),paste("\\|",id,"$",sep=""),collapse = "" ,sep="")), by = list(id)]

#Transforming the ID vector into factor and setting it as a 'key' to the data.table (speed up the processing)
dt$new.id = as.factor(dt$new.id)
setkeyv(dt, c("new.id"))

#Performing the loop using sapply
library(stringr)
for(i in 1:nrow(dt)) {
  pat = dt$patt[i] # retrieving the research pattern
  tmp = dt[new.id %like% pat] # searching the pattern using grepl()
  if(dim(tmp)[1]>1) {
    x = which.max(str_count(tmp$new.id, "\\|"))
    dt$new.id[i] = as.character(tmp$new.id[x])
  }
}

#filtering the final columns 
dt = dt[,.(id,new.id)]

决赛 table 看起来像:

   id   new.id
 1: a1 a1|b3|c7
 2: b3 a1|b3|c7
 3: c7 a1|b3|c7
 4: d5    d5|e3
 5: e3    d5|e3
 6: f4 f4|g2|h1
 7: g2 f4|g2|h1
 8: h1 f4|g2|h1
 9: i9       NA
10: j6       NA

请注意，现在前三个记录(“a1”、“b3”、“c7”)分组在更广泛的重复 ID 下，其中包含直接和间接记录。

一切正常，但我的代码非常慢。运行一半的数据集(~800,0000)需要整整 2 天的时间。我可以将循环并行化到不同的内核中，但仍然需要几个小时。而且我几乎可以肯定我可以以更好的方式使用 data.table 功能，也许在循环中使用“set”。我今天花了几个小时试图使用 data.table 实现相同的代码，但我对它的语法不熟悉，我在这里真的很难。关于如何优化此代码的任何建议？

注意:代码中最慢的部分是循环，在循环中效率最低的步骤是 data.table 中模式的 grepl()。似乎为 data.table 设置一个“键”可以加快这个过程，但在我的情况下，我没有改变执行 grepl() 所花费的时间。

Answer 1

您可以将此视为网络问题。这里我使用了 igraph 中的函数包裹。基本步骤:

melt数据为长格式。

使用 graph_from_data_frame创建一个图表，其中 'id' 和 'value' 列被视为边缘列表。

使用 components获取图形的连接组件，即哪些“id”通过它们的标准直接或间接连接。

选择 membership元素以获取“每个顶点所属的集群 ID”。

将成员(member)加入原始数据。

连接按集群成员身份分组的“id”。

library(igraph)

# melt data to long format, remove NA values
d <- melt(dt, id.vars = "id", na.rm = TRUE)

# convert to graph
g <- graph_from_data_frame(d[ , .(id, value)])

# get components and their named membership id 
mem <- components(g)$membership

# add membership id to original data
dt[.(names(mem)), on = .(id), mem := mem] 

# for groups of length one, set 'mem' to NA
dt[dt[, .I[.N == 1], by = mem]$V1, mem := NA]

如果需要，通过“mem”列连接“id”(对于非 NA“mem”)(恕我直言，这只会使进一步的数据操作更加困难；))。无论如何，我们开始:

dt[!is.na(mem), id2 := paste(id, collapse = "|"), by = mem]

#     id   s1   s2 s3   s4  mem      id2
#  1: a1    a    d  f    h    1 a1|b3|c7
#  2: b3    b    d  g    i    1 a1|b3|c7
#  3: c7    c    e  f    j    1 a1|b3|c7
#  4: d5    l    k  l    m    2    d5|e3
#  5: e3    l    k  l    m    2    d5|e3
#  6: f4    o    o  s    o    3 f4|g2|h1
#  7: g2    o    o  r    o    3 f4|g2|h1
#  8: h1    o    o  u    o    3 f4|g2|h1
#  9: i9 <NA> <NA>  w <NA>   NA     <NA>
# 10: j6 <NA> <NA>  z <NA>   NA     <NA>

这个小例子中图形的基本图，只是为了说明连接的组件:

plot(g, edge.arrow.size = 0.5, edge.arrow.width = 0.8, vertex.label.cex = 2, edge.curved = FALSE)