public
Last active

Given a data matrix, this produces a tile plot with dendograms for each axis

  • Download Gist
dual_dendogram_tile_plot
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69
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)
}

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.