Skip to content

Instantly share code, notes, and snippets.

@low-decarie
Last active July 21, 2023 22:17
Show Gist options
  • Star 2 You must be signed in to star a gist
  • Fork 3 You must be signed in to fork a gist
  • Save low-decarie/5886616 to your computer and use it in GitHub Desktop.
Save low-decarie/5886616 to your computer and use it in GitHub Desktop.
Given a data matrix, this produces a tile plot with dendograms for each axis
dual_dendogram_tile_plot <- function(data.matrix, main="Title"){
#Dual dendrogram ############
x <- data.matrix
dd.col <- as.dendrogram(hclust(method="ward",dist(x)))
col.ord <- order.dendrogram(dd.col)
dd.row <- as.dendrogram(hclust(method="ward",dist(t(x))))
row.ord <- order.dendrogram(dd.row)
xx <- data.matrix[col.ord, row.ord]
xx_names <- attr(xx, "dimnames")
df <- as.data.frame(xx)
colnames(df) <- xx_names[[2]]
df$y.variable <- xx_names[[1]]
df$y.variable <- with(df, factor(y.variable, levels=y.variable, ordered=TRUE))
mdf <- melt(df, id.vars="y.variable")
### Use ggdendro to extract dendrogram data ###
ddata_x <- dendro_data(dd.row)
ddata_y <- dendro_data(dd.col)
### Create plot components ###
# Heatmap
p1 <- ggplot(mdf,xlab="",ylab="", aes(x=variable, y=y.variable)) +
geom_tile(aes(fill=value))+
theme(axis.text.x=element_text(angle=90,hjust=0),
axis.text.y=element_text(hjust=0),
legend.position="bottom",
plot.margin=unit(c(0,0,1,1), "cm"))+
scale_x_discrete(expand = c(0, 0)) + scale_y_discrete(expand = c(0, 0))
# Dendrogram 1
p2 <- ggplot(segment(ddata_x)) +
geom_segment(aes(x=x, y=y, xend=xend, yend=yend)) +
theme_none + theme(axis.title.x=element_blank(),
plot.margin=unit(c(1,1,0,1), "cm"))+
scale_x_continuous(expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0))
# Dendrogram 2
p3 <- ggplot(segment(ddata_y)) +
geom_segment(aes(x=x, y=y, xend=xend, yend=yend)) +
coord_flip() + theme_none + theme(plot.margin=unit(c(1,1,1,0), "cm"))+
scale_x_continuous(expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0))
gp1 <- ggplotGrob(p1)
gp2 <- ggplotGrob(p2)
gp3 <- ggplotGrob(p3)
# maxWidth = grid::unit.pmax(gp1$widths[2:3], gp2$widths[2:3])
# maxHeight = grid::unit.pmax(gp1$heights[c(2,4,5)], gp3$heights[c(2,4,5)])
# gp1$widths[2:3] <- as.list(maxWidth)
# gp2$widths[2:3] <- as.list(maxWidth)
# gp1$heights[c(2,4,5)] <- as.list(maxHeight)
# gp3$heights[c(2,4,5)] <- as.list(maxHeight)
# grid.arrange(gp2,grid.text(main), gp1,gp3, ncol=2, heights=c(5,25), widths=c(25,5))
g <- gtable_add_cols(gp1, unit(3,"in"))
g <- gtable_add_grob(g, gp3,
t = 2, l=ncol(g), b=3, r=ncol(g))
g <- gtable_add_rows(g, unit(3,"in"), 0)
g <- gtable_add_grob(g, gp2,
t = 1, l=4, b=1, r=4)
grid.newpage()
grid.draw(g)
}
@jenzopr
Copy link

jenzopr commented May 20, 2015

Hey Etienne! Nice function here, just a side note: Can you clarify how theme_none was defined? Or where do I find it? Thanks a lot!
Edit:

Set up a blank theme

theme_none <- theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.title.x = element_text(colour=NA),
axis.title.y = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.line = element_blank()
#axis.ticks.length = element_blank()
)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment