Zoe
Zoe

Reputation: 1000

Dendrogram with labels on the right side

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() 

current dendro

(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):

what I want

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()

Upvotes: 2

Views: 352

Answers (1)

tjebo
tjebo

Reputation: 23737

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)

Upvotes: 1

Related Questions