I want a horizontal dendrogram with the variable names on the right side to display correlation coefficients. It would be nice if I could achieve it in some ggplot2-related package, since I want the diagram to be similar looking to my other graphics. scale_x_discrete(position="top)
does not work, because then the labels disappear. These are my results so far:
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()
(I stole the preparation of correlated variables from: https://cran.r-project.org/web/packages/faux/vignettes/rnorm_multi.html)
But this would be what I want (just a quick paint-montage):
EDIT: Thanks to @tjebo, this is my final solution (I removed all the parts that I did not need, look at his answer for a more generic answer):
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()
If you want to avoid re-inventing the wheel and creating those dendrograms from scratch (i.e., if you wanna make use of high level ggdendrogram), then you won't get around changing the underlying function. ggdendro::ggdendrogram
defines both y and x axis. You need to modify them in the function body. See comments in the code below.
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)
Created on 2021-07-28 by the reprex package (v2.0.0)