热力图中x轴上的对角标签方向

Question

在R中创建热力图一直是许多帖子、讨论和迭代的主题。我的主要问题是，很难将lattice中可用的levelplot()或基本图形中的image()的视觉灵活性与基本的heatmap()、pheatmap的pheatmap()或gplots的heatmap.2()的轻松聚类相结合。我想改变的是一个小细节——x轴标签的对角线方向。让我在代码中展示给你看。

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

您可以使用levelplot()轻松地将方向更改为对角线：

require(lattice)
levelplot(d, scale=list(x=list(rot=45)))

但是应用聚类似乎很麻烦。其他视觉选项，如在热图单元格周围添加边框，也一样。

现在，转向实际的heatmap()相关函数，聚类和所有基本的可视化都非常简单- 几乎不需要调整：

heatmap(d)

这里也是一样的:

require(gplots)
heatmap.2(d, key=F)

最后，我的最爱：

require(pheatmap)
pheatmap(d) 

但是所有这些都没有旋转标签的选项。 pheatmap 的手册建议我使用grid.text来自定义我的标签方向。这真是太棒了，尤其是在聚类和更改显示标签顺序时。除非我在这里漏掉了什么......

最后，还有一个古老而好用的 image()。我可以旋转标签，它是最可定制的解决方案，但没有聚类选项。

image(1:nrow(d),1:ncol(d), d, axes=F, ylab="", xlab="")
text(1:ncol(d), 0, srt = 45, labels = rownames(d), xpd = TRUE)
axis(1, label=F)
axis(2, 1:nrow(d), colnames(d), las=1)

那么，我该怎么做才能获得我的理想热力图，包括聚类、方向和美观的可视化特征？我最好的办法是以某种方式改变 heatmap() 或 pheatmap()，因为这两者似乎在调整方面最为灵活。但欢迎任何解决方案。

- Geek On Acid

---

基础图形不允许您控制刻度标签的旋转角度，因此您必须使用“文本”“hack”，就像您在最后一个“image”示例中展示的那样。我可能会在我的“heatmap”调用中传递“xaxt = FALSE”，然后添加没有标签的轴，然后使用“text”添加标签，就像您在“image”中所做的那样。 - Gavin Simpson

@GavinSimpson 这种方法的问题在于，当你进行聚类时，必须手动定义x轴标签的顺序。这是可能的，但有点痛苦。不过，感谢你指出heatmap()是使用基本图形构建的，而不是像pheatmap()一样使用网格。 - Geek On Acid

有一个解决方案 - 我已经有了一些工作，正在将其编写为答案。它比我想象的要复杂一些。解决方案即将到来... - Gavin Simpson

这是一个有趣的问题，阅读起来很愉快。 - Simon O'Hanlon

Answer 1

为了修复pheatmap，你实际上只需要进入pheatmap:::draw_colnames并调整它在调用grid.text()时的一些设置。这里是一种使用assignInNamespace()的方法来做到这一点。（可能需要额外的调整，但你可以看到大致思路😉）:

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)

- Josh O'Brien

---

对你来说这只是一个小调整，但对我来说却是一大步。归根结底，你是网格的主人 ;) 谢谢 Josh！ - Geek On Acid

@GeekOnAcid -- 嗯，像往常一样感谢你提出这个有趣的问题！事实上，这是我第一次使用assignInNamespace()和pheatmap，它们都是不错的发现。我首先执行了trace(pheatmap:::draw_colnames, edit=TRUE)来尝试一些东西，但是一旦我找到了解决方法，就想要比那更少交互的东西。结果assignInNamespace()就派上用场了，我将在以后经常使用它。干杯。 - Josh O'Brien

同样的事情当然也可以用于“heatmap”版本，但在这种情况下，运行绘图调用两次并使用“add.expr”更容易。 - Gavin Simpson

有什么办法可以增加边距，如果标签很长并且超出了左侧？ - Colin D

这个解决方法不再必要。在pheatmap的1.0.12版本中支持angle_col参数（有关详细信息，请参见下面的答案）。 - Tom Kelly

Answer 2

pheatmap的最新版本（1.0.12）于2019年01月04日发布，支持使用angle_col参数实现此功能。

#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)

我在GitHub上创建了一个包，其中包含heatmap.2函数的改进版本。这支持调整轴标签，包括传递给axis函数的srtCol参数。它可以从以下位置安装：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)

截至 版本 2.12.1 的 gplots，heatmap.2 函数也支持 srtCol 参数。

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

- Tom Kelly

Answer 3

这比我的评论预想的要复杂一些，因为heatmap为了绘制树状图而分割了绘图区域，最后一个绘图区域不是您想要附加标签的image绘图。

然而，有一个解决方案，因为heatmap提供了add.expr参数，该参数接受在绘制image时要评估的表达式。还需要知道由于树状图排序而发生的标签重新排序。最后一部分涉及到有点不太优雅的技巧，因为我将首先绘制热图以获取重新排序的信息，然后使用该信息正确地绘制带有倾斜标签的热图。

首先，来自?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\")")

在这个阶段，标签不是我们想要的，但是hv包含了我们需要重新排序mtcars中的colnames的信息，在其组件$colInd中：

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

你可以像使用 order 返回的输出一样使用它，例如：

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

现在使用它来生成我们想要的标签，按正确顺序排列：

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

接着我们重新调用heatmap，但这次我们指定labCol = ""来抑制列变量的标签（使用零长度字符串）。我们还使用text调用来以所需的角度绘制标签。调用text是：

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

这基本上就是你在问题中提到的内容。根据需要调整y值的大小，以使标签不与image图重叠。我们指定labels = labs来传递我们想要按顺序绘制的标签。整个text调用未引用地传递给add.expr。以下是整个调用：

 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))

这导致了以下结果：

- Gavin Simpson

---

不错的方案，谢谢。获取标签位置非常重要，所以感谢您提供这个解决方案，无论它有多"粗糙" :) - Geek On Acid

是的，非常好。就在上个月我从你那里学到了 plot(..., panel.last)，现在又有了 heatmap(..., add.expr)。这些都是很好的提醒，让我更加注意寻找这样的有用参数（或者更好的方法是，去浏览一下你的旧帖子，寻找类似的宝藏）。 - Josh O'Brien

Answer 4

我也在寻找一种方法来旋转heatmap中的标签文本。最终我找到了这个解决方案：

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)

关键参数是 srtCol（或 srtRow 用于行标签），它用于旋转 gplots 中的列标签。

- Yongsheng Cheng

---

不行，当我使用你的解决方案和我的示例数据时，它不起作用。它会给我一个错误，指出“srtCol”不是图形参数。 - Geek On Acid

Answer 5

使用lattice::levelplot和latticeExtra::dendrogramGrob的解决方案:

library(lattice)
library(latticeExtra)

示例数据：

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

您需要定义行和列的树状图（在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)

将它们传递给levelplot函数中的legend参数的dendrogramGrob函数。

我使用了RColorBrewer中的颜色定义了一个新的主题，并使用border和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"))))

您甚至可以使用“shrink”参数，将单元格大小按比例缩小以适应其值。

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"))))

- Oscar Perpiñán

Answer 6

我能够采用Gavin Simpson的答案，并将其简化一些以适用于我的简单原型制作，其中data1是read.csv()对象，而data1_matrix 当然就是从那个对象生成的矩阵。

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))

嘭！谢谢Gavin。

这个技巧关键在于在add.expr之前的部分，他将labCol设置为空字符串""，这是必要的，以防止原来（直下）的标签与新的45度标签重叠。

- boulder_ruby