快速获取父元素的所有子代的方法

Question

快速获取父元素的所有子代的方法

14

以下是与父子关系相关的数据框:

  parent_id child_id
1         1        2
2         2        3
3         3        4

目标是实现以下内容，即扩展先前数据框的版本，其中所有后代（子女、孙子女等）都分配给每个父级（包括父/子本身）：

   parent_id child_id
1          1        1
2          1        2
3          1        3
4          1        4
5          2        2
6          2        3
7          2        4
8          3        3
9          3        4
10         4        4

我有一个问题：在R中，最快的实现方法是什么（或其中之一）？ 我已经尝试了各种方法 - 从for循环、SQL递归到使用igraph（如此处所述）。它们都相当慢，有些在处理更多组合时也容易崩溃。

下面是使用sqldf和igraph的示例，对比了一个稍大的数据框。

library(sqldf)
library(purrr)
library(dplyr)
library(igraph)

df <- data.frame(parent_id = 1:1000L)
df$child_id <- df$parent_id + 1L

# SQL recursion

sqlQuery <- 'with recursive
             dfDescendants (parent_id, child_id)
             as
             (select parent_id, child_id from df
             union all
             select d.parent_id, s.child_id from dfDescendants d
             join df s
             on d.child_id = s.parent_id)
             select distinct parent_id, parent_id as child_id from dfDescendants
             union
             select distinct child_id as parent_id, child_id from dfDescendants
             union
             select * from dfDescendants;'

sqldf(sqlQuery)

# igraph with purrr

df_g = graph_from_data_frame(df, directed = TRUE)

map(V(df_g), ~ names(subcomponent(df_g, .x, mode = "out"))) %>% 
  map_df(~ data.frame(child_id = .x), .id = "parent_id")

基准测试（不包括在 sqldf 中创建查询和在 igraph 中转换为图形）：

set.seed(23423)

microbenchmark::microbenchmark(
  sqldf = sqldf(sqlQuery),
  tidyigraph = map(V(df_g), ~ names(subcomponent(df_g, .x, mode = "out"))) %>% 
    map_df(~ data.frame(child_id = .x), .id = "parent_id"),
  times = 5
)

#    Unit: seconds
#           expr      min       lq     mean   median       uq      max neval
#          sqldf 7.815179 8.002836 8.113392 8.084038 8.315207 8.349701     5
#     tidyigraph 5.784239 5.806539 5.883241 5.889171 5.964906 5.971350     5

- arg0naut91

1

我不是R语言的用户，也没有时间去了解你在这里做什么，但是这里有一些提示：（1）使用igraph构建图形（例如从数据框中）可能很耗时。避免转换。（2）subcomponent()一旦构建了图形，应该会很快，但目前任何图形遍历都有一个图形设置成本，因此对于每个顶点重复调用subcomponent不是理想的选择。（3）您可以使用ego函数一次完成，将“order”设置为顶点数。但我刚刚查看了C代码，它实际上并没有避免设置成本。 - Szabolcs

1

as_edgelist(connect(df_g, order=length(V(df_g)), mode="in")) 看起来更快（但是在这些设置下不会得到自环）。 - user20650

1

可以使用 order=vcount(df_g)。仔细查看了 C 源代码后，我非常惊讶它的速度能够快那么多。不过我已经为加速它而打开了一个问题：https://github.com/igraph/igraph/issues/1954 - Szabolcs

相比于“subcomponent”使用“vcount”，大约只需要220毫秒，而“subcomponent”需要4500毫秒。看起来非常快，但是我会进行更多的测试。我也会一直关注这个问题，谢谢！总体看来，这似乎是一个很好的解决方案-请随意发布一个基于igraph的通用解释，如果没有其他更快的解决方案，我会接受它。 - arg0naut91

@user20650，谢谢 - 的确，联合会解决了这个问题，就像SQL一样。不过我认为还有另一个igraph配置选项可以解决它（实际上一开始我只是认为孤立的子循环没有被处理）。 - arg0naut91

显示剩余5条评论

2个回答

7

igraph当然是回答图形问题的好方法（还可以参考Bioconductor的graph和RBGL包），但我认为这个问题在R中有一个迭代解决方案。

似乎一个合理的方法是执行深度优先图遍历（我原本期望有一个更高级的解决方案）。在R中实现这个方法实际上非常容易且高效。假设向量pid和cid描述了图中父节点和子节点之间的链接关系（如问题中的数据框所示）。将每个节点表示为正整数。

all_nodes <- unique(c(parent_id, child_id)  # all nodes
uid <- match(all_nodes, all_nodes)
pid <- match(parent_id, all_nodes)
cid <- match(child_id, all_nodes)

并从每个节点到其所有子节点形成边缘列表。

edge_list <- unname(split(cid, factor(pid, levels = uid)))
edge_lengths <- lengths(edge_list)

当前子节点的子节点是edge_list[cid]，每个原始父节点关联的二级子节点数量为rep(pid, edge_lengths[cid])。因此，从任何节点到任何其他可达节点的路径都通过简单迭代遍历。

while (length(pid)) {
    pid <- rep(pid, edge_lengths[cid])
    cid <- unlist(edge_list[cid])
}

@jblood94指出，遍历必须跟踪已访问的边。我们可以通过创建一个已访问边的逻辑向量来有效地实现这一点（在时间上而不是空间上！）。我们使用“工厂”模式，其中创建一个保留状态的函数（已访问节点的逻辑向量）。该向量由边的唯一id（key）索引，pid * n + cid。我们感兴趣的是未重复且未被访问过的键。

visitor <- function(uid, n_max = 3000) {
    n <- length(uid)
    if (n <= n_max) {
        ## over-allocate, to support `key = pid * n + cid`
        visited <- logical((n + 1L) * n) # FALSE on construction
    } else {
        stop("length(uid) greater than n_max = ", n_max)
    }
    function(pid, cid) {
        key <- pid * n + cid
        to_visit <- !(duplicated(key) | visited[key])
        visited[key[to_visit]] <<- TRUE  # update nodes that we will now visit
        to_visit
    }
}

因此

> visit = visitor(1:10)
> visit(1:3, 2:4)
[1] TRUE TRUE TRUE
> visit(2:4, 3:5)
[1] FALSE FALSE  TRUE

这里是整个解决方案的更完整实现，具有额外的记录功能。

visitor <- function(uid, n_max = 3000) {
    n <- length(uid)
    if (n <= n_max) {
        ## over-allocate, to support `key = pid * n + cid`
        visited <- logical((n + 1L) * n) # FALSE on construction
    } else {
        stop("length(uid) greater than n_max = ", n_max)
    }
    function(pid, cid) {
        key <- pid * n + cid
        to_visit <- !(duplicated(key) | visited[key])
        visited[key[to_visit]] <<- TRUE
        to_visit
    }
}

ancestor_descendant <- function(df) {
    ## encode parent and child to unique integer values
    ids <- unique(c(df$parent_id, df$child_id))
    uid <- match(ids, ids)
    pid <- match(df$parent_id, ids)
    cid <- match(df$child_id, ids)
    n <- length(uid)

    ## edge list of parent-offspring relationships, based on unique
    ## integer values; list is ordered by id, all ids are present, ids
    ## without children have zero-length elements. Use `unname()` so
    ## that edge_list is always indexed by integer
    edge_list <- unname(split(cid, factor(pid, levels = uid), drop = FALSE))
    edge_lengths <- lengths(edge_list)

    visit <- visitor(uid)
    keep <- visit(uid, uid) # all TRUE
    aid = did = list(uid) # results -- all uid's are there own ancestor / descendant
    i = 1L
   
    while (length(pid)) {
        ## only add new edges
        keep <- visit(pid, cid)
        ## record current generation ancestors and descendants
        pid <- pid[keep]
        cid <- cid[keep]
        i <- i + 1L
        aid[[i]] <- pid
        did[[i]] <- cid

        ## calculate next generation pid and cid.
        pid <- rep(pid, edge_lengths[cid])
        cid <- unlist(edge_list[cid])
    }
    ## decode results to original ids and clean up return value
    df <- data.frame(
        ancestor_id = ids[unlist(aid)],
        descendant_id = ids[unlist(did)]
    )
    df <- df[order(df$ancestor_id, df$descendant_id),]
    rownames(df) <- NULL
    df
}

这看起来表面上是正确的和高效的。

## Original example
df <- data.frame(parent_id = 1:1000L)
df$child_id <- df$parent_id + 1L
df = df[sample(nrow(df)),]
system.time(result <- ancestor_descendant(df))
##  user  system elapsed 
## 0.243   0.001   0.245 
dim(result)
## [1] 501501      2

## updated example from comments
df <- data.frame(parent_id = 1:1000L)
df$child_id <- df$parent_id + 1L
df <- rbind(df, data.frame(parent_id = 1000L, child_id = 1002L))
system.time(result <- ancestor_descendant(df))
##  user  system elapsed 
## 0.195   0.001   0.195 
dim(result)
## [1] 502502      2

## problematic case from @jblood94
df <- data.frame(
    parent_id=c(1, 1, 2),
    child_id = c(2, 3, 3)
)
ancestor_descendant(df)
##   ancestor_id descendant_id
## 1           1             1
## 2           1             2
## 3           1             3
## 4           2             2
## 5           2             3
## 6           3             3

## previously failed without filtering re-visited nodes
df <- data.frame(
    parent_id = rep(1:100, each = 2),
    child_id = c(2, rep(3:101, each = 2), 102)
)
system.time(result <- ancestor_descendant(df))
##  user  system elapsed 
## 0.005   0.000   0.006 
dim(result)
## [1] 5252    2

- Martin Morgan

@arg0naut91，我今天早些时候进行了更新，并刚刚添加了一个最终段落，展示了您更新的数据框的结果。这是您期望的吗，还是...？ - Martin Morgan

很遗憾 - 1002 应该是 999 的后代，也是所有先前节点的后代。 - arg0naut91

1

@arg0naut91，实际上回到了更干净的实现和更快的性能。 - Martin Morgan

1

@jblood94，我收回了至少一部分的话。看起来一个合理的解决方案是从所有节点开始进行深度优先遍历图形，前提是不重复访问边缘。边缘可以被唯一地索引，并且它们是否被访问或在逻辑向量中高效地跟踪（在时间上而不是空间上）。对于我来说，我的当前R解决方案比自我解决方案稍快。 - Martin Morgan

1

@MartinMorgan，你的方法似乎很可靠、快速，并且可能适用于实际使用情况的高百分比。在与我提出问题中的df大小/复杂度类似的示例中，它似乎比ego快10倍。然而，考虑到ego解决方案基于一个众所周知的开源库（因此更容易受到审查，即更有可能是稳健的），我将接受基于igraph的答案。 - arg0naut91

显示剩余5条评论

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- ThomasIsCoding · Accepted Answer

我们可以像下面这样使用ego。

library(igraph)
df <- data.frame(parent_id = 1:3, child_id = 2:4)
g <- graph_from_data_frame(df)

setNames(
  rev(
    stack(
      Map(
        names,
        setNames(
          ego(g,
            order = vcount(g),
            mode = "out"
          ),
          names(V(g))
        )
      )
    )
  ),
  names(df)
)

该技术提供

   parent_id child_id
1          1        1
2          1        2
3          1        3
4          1        4
5          2        2
6          2        3
7          2        4
8          3        3
9          3        4
10         4        4

性能基准测试

set.seed(23423)

microbenchmark::microbenchmark(
  sqldf = sqldf(sqlQuery),
  tidyigraph = map(V(df_g), ~ names(subcomponent(df_g, .x, mode = "out"))) %>%
    map_df(~ data.frame(child_id = .x), .id = "parent_id"),
  ego = setNames(
    rev(
      stack(
        Map(
          names,
          setNames(
            ego(df_g,
              order = vcount(df_g),
              mode = "out"
            ),
            names(V(df_g))
          )
        )
      )
    ),
    names(df)
  ),
  times = 5
)

展示

Unit: milliseconds
       expr       min       lq      mean    median         uq        max neval
      sqldf 7156.2753 9072.155 9402.6904 9518.2796 10206.3683 11060.3738     5
 tidyigraph 2483.9943 2623.558 3136.7490 2689.8388  2879.5688  5006.7853     5
        ego  182.5941  219.151  307.2481  253.2171   325.8721   555.4064     5

使用管道增强代码可读性：

g |>
  ego(order = vcount(g), mode = "out") |>
  setNames(names(V(g))) |>
  Map(f = names) |>
  stack() |>
  rev() |>
  setNames(names(df))