在 R 中查找数字对之间的层次关系

Question

我想找到一种确定数字对表的整个层次结构类型关系的有效方法，然后在向量或字符串中表达该关系，以便我可以确定有关每对层次结构的其他有用信息，例如最高相关的整数、最低相关整数和相关整数总数。

例如，我有一个整数对表：

  X    Y       
 ---   ---
  5    10
  5    11
  11   12
  11   13
  13   3
  20   18
  17   18
  50   18
  20   21

如果记录被与另一记录任何在一对值由另一对任何其他值共享。决赛桌看起来像这样：

  X    Y    Related ID's
  ---  ---  ---------------   
  5    10    3,5,10,11,12,13 
  5    11    3,5,10,11,12,13 
  11   12    3,5,10,11,12,13 
  11   13    3,5,10,11,12,13 
  13   3     3,5,10,11,12,13 
  20   18    17,18,20,21,50
  17   18    17,18,20,21,50
  50   18    17,18,20,21,50
  20   21    17,18,20,21,50

我现在所拥有的无疑是一团糟。它使用带有匹配函数的模糊连接，该函数将 x,y 作为向量并在它们之间进行匹配。该匹配然后创建一个包含所有四个匹配数字的更大向量，该向量返回到模糊连接中再次进行匹配。这个循环直到没有更多的匹配。它很快变得很糟糕，在大约 4k 记录时它不再响应。整个初始对表将保持 < 100k 条记录

Answer 1

在基础 R 中，您可以执行以下操作：

relation <- function(dat){
  .relation <- function(x){
    k = unique(sort(c(dat[dat[, 1] %in% x, 2], x, dat[dat[, 2] %in% x, 1])))
    if(setequal(x,k)) toString(k) else .relation(k)}
  sapply(dat[,1],.relation)
}

df$related <- relation(df)

df
   X  Y              related
1  5 10 3, 5, 10, 11, 12, 13
2  5 11 3, 5, 10, 11, 12, 13
3 11 12 3, 5, 10, 11, 12, 13
4 11 13 3, 5, 10, 11, 12, 13
5 13  3 3, 5, 10, 11, 12, 13
6 20 18   17, 18, 20, 21, 50
7 17 18   17, 18, 20, 21, 50
8 50 18   17, 18, 20, 21, 50
9 20 21   17, 18, 20, 21, 50

如果您已经igraph安装，您可以执行以下操作：

library(igraph)
a <- components(graph_from_data_frame(df, FALSE))$membership
b <- tapply(names(a),a,toString)
df$related <- b[a[as.character(df$X)]]

编辑：

如果我们比较函数的速度，请注意在我上面的函数中，最后一个语句 iesapply(dat[,1], ...)计算每个元素的值，即使之前计算过它。例如sapply(c(5,5,5,5)...)将计算组 4 次而不是一次。现在使用：

relation <- function(dat){
  .relation <- function(x){
    k <- unique(c(dat[dat[, 1] %in% x, 2], x, dat[dat[, 2] %in% x, 1]))
    if(setequal(x,k)) sort(k) else .relation(k)}
  d <- unique(dat[,1])
  m <- setNames(character(length(d)),d)
  while(length(d) > 0){
    s <- .relation(d[1])
    m[as.character(s)] <- toString(s)
    d <- d[!d%in%s]
  }
  dat$groups <- m[as.character(dat[,1])]
  dat
}

现在做基准测试：

 df1 <- do.call(rbind,rep(list(df),100))
 microbenchmark::microbenchmark(relation(df1), group_pairs(df1),unit = "relative")


 microbenchmark::microbenchmark(relation(df1), group_pairs(df1))
Unit: milliseconds
             expr      min        lq       mean    median       uq      max neval
    relation(df1)   1.0909   1.17175   1.499096   1.27145   1.6580   3.2062   100
 group_pairs(df1) 153.3965 173.54265 199.559206 190.62030 213.7964 424.8309   100