Diagonal labels orientation on x-axis in heatmap(s)

孤街醉人 提交于 2019-11-29 21:27:01

To fix pheatmap, all you really want to do is to go into pheatmap:::draw_colnames and tweak a couple of settings in its call to grid.text(). Here's one way to do that, using assignInNamespace(). (It may need additional adjustments, but you get the picture ;):

library(grid)     ## Need to attach (and not just load) grid package
library(pheatmap)

## Your data
d <- matrix(rnorm(25), 5, 5)
colnames(d) = paste("bip", 1:5, sep = "")
rownames(d) = paste("blob", 1:5, sep = "")

## Edit body of pheatmap:::draw_colnames, customizing it to your liking
draw_colnames_45 <- function (coln, ...) {
    m = length(coln)
    x = (1:m)/m - 1/2/m
    grid.text(coln, x = x, y = unit(0.96, "npc"), vjust = .5, 
        hjust = 1, rot = 45, gp = gpar(...)) ## Was 'hjust=0' and 'rot=270'
}

## For pheatmap_1.0.8 and later:
draw_colnames_45 <- function (coln, gaps, ...) {
    coord = pheatmap:::find_coordinates(length(coln), gaps)
    x = coord$coord - 0.5 * coord$size
    res = textGrob(coln, x = x, y = unit(1, "npc") - unit(3,"bigpts"), vjust = 0.5, hjust = 1, rot = 45, gp = gpar(...))
    return(res)}

## 'Overwrite' default draw_colnames with your own version 
assignInNamespace(x="draw_colnames", value="draw_colnames_45",
ns=asNamespace("pheatmap"))

## Try it out
pheatmap(d)

It is a little more complex than my comment presumed, because heatmap breaks up the plotting region in order to draw the dendrograms and the last plot region is not the image plot to which you want to attach the labels.

There is a solution though as heatmap provides the add.expr argument which takes an expression to be evaluated when the image is drawn. One also needs to know the reordering of the labels that takes place due to the dendrogram ordering. The last bit involves a bit of an inelegant hack as I will draw the heatmap first to get the reordering information and then use that to draw the heatmap properly with the angled labels.

First an example from ?heatmap

 x  <- as.matrix(mtcars)
 rc <- rainbow(nrow(x), start = 0, end = .3)
 cc <- rainbow(ncol(x), start = 0, end = .3)
 hv <- heatmap(x, col = cm.colors(256), scale = "column",
               RowSideColors = rc, ColSideColors = cc, margins = c(5,10),
               xlab = "specification variables", ylab =  "Car Models",
               main = "heatmap(<Mtcars data>, ..., scale = \"column\")")

At this stage, the labels aren't how we want them, but hv contains the information we need to reorder the colnames of mtcars in its component $colInd:

> hv$colInd
 [1]  2  9  8 11  6  5 10  7  1  4  3

You use this like you would the output from order e.g.:

> colnames(mtcars)[hv$colInd]
 [1] "cyl"  "am"   "vs"   "carb" "wt"   "drat" "gear" "qsec" "mpg"  "hp"  
[11] "disp"

Now use that to generate the labels we want in the correct order:

 labs <- colnames(mtcars)[hv$colInd]

Then we re-call heatmap but this time we specify labCol = "" to suppress the labelling of the column variables (using zero length strings). We also use a call to text to draw the labels at the desired angle. The call to text is:

text(x = seq_along(labs), y = -0.2, srt = 45, labels = labs, xpd = TRUE)

which is essentially what you have in your question. Play with the value of y as you need to adjust this to the length of the strings so as to have the labels not overlap with the image plot. We specify labels = labs to pass in the labels we want draw in the order required. The entire text call is passed to add.expr unquoted. Here is the entire call:

 hv <- heatmap(x, col = cm.colors(256), scale = "column",
               RowSideColors = rc, ColSideColors = cc, margins = c(5,10),
               xlab = "specification variables", ylab =  "Car Models",
               labCol = "",
               main = "heatmap(<Mtcars data>, ..., scale = \"column\")",
               add.expr = text(x = seq_along(labs), y = -0.2, srt = 45,
                               labels = labs, xpd = TRUE))

Which results in:

Yongsheng Cheng

I am also looking for method to rotate label text with heatmap. Eventually I have managed to find this solution:

library(gplots)

library(RColorBrewer)

heatmap.2(x,col=rev(brewer.pal(11,"Spectral")),cexRow=1,cexCol=1,margins=c(12,8),trace="none",srtCol=45)

The key argument is srtCol(or srtRow for row labels), which is used to rotate column labels in gplots.

A solution using lattice::levelplot and latticeExtra::dendrogramGrob:

library(lattice)
library(latticeExtra)

The example data:

d <- matrix(rnorm(25), 5, 5)
colnames(d) = paste("bip", 1:5, sep = "")
rownames(d) = paste("blob", 1:5, sep = "")

You must define the dendrograms for rows and columns (computed internally in heatmap):

dd.row <- as.dendrogram(hclust(dist(d)))
row.ord <- order.dendrogram(dd.row)

dd.col <- as.dendrogram(hclust(dist(t(d))))
col.ord <- order.dendrogram(dd.col)

and pass them to the dendrogramGrob function in the legend argument of levelplot.

I have defined a new theme with colors from RColorBrewer, and modified the width and color of the cells borders with border and border.lwd:

myTheme <- custom.theme(region=brewer.pal(n=11, 'RdBu'))

levelplot(d[row.ord, col.ord],
          aspect = "fill", xlab='', ylab='',
          scales = list(x = list(rot = 45)),
          colorkey = list(space = "bottom"),
          par.settings=myTheme,
          border='black', border.lwd=.6,
          legend =
          list(right =
               list(fun = dendrogramGrob,
                    args =
                    list(x = dd.col, ord = col.ord,
                         side = "right",
                         size = 10)),
               top =
               list(fun = dendrogramGrob,
                    args =
                    list(x = dd.row,
                         side = "top"))))

You can even use the shrink argument to scale the cells size proportional to their value.

levelplot(d[row.ord, col.ord],
          aspect = "fill", xlab='', ylab='',
          scales = list(x = list(rot = 45)),
          colorkey = list(space = "bottom"),
          par.settings=myTheme,
          border='black', border.lwd=.6,
          shrink=c(.75, .95),
          legend =
          list(right =
               list(fun = dendrogramGrob,
                    args =
                    list(x = dd.col, ord = col.ord,
                         side = "right",
                         size = 10)),
               top =
               list(fun = dendrogramGrob,
                    args =
                    list(x = dd.row,
                         side = "top"))))

The latest version of pheatmap (1.0.12) released on 2019-01-04 supports this with the angle_col argument.

#example data
d <- matrix(rnorm(25), 5, 5)
colnames(d) = paste("bip", 1:5, sep = "")
rownames(d) = paste("blob", 1:5, sep = "")

#update to latest version on CRAN
install.packages("pheatmap")
library("pheatmap")
pheatmap(d, angle_col = 45)

I've created a package on GitHub with an improved version of the heatmap.2 function. This supports adjusting the axis labels, including the srtCol argument which is passed to the axis function. It can be installed from: https://github.com/TomKellyGenetics/heatmap.2x

library("devtools")
install_github("TomKellyGenetics/heatmap.2x")
library("heatmap.2x")

heatmap.2x(d, scale = "none", trace = "none", col = heat.colors, srtCol = 45)

As of version 2.12.1 of gplots, the heatmap.2 function also supports the srtCol argument.

library("gplots")
heatmap.2(d, scale = "none", trace = "none", srtCol = 45)

I was able to take Gavin Simpson's answer and trimmed it down a bit to work for me for simple prototyping purposes, where data1 is the read.csv() object, and data1_matrix of course the matrix produced from that

heatmap(data_matrix, Rowv=NA, Colv=NA, col=heat.colors(64), scale='column', margins=c(5,10),
   labCol="", add.expr = text(x = seq_along(colnames(data1)), y=-0.2, srt=45, 
   labels=colnames(data1), xpd=TRUE))

Boom! Thanks Gavin.

A key bit for this to work is the part before the add.expr bit where he set the labCol to "", which is necessary to prevent the former (straight-down) labels from overlapping with the new 45 degree ones

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!