How to add clustering rectangle in hierarchical heatmap dendogram

Question

The following code create 1. Dendogram and 2. Heatmap with dendogram

mydata <- mtcars
hclustfunc <- function(x) hclust(x, method="complete")
distfunc <- function(x) dist(x,method="euclidean")
d <- distfunc(mydata)
fit <- hclustfunc(d)

#plot dendogram only
plot(fit)
groups <- cutree(fit, k=5) 

# Add rectangle in cluster
rect.hclust(fit, k=5, border="red")

Which generate this plot:

Now I want to create a heat map with dendogram

# plot heat map with dendogram together.
library("gplots")
heatmap.2(as.matrix(mydata),dendrogram="row",trace="none", margin=c(8,9), hclust=hclustfunc,distfun=distfunc);

Currently it looks like this:

In the final heat map is there a way I can add the red rectangle for each cluster (i.e. onto the dendogram on the left) just like first figure?

Answer 1

May I suggest an alternative, by using RowSideColors argument in the heatmap.2 function:

heatmap.2(as.matrix(mydata),dendrogram="row",trace="none", margin=c(8,9), 
         hclust=hclustfunc, distfun=distfunc, RowSideColors=as.character(groups))

If you wish to reassign the colours:

# require(RColorBrewer)
cols <- brewer.pal(max(groups), "Set1")
heatmap.2(as.matrix(mydata),dendrogram="row",trace="none", margin=c(8,9), 
         hclust=hclustfunc, distfun=distfunc, RowSideColors=cols[groups])

The first example is shown below:

Answer 2

I hacked heatmap.2 and I add this lines :

cluster <- cutree(hcr, k=kcluster) 
clustab <- table(cluster)[unique(cluster[hcr$order])]
m <- c(0, cumsum(clustab))
which <- 1L:kcluster
border <- rep_len(border, length(which))
for (n in seq_along(which))
   rect(par("usr")[2L]+10,m[which[n]] + 0.66, 
    mean(rev(hcr$height)[(kcluster - 1):kcluster]),
    m[which[n] + 1] + 0.33, 
    border = border[n])

after this line :

plot(ddr, horiz = TRUE, axes = FALSE, yaxs = "i", leaflab = "none")

You can find the code of the new function in this gist.

Examples:

heatmap.rect(as.matrix(mydata),
             dendrogram="row",trace="none", margin=c(8,9), 
             hclust=hclustfunc,distfun=distfunc,key=FALSE,
             kcluster=7,border='blue')