使用循环创建网络组效率不高

Using loop to create network group is not efficient

我有一个包含 100 列的数据框,但此操作只需要两列。我只保留这样的两列:

org <- data.frame(
  ID = c( "ID1", "ID2", "ID3", "ID4", "ID5", "ID1", "ID2",
           "ID1", "ID2", "ID1", "ID2", "ID1", "ID2", "ID3",
           "ID1", "ID5", "ID1", "ID2", "ID1", "ID2", "ID3"),
  
  Key = c(1, 2, 3, 5, 7, 1, 2, 1, 8, 3, 9, 4,
           11, 15, 4, 17, 11, 15, 17, 4, 18)
)

请注意,“ID1”已分配给键 1、3、4、11 和 17。因此这些键在组 1 中
这里“3”也是 ID3 的关键。
ID3 有密钥“15”和“18”。因此“15”和“18”也将与 1、3、4、11、17、15、18 在同一组中。“ID”与键的关联(反之亦然:键与 ID 的关联)不是唯一的.
我想找到所有组及其密钥。
我在 上找到了一个解决方案:

t <- table(org$ID_id,org$key)

new_group <- list()

for (i in rownames(t)) {
  row_values <- names(t[i,][t[i,]>0])
  
  if(length(new_group)==0){
    new_group[[i]] <- row_values # add first key values to group 1
  } else{
    create_new_group <- TRUE
    for (list_item in seq_len(length(new_group))) {
      if(max(row_values %in% new_group[[list_item]]) == 1){# If key values (some or all) exist in current group
        new_group[[list_item]] <- unique(c(new_group[[list_item]],  row_values))
        create_new_group <- FALSE
      }
    }
    if(create_new_group){
      new_group[[length(new_group)+1]] <- row_values
    }
  }
  
}

效果很好。但是,我的数据框有 800 万次观察,效率不高。如果能帮助我提高这段代码的效率,我将不胜感激。

library(igraph)
 
g = simplify(graph.data.frame(org, directed = FALSE))
grp = decompose(g)
lapply(grp, function(x){
    m = get.edgelist(x)
    list(id = unique(m[,1]),
         val = unique(m[,2]))
})
#[[1]]
#[[1]]$id
#[1] "ID1" "ID2" "ID3" "ID5"

#[[1]]$val
#[1] "1"  "3"  "4"  "11" "17" "2"  "8"  "9"  "15" "18" "7" 


#[[2]]
#[[2]]$id
#[1] "ID4"

#[[2]]$val
#[1] "5"

您可以试试下面的代码

g <- simplify(graph_from_data_frame(org))
lapply(
  V(g)[names(V(g)) %in% org$ID],
  function(k) neighbors(g, k)
)

这给出了

$ID1
+ 5/17 vertices, named, from 3a33432:
[1] 1  3  4  11 17

$ID2
+ 6/17 vertices, named, from 3a33432:
[1] 2  8  9  4  11 15

$ID3
+ 3/17 vertices, named, from 3a33432:
[1] 3  15 18

$ID4
+ 1/17 vertex, named, from 3a33432:
[1] 5

$ID5
+ 2/17 vertices, named, from 3a33432:
[1] 7  17