简介
最近看到了一个有趣的 R 包：ggparty[1]，可以绘制出以下图形：
该包旨在将 ggplot2 功能扩展到 partykit[2] 软件包中。它可以为聚类的对象创建清晰结构化且高度可定制的可视化图形。
本文目的：解读上图是细节代码，注意这不算是一个入门级教程。该包的入门教程可见 ggparty: Graphic Partying[3]。
教程
安装
通过 GitHub 安装：
devtools::install_github("martin-borkovec/ggparty", dependencies = TRUE)
数据介绍
加载相关 R 包，使用 ARE 包中的 TeachingRatings 数据。数据预览如下：
library(ggparty) library(ARE) data("TeachingRatings", package = "AER")
模型拟合
tr <- subset(TeachingRatings, credits == "more") tr_tree <- lmtree(eval ~ beauty | minority + age + gender + division + native + tenure, data = tr, weights = students, caseweights = FALSE)
这里使用 credits == "more" 的数据集作为例子。并使用 lmtree() 函数来拟合用于拟合条件推断树模型，该函数来自于 partykit 包。具体来说，该模型用来预测响应变量 eval（即教学评估）的值，其解释变量包括 beauty（外貌吸引力）、minority（是否为少数族裔）、age（年龄）、gender（性别）、division（所在学院）和 native（出生地），还有 tenure（职业资历）。
在该模型中， minority、age、gender、division、native 和 tenure 是条件变量，它们的取值会影响到 beauty 对 eval 的影响。同时，模型使用了 students 权重来调整样本中不同学生的权重，以更准确地估计模型的系数。
基于拟合结果，绘制对应图形。这时候需要使用 ggparty 包中的 ggparty()。最终代码将会在文末给出，这里先带读者解读代码的含义。
具体来说，这段代码绘制了一个节点表示模型的每个内部节点和叶子节点，并用边连接它们。此外，该代码也添加了其他几个元素，如节点标签、节点样式、节点尺寸、节点形状和节点颜色。
可视化：构建边
p = ggparty(tr_tree, terminal_space = 0.5, add_vars = list(p.value = "$node$info$p.value")) + geom_edge(size = 1.5) + geom_edge_label(colour = "grey", size = 6) p
各个参数的具体含义为：
terminal_space = 0.5：表示绘制叶子节点时，每个节点之间的水平空间大小。add_vars = list(p.value = "$node$info$p.value")：表示添加p.value到节点标签中，即每个节点上的显著性检验的 p 值。geom_edge(size = 1.5)：表示定义边的样式和宽度。geom_edge_label(colour = "grey", size = 6)：表示定义边标签的颜色和大小。
可视化：构建节点
在构建完树的边后，添加节点。各个参数的具体含义为：
geom_node_plot：表示为节点添加一个ggplot2对象，包含点和点属性。这里的gglist参数表示添加到节点中的点图层的列表。scales = "fixed"表示 x 和 y 轴使用相同的尺度。id = "terminal"表示这个点图层是在终端节点上绘制的。shared_axis_labels = T和shared_legend = T分别表示共享坐标轴标签和图例。legend_separator = T表示为图例添加分隔符。predict_gpar = list(col = "blue", size = 1.2)：表示定义预测线的颜色和大小。geom_node_label：表示为节点添加文本标签。第一个geom_node_label函数用于添加内部节点标签。其中line_list参数是一个包含每行标签的列表，分别代表节点 ID、拆分变量和 p 值。line_gpar参数是一个包含每行标签样式的列表。ids = "inner"表示这个文本标签是在内部节点上绘制的。第二个geom_node_label函数用于添加叶子节点标签。size = 5表示文本大小，nudge_y = 0.01表示在 y 方向上微调文本位置。
p + geom_node_plot(gglist = list(geom_point(aes(x = beauty, y = eval, col = tenure, shape = minority), alpha = 0.8), theme_bw(base_size = 15)), scales = "fixed", id = "terminal", shared_axis_labels = T, shared_legend = T, legend_separator = T, predict = "beauty", predict_gpar = list(col = "blue", size = 1.2) ) + geom_node_label(aes(col = splitvar), line_list = list(aes(label = paste("Node", id)), aes(label = splitvar), aes(label = paste("p =", formatC(p.value, format = "e", digits = 2)))), line_gpar = list(list(size = 12, col = "black", fontface = "bold"), list(size = 20), list(size = 12)), ids = "inner") + geom_node_label(aes(label = paste0("Node ", id, ", N = ", nodesize)), fontface = "bold", ids = "terminal", size = 5, nudge_y = 0.01) + theme(legend.position = "none")
此时，即可得到原文最前面的图形了。
完整代码
library(ggparty) library(ARE) data("TeachingRatings", package = "AER") str(TeachingRatings) tr <- subset(TeachingRatings, credits == "more") tr_tree <- lmtree(eval ~ beauty | minority + age + gender + division + native + tenure, data = tr, weights = students, caseweights = FALSE) ggparty(tr_tree, terminal_space = 0.5, add_vars = list(p.value = "$node$info$p.value")) + geom_edge(size = 1.5) + geom_edge_label(colour = "grey", size = 6) + geom_node_plot(gglist = list(geom_point(aes(x = beauty, y = eval, col = tenure, shape = minority), alpha = 0.8), theme_bw(base_size = 15)), scales = "fixed", id = "terminal", shared_axis_labels = T, shared_legend = T, legend_separator = T, predict = "beauty", predict_gpar = list(col = "blue", size = 1.2) ) + geom_node_label(aes(col = splitvar), line_list = list(aes(label = paste("Node", id)), aes(label = splitvar), aes(label = paste("p =", formatC(p.value, format = "e", digits = 2)))), line_gpar = list(list(size = 12, col = "black", fontface = "bold"), list(size = 20), list(size = 12)), ids = "inner") + geom_node_label(aes(label = paste0("Node ", id, ", N = ", nodesize)), fontface = "bold", ids = "terminal", size = 5, nudge_y = 0.01) + theme(legend.position = "none")
小编有话说
- 这种图形非常新颖，小编也是第一次见，并且觉得在未来科研中还会遇到。所以在此对这段代码进行解读，也分享给大家。
- 该包还能做许多类似的工作，感兴趣的读者可以自行浏览官网和学习。
参考资料
[1]
ggparty: https://github.com/martin-borkovec/ggparty
[2]
partykit: https://github.com/partykit/partykit
[3]
ggparty: Graphic Partying: https://cran.r-project.org/web/packages/ggparty/vignettes/ggparty-graphic-partying.html
