r - 右侧带有标签的树状图
问题描述
我想要一个带有右侧变量名称的水平树状图来显示相关系数。如果我可以在一些与 ggplot2 相关的包中实现它会很好,因为我希望该图与我的其他图形相似。scale_x_discrete(position="top)
不起作用,因为这样标签就会消失。这些是我到目前为止的结果:
library(ggplot2)
library(dplyr)
library(tidyr)
library(faux)
library(ggdendro)
# data
set.seed(5)
dat <- rnorm_multi(n = 100,
mu = c(0, 20, 20),
sd = c(1, 5, 5),
r = c(0.5, 0.5, 0.25),
varnames = c("A", "B", "C"),
empirical = FALSE)
# make correlation matrix
cor_matrix_before <- cor(dat, method="spearman")
# make dendrogram
tree <- hclust(as.dist(1 - cor_matrix_before**2))
ggdendrogram(tree) +
theme_light() +
theme(text = element_text(size=16)) +
xlab("") +
ylab("Spearmans rho squared") +
scale_y_reverse(breaks=seq(0,1,0.25), labels=rev(seq(0,1,0.25))) +
geom_hline(yintercept=0.7*0.7, col = "red") +
coord_flip()
(我偷了相关变量的准备:https ://cran.r-project.org/web/packages/faux/vignettes/rnorm_multi.html )
但这就是我想要的(只是一个快速的蒙太奇):
编辑:感谢@tjebo,这是我的最终解决方案(我删除了所有不需要的部分,查看他的答案以获得更通用的答案):
tree <- hclust(as.dist(1 - cor_matrix_before**2))
data <- ggdendro::dendro_data(tree)
ggplot() +
geom_blank()+
geom_segment(data = segment(data), aes_string(x = "x", y = "y", xend = "xend", yend = "yend")) +
geom_hline(yintercept=0.7*0.7, col = "red") +
scale_x_continuous(breaks = seq_along(data$labels$label), labels = data$labels$label, position = "top") +
scale_y_reverse(breaks=seq(0,1,0.25), labels=rev(seq(0,1,0.25))) +
coord_flip() +
theme(axis.text.x = element_text(angle = angle, hjust = 1, vjust = 0.5),
axis.text.y = element_text(angle = angle, hjust = 1),
text = element_text(size=16, family="Calibri")) +
ylab("Spearmans rho squared") +
xlab("") +
theme_light()
解决方案
如果您想避免重新发明轮子并从头开始创建这些树状图(即,如果您想使用高级 ggdendrogram),那么您将无法绕过更改底层功能。ggdendro::ggdendrogram
定义 y 和 x 轴。您需要在函数体中修改它们。请参阅下面代码中的注释。
library(tidyverse)
library(faux)
library(ggdendro)
set.seed(5)
dat <- rnorm_multi(
n = 100,
mu = c(0, 20, 20),
sd = c(1, 5, 5),
r = c(0.5, 0.5, 0.25),
varnames = c("A", "B", "C"),
empirical = FALSE
)
cor_matrix_before <- cor(dat, method = "spearman")
tree <- hclust(as.dist(1 - cor_matrix_before**2))
## re-define ggdendrogram. I think the easiest is add another argument for the axis position, see "x_lab"
ggdendrogram2 <- function(data, segments = TRUE, labels = TRUE, leaf_labels = TRUE,
rotate = FALSE, theme_dendro = TRUE, x_lab = "bottom", ...) {
dataClass <- if (inherits(data, "dendro")) {
data$class
} else {
class(data)
}
angle <- if (dataClass %in% c("dendrogram", "hclust")) {
ifelse(rotate, 0, 90)
} else {
ifelse(rotate, 90, 0)
}
hjust <- if (dataClass %in% c("dendrogram", "hclust")) {
ifelse(rotate, 1, 1)
} else {
0.5
}
if (!ggdendro::is.dendro(data)) {
data <- ggdendro::dendro_data(data)
}
p <- ggplot() +
geom_blank()
if (segments && !is.null(data$segments)) {
p <- p + geom_segment(data = segment(data), aes_string(
x = "x",
y = "y", xend = "xend", yend = "yend"
))
}
if (leaf_labels && !is.null(data$leaf_labels)) {
p <- p + geom_text(
data = leaf_label(data), aes_string(
x = "x",
y = "y", label = "label"
), hjust = hjust, angle = angle,
...
)
}
if (labels) {
p <- p + scale_x_continuous(
breaks = seq_along(data$labels$label),
labels = data$labels$label,
# and this is where you add x_lab
position = x_lab
)
}
if (rotate) {
p <- p + coord_flip()
p <- p + scale_y_continuous()
} else {
p <- p + scale_y_continuous()
}
if (theme_dendro) {
p <- p + theme_dendro()
}
p <- p + theme(axis.text.x = element_text(
angle = angle,
hjust = 1, vjust = 0.5
)) + theme(axis.text.y = element_text(
angle = angle,
hjust = 1
))
p
}
ggdendrogram2(tree, x_lab = "top", rotate = TRUE)
由reprex 包于 2021-07-28 创建 (v2.0.0 )
推荐阅读
- sql - SQL在字符串中的括号之间选择多个值
- spring - 为什么@GetMapping 和@PostMapping 对同一个URI 抛出错误?
- angularjs - 表单组 - 选择下拉列表未填充,但数组显示在控制台中
- reactjs - 你如何在 React 的功能组件中执行条件渲染?
- angular - 我们如何向 mcc-color-picker-collection 中的颜色集合添加“透明”
- apache-poi - Apache POI excel如何为单元格应用文本左上缩进
- javascript - 每 5 秒后自动刷新 Div
- java - 没有连接子句的一对多 JPA 查询
- iis - 来自 IIS 应用程序的 IE 11 中的 403 禁止错误
- php - 具有类型的聚合计数过滤器