我正在使用 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)
有人可以建议如何解决这个问题吗?谢谢!
注意: 最后,相同颜色的所有节点将合并为一个节点 - 这就是我想要实现的目标:
您尝试创建的结构不是树。在一棵树中,任何两个节点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)