Search code examples
rdendrogrampheatmap

Changing branch length in dendrogram (pheatmap)


I am trying to plot a heatmap with the library pheatmap in R. I think that by default the branch length is proportional to the "dissimilarity" of the clusters that got merged at this step. I would like to chance that, so it is a fixed value because for my purpose it looks very weird!

If anyone has an idea how I can fix this, I would be very happy.

Here is a sample code

library(pheatmap)
test = matrix(rnorm(6000), 100, 60)
pheatmap(test)

Cheers!


Solution

  • Here is an example of two column groups with high dissimilarity:

    library(pheatmap)
    test = cbind(matrix(rnorm(3000), 100, 30),
                matrix(rnorm(3000)+10, 100, 30))
    pheatmap(test)
    

    enter image description here

    TIn pheatmapthe dendrogram is plotted by the pheatmap:::draw_dendrogram function and branch lengths are stored in the h object.
    Below I define equal-length branches adding the command
    hc$height <- cumsum(rep(1/length(hc$height), length(hc$height)))
    as follows:

    draw_dendrogram <- function(hc, gaps, horizontal = T) {
        # Define equal-length branches
        hc$height <- cumsum(rep(1/length(hc$height), length(hc$height)))
        h = hc$height/max(hc$height)/1.05
        m = hc$merge
        o = hc$order
        n = length(o)
        m[m > 0] = n + m[m > 0]
        m[m < 0] = abs(m[m < 0])
        dist = matrix(0, nrow = 2 * n - 1, ncol = 2, dimnames = list(NULL, 
            c("x", "y")))
        dist[1:n, 1] = 1/n/2 + (1/n) * (match(1:n, o) - 1)
        for (i in 1:nrow(m)) {
            dist[n + i, 1] = (dist[m[i, 1], 1] + dist[m[i, 2], 1])/2
            dist[n + i, 2] = h[i]
        }
        draw_connection = function(x1, x2, y1, y2, y) {
            res = list(x = c(x1, x1, x2, x2), y = c(y1, y, y, y2))
            return(res)
        }
        x = rep(NA, nrow(m) * 4)
        y = rep(NA, nrow(m) * 4)
        id = rep(1:nrow(m), rep(4, nrow(m)))
        for (i in 1:nrow(m)) {
            c = draw_connection(dist[m[i, 1], 1], dist[m[i, 2], 1], 
                dist[m[i, 1], 2], dist[m[i, 2], 2], h[i])
            k = (i - 1) * 4 + 1
            x[k:(k + 3)] = c$x
            y[k:(k + 3)] = c$y
        }
        x = pheatmap:::find_coordinates(n, gaps, x * n)$coord
        y = unit(y, "npc")
        if (!horizontal) {
            a = x
            x = unit(1, "npc") - y
            y = unit(1, "npc") - a
        }
        res = polylineGrob(x = x, y = y, id = id)
        return(res)
    }
    # Replace the non-exported function `draw_dendrogram` in `pheatmap`:
    assignInNamespace(x="draw_dendrogram", value=draw_dendrogram, ns="pheatmap")
    
    pheatmap(test)
    

    The result is:

    enter image description here