R - 使用 Pheatmap 时的图例标题或单位

Question

我正在使用 pheatmap 创建值热图，并希望使用矩阵中 z 值的单位来标记图例。在此示例中，我希望图例的顶部显示温度 [°C]。我已经阅读了 pheatmap 的指南，似乎对图例的唯一操作是添加要显示的默认数字列表来代替比例。我看不到任何添加图例标题本身的选项。

这是一个通用代码块，用于生成矩阵并使用 pheatmap 进行绘图。我真的很感激任何关于如何为图例添加标题的建议。

test <- matrix(rexp(200, rate=.1), ncol=20)
colnames(test) = paste("Room", 1:20, sep = "")
rownames(test) = paste("Building", 1:10, sep = "")

pheatmap(test, legend = TRUE, cluster_rows = FALSE, cluster_cols = FALSE)

Answer 1

MikeyMike的回答令人难以置信；通过阅读我也学到了很多东西。

但是，我需要一个愚蠢、丑陋的 10 秒解决方案：

test <- matrix(rexp(200, rate=.1), ncol=20)
colnames(test) = paste("Room", 1:20, sep = "")
rownames(test) = paste("Building", 1:10, sep = "")

pheatmap(test, legend_breaks = c(10, 20, 30, 40, max(test)), 
main = "", legend_labels = c("10", "20", "30", "40", "title\n"),
legend = TRUE, cluster_rows = FALSE, cluster_cols = FALSE)

产生此热图：

Answer 2

好吧，既然有人还没有回答这个问题，如果你绝对必须使用 pheatmap 函数，我会给你一个可能的选择。使用这更容易做到 ggplot，但它是这样的：

首先，我们要生成绘图，以便我们可以使用所有绘图对象来创建我们自己的绘图，并带有编辑后的图例。

#Edited to add in library names
library(gtable)
library(grid)

#Starting with data and generating initial plot
test <- matrix(rexp(200, rate=.1), ncol=20)
colnames(test) = paste("Room", 1:20, sep = "")
rownames(test) = paste("Building", 1:10, sep = "")

p<-pheatmap(test, legend = TRUE, cluster_rows = FALSE, cluster_cols = FALSE)



#Get grobs we want - will use these to create own plot later
plot.grob <- p$gtable$grob[[1]]
xlab.grob <- p$gtable$grob[[2]]  
ylab.grob <- p$gtable$grob[[3]]  
legend.grob <- p$gtable$grob[[4]]  

现在，一旦我们有了对象，我们实际上想要将图例向下移动一点，为标题腾出空间。

#Shift both down by 1 inch
legend.grob$children[[1]]$y <- legend.grob$children[[1]]$y - unit(0.85,"inches") 
legend.grob$children[[2]]$y <- legend.grob$children[[2]]$y - unit(0.85,"inches") 
legend.grob$children[[1]]$x <- legend.grob$children[[1]]$x + unit(0.4,"inches") 
legend.grob$children[[2]]$x <- legend.grob$children[[2]]$x + unit(0.4,"inches") 

既然我们已经为图例腾出了空间，现在我们可以创建图例 textGrob 并将其添加到图例 grobTree （只是我们希望图例中的图形对象集）

#New legend label grob
leg_label <- textGrob("Temperature [°C]",x=0,y=0.9,hjust=0,vjust=0,gp=gpar(fontsize=10,fontface="bold"))

#Add label to legend grob
legend.grob2 <- addGrob(legend.grob,leg_label)

如果您想看看我们的图例是什么样子，请尝试：

grid.draw(legend.grob2)

现在我们实际上需要构建我们的 gtable 对象。为此，我们将使用与 pheatmap 函数生成的绘图类似的布局（经过一些修改）。另请注意，pheatmap 函数生成一个 gtable 对象，可以通过以下方式访问：

p$gtable

为了查看 gtable 对象中每个“扇区”的宽度/高度，我们需要做的是：

p$gtable$heights
p$gtable$widths

这些将作为我们的参考值。如需更多图形显示，请尝试：

gtable_show_layout(p$gtable)

产生此图像：

好的，现在我们已经有了我们想要的 grobs，我们需要做的就是根据我们看到的 pheatmap 构建的 gtable 来构建我们的 gtable。我写的一些示例代码是：

my_new_gt <- gtable(widths=  unit.c(unit(0,"bigpts") + unit(5,"bigpts"),
                                    unit(0,"bigpts"),
                                    unit(1,"npc") - unit(1,"grobwidth",plot.grob) + unit(10,"bigpts") - max(unit(1.1,"grobwidth",plot.grob), (unit(12,"bigpts")+1.2*unit(1.1,"grobwidth",plot.grob))) + unit(5,"bigpts") - unit(3,"inches"),
                                    unit(1,"grobwidth",ylab.grob) + unit(10,"bigpts"),
                                    max(unit(1,"grobwidth",legend.grob2),unit(12,"bigpts")+1.2*unit(1.1,"grobwidth",legend.grob2)) + unit(1,"inches") ,
                                    max(unit(0,"bigpts"),unit(0,"bigpts"))
                                    ),
                                    
                    
                    
                    height = unit.c(unit(0,"npc"),
                                    unit(5,"bigpts"),
                                    unit(0,"bigpts"),
                                    unit(1,"npc") - unit(1,"grobheight",xlab.grob) + unit(15,"bigpts") - unit(0.2,"inches"),
                                    unit(1,"grobheight",xlab.grob) + unit(15,"bigpts")     
                      ))

最后，我们可以将所有对象添加到新的 gtable 中，以获得与 pheatmap 生成的图形非常相似的图形，并添加了图例标题。

#Adding each grob to the appropriate spot
gtable <- gtable_add_grob(my_new_gt,plot.grob,4,3)
gtable <- gtable_add_grob(gtable,xlab.grob,5,3)
gtable <- gtable_add_grob(gtable,ylab.grob,4,4)
gtable <- gtable_add_grob(gtable,legend.grob2,4,5)

grid.draw(gtable)

最终生成的输出是：

希望这有帮助。您可以摆弄不同的大小，尝试使布局更加动态，但我认为这是一个很好的设置，可以让您得到您想要的东西 - 带有图例的 pheatmap。

编辑 - ggplot 选项：

由于我推荐 ggplot 作为替代方案，这里有一些代码来完成它：

library(ggplot2)
library(reshape)
test <- as.data.frame(matrix(rexp(200, rate=.1), ncol=20))
colnames(test) = paste("Room", 1:20, sep = "")
test$building = paste("Building", 1:10, sep = "")

#Get the sorting right
test$sort <- 1:10

#Melting data so we can plot it with GGplot
test.m <- melt(test,id.vars = c("building","sort"))

#Resetting factors
test.m$building <- factor(test.m$building, levels=(test.m$building)[order(test.m$sort)])

#Creating the plot itself
plot <- ggplot(test.m,aes(variable,building)) + geom_tile(aes(fill=value),color = "white") +
        #Creating legend
        guides(fill=guide_colorbar("Temperature [°C]")) +
        #Creating color range
        scale_fill_gradientn(colors=c("skyblue","yellow","tomato"),guide="colorbar") +
        #Rotating labels
        theme(axis.text.x = element_text(angle = 270, hjust = 0,vjust=-0.05))
plot

这产生了这个情节：

如您所见，ggplot2 方法要快得多。您所要做的就是将数据转换为数据框，然后熔化它。完成后，您可以轻松更改图例标题。

Answer 3

另一个快速解决方案是将

pheatmap::pheatmap

替换为

ComplexHeatmap::pheatmap

，然后添加

heatmap_legend_param

支持的

ComplexHeatmap::pheatmap

参数：

ComplexHeatmap::pheatmap(test, legend = TRUE, cluster_rows = FALSE, cluster_cols = FALSE, heatmap_legend_param = list(title = "title", at = c(10,20,30,40)))

Answer 4

我找到了一个有用的解决方案，它介于迈克的美丽但相当复杂的解决方案和安德鲁的“愚蠢而丑陋”的解决方案之间，我喜欢它。我使用安德鲁的解决方案添加了一个额外的中断标签，然后您可以将其转换为美丽的图例标题！

library(pheatmap)
library(grid)

# Generate dummy data
tally <- matrix((1:50) + rnorm(50), nrow = 10, ncol = 5)

nbreaks <- 4 # as many breaks as you want
get.breaks <- seq(from = range(cor(tally))[1],
                  to = range(cor(tally))[2],
                  length.out = nbreaks)

# Create gtable using pheatmap
plot.cor <- pheatmap(cor(tally),
                     # add an additional break, doesn't matter how you label it
                     legend_breaks = c(get.breaks, max(get.breaks)),
                     legend_labels = c(round(get.breaks, 2), "r"),
                     silent = TRUE)$gtable

# Extract legend grob from gtable:
# the legend is probably the last grob, but you might have to investigate
# plot.cor$grobs if this is not the case
index <- length(plot.cor$grobs)
legend.grob <- plot.cor$grobs[[index]]

# Transform ugly break label into beautiful legend title
legend.grob$children[[2]]$label[nbreaks + 1] <- expression("Pearson's" ~ italic(r))
legend.grob$children[[2]]$hjust <- c(rep(0, nbreaks), 0.75)
legend.grob$children[[2]]$vjust <- c(rep(0.5, nbreaks), -2)
# ... playing with the horizontal and vertical alignment should be sufficient
# to move your lengend title exactly where you want it!
legend.grob$children[[2]]$gp$fontsize <- c(rep(8, nbreaks), 11)
plot.cor$grobs[[index]] <- legend.grob

grid.newpage()
grid.draw(plot.cor)

带有图例标题的最终相关热图！

不幸的是，我还没有先进到可以在这里嵌入图像：p