R:将图的各个部分合并在一起

sta*_*oob 2 tree r graph

我正在使用 R 编程语言。

我有下面的“树”,它描述了抛硬币游戏的结果(从 5 点开始,每轮有 0.5 个 +1 的概率和 0.5 个 -1 的概率):

outcomes <- c(-1, 1)  

combinations <- expand.grid(rep(list(outcomes), 10))
colnames(combinations) <- paste("Turn", 1:10)

library(data.tree)

generate_tree <- function(node, depth, total) {
    if (depth == 0) {
        node$Set(total = total)
        return(node)
    } else {
        for (outcome in outcomes) {
            child <- node$AddChild(name = as.character(total + outcome), total = total + outcome)
            generate_tree(child, depth - 1, total + outcome)
        }
        return(node)
    }
}

root <- Node$new("Start", total = 5)

root <- generate_tree(root, 4, 5)

print(root, "total")

plot(root, "total")
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

我的问题:是否可以重新格式化(即合并)该图,以便在每个回合中,具有相同“值”的所有“节点”都折叠为单个节点?这意味着在每个回合中,给定的“值”只能出现一次。

阅读以下参考文献(如何通过节点或叶子中的标签折叠系统发育树中的分支?绘制树 - 折叠节点向量)尝试使用以下代码执行此操作:

collapse_nodes <- function(node) {
    if (node$isRoot) {
        return(node)
    } else {
        parent <- node$parent
        siblings <- parent$children
        same_value_siblings <- siblings[sapply(siblings, function(x) x$total == node$total)]
        if (length(same_value_siblings) > 1) {
            node$parent <- NULL
            parent$RemoveChild(node$name)
        }
        return(node)
    }
}
root <- Traverse(root, collapse_nodes, mode = "post-order")

print(root, "total")
plot(root, "total")
Run Code Online (Sandbox Code Playgroud)

不幸的是,我收到以下错误:

Error in Traverse(root, collapse_nodes, mode = "post-order") : 
  unused argument (mode = "post-order")
Run Code Online (Sandbox Code Playgroud)

有人可以建议如何解决这个问题吗?谢谢!

注意: 最后,相同颜色的所有节点将合并为一个节点 - 这就是我想要实现的目标:

在此输入图像描述

All*_*ron 5

您尝试创建的结构不是在一棵树中,任何两个节点1之间都只有一条路径。尽管您从一棵有根树开始,但如果合并节点以使某些节点有两个父节点,则您不再拥有一棵树,而是一个有向无环图(DAG)。该结构不能用 表示data.tree

Thomas 已经出色地演示了如何使用igraph. 但是,如果您主要为了视觉输出而生成此图表,则可以使用tidygraph/ggraph生态系统来获得有吸引力且高度可定制的绘图。

以下函数将输出一个具有正确三角形网格结构的图表,给定起始值、每次获胜/失败的分数以及所需的深度。

make_tri_mesh <- function(value, scores, depth) {
  height <- rep(seq(depth + 1), seq(depth + 1))
  score <- c(0, lapply(seq(depth), function(x) {
    sort(unique(rowSums(do.call("expand.grid", rep(list(scores), x)))))
  }) |> unlist()) + value
  nodes <- data.frame(node = seq_along(height), height, score)
  from <- rep(unique(nodes$node[nodes$height <= depth]), each = 2)
  to <- unlist(lapply(split(nodes$node, nodes$height)[-1], \(x) {
    if(length(x) == 2) x else head(tail(rep(x, each = 2), -1), -1)}))
  tidygraph::as_tbl_graph(igraph::graph.data.frame(data.frame(from, to))) |> 
    dplyr::mutate(value = nodes$score,
                  yval = max(nodes$height) - nodes$height) |>
    dplyr::group_by(yval) |>
    dplyr::mutate(xval = (seq_along(value) - dplyr::n()/2))
}
Run Code Online (Sandbox Code Playgroud)

输出是一个tidygraph对象,如果您熟悉数据结构,则很容易使用它tidyverse

g <- make_tri_mesh(value = 5, scores = c(-1, 1), depth = 4)

g
#> # A tbl_graph: 15 nodes and 20 edges
#> #
#> # A directed acyclic simple graph with 1 component
#> #
#> # A tibble: 15 x 4
#> # Groups:   yval [5]
#>   name  value  yval  xval
#> * <chr> <dbl> <int> <dbl>
#> 1 1         5     4   0.5
#> 2 2         4     3   0  
#> 3 3         6     3   1  
#> 4 4         3     2  -0.5
#> 5 5         5     2   0.5
#> 6 6         7     2   1.5
#> # i 9 more rows
#> # i Use `print(n = ...)` to see more rows
#> #
#> # A tibble: 20 x 2
#>    from    to
#>   <int> <int>
#> 1     1     2
#> 2     1     3
#> 3     2     4
#> # i 17 more rows
#> # i Use `print(n = ...)` to see more rows
Run Code Online (Sandbox Code Playgroud)

ggraph允许使用所有熟悉的 ggplot 选项以及它自己的一些选项来定制绘图:

library(ggraph)
library(ggplot2)

ggraph(g, layout = "manual", x = xval, y = yval) + 
  geom_edge_fan(end_cap = circle(0.9), 
                arrow = arrow(type = "closed", length = unit(3, "mm"))) + 
  geom_node_point(shape = 21, size = 20, aes(fill = value)) + 
  geom_node_text(aes(label = value), size = 6, fontface = 2) +
  theme_void() +
  scale_fill_gradient2(low = "lightblue", mid = "white", high = "pink", 
                       midpoint = 5, guide = "none")
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

如果我们想将图的深度加倍,我们可以简单地这样做:

library(ggraph)
library(ggplot2)

ggraph(g, layout = "manual", x = xval, y = yval) + 
  geom_edge_fan(end_cap = circle(0.9), 
                arrow = arrow(type = "closed", length = unit(3, "mm"))) + 
  geom_node_point(shape = 21, size = 20, aes(fill = value)) + 
  geom_node_text(aes(label = value), size = 6, fontface = 2) +
  theme_void() +
  scale_fill_gradient2(low = "lightblue", mid = "white", high = "pink", 
                       midpoint = 5, guide = "none")
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述