右侧带有标签的树状图

Question

我想要一个带有右侧变量名称的水平树状图来显示相关系数。 如果我能在一些与 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()

Answer 1

如果您想避免重新发明轮子并从头开始创建这些树状图（即，如果您想使用高级 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 包( v2.0.0 ) 于 2021 年 7 月 28 日创建}