R语言pheatmap包热图legend位置调整

大嘎的数据分析BAR

16571人浏览 · 2022-06-05 15:12:26

大嘎的数据分析BAR · 2022-06-05 15:12:26 发布

前言

上一期用 pheatmap 包画完热图之后发现，虽然图很美观，但是图例位置有些不符合我的要求，我希望图例 (legend) 在左边，所以去看了看 pheatmap 函数具体参数，然而只有 legend、legend_breaks、legend_labels 几项是关于图例的，并没有 legend_position 类似参数。最后，终于在看完几个大神的博客之后，发现怎么调整图例位置了，具体操作如下：

参考

https://zhuanlan.zhihu.com/p/430153581 （R 数据可视化 —— gtable 介绍）
https://zhuanlan.zhihu.com/p/430448222 （R 数据可视化 —— 用 gtable 绘制多个 Y 轴）
https://qa.1r1g.com/sf/ask/2579647101/ （R - 使用Pheatmap时的图例标题或单位）

第一步：加载安装包

library(psych)
library(pheatmap)

第二步：导入数据集

mtcars          # R自带数据集

第三步：构建相关关系矩阵

data_corr <- corr.test(mtcars, method="pearson", adjust="none")
data_r <- data_corr$r        # 相关系数
data_p <- data_corr$p        # p值

第四步：绘制标注有显著性的热图

getSig <- function(dc) {
  sc <- ''
  if (dc < 0.001) sc <- '***'
  else if (dc < 0.01) sc <- '**'
  else if (dc < 0.05) sc <- '*'
  sc
}   

sig_mat <- matrix(sapply(data_p, getSig), nrow=nrow(data_p))
heatmap_pic_new <- pheatmap(data_r,cellwidth = 45,cellheight = 30, 
                            cluster_row = F,cluster_col = F,angle_col=0, 
                            display_numbers=sig_mat, fontsize_number=15)

第五步：调整图例位置（今日主角）

由于 pheatmap 函数未提供图例位置相关参数，所以此时我们只能想办法调整整个图片的布局，而这就需要 gtable 包和 grid 包来实现。

引用

gtable 是基于 grid 包的布局引擎，可以用来抽象化地创建网格视图，每个网格内都可以放置不同的图形对象，同时还能完美兼容 ggplot2 图形。

# 加载安装包
library(ggplot2)
library(gtable)
library(grid)

# 查看布局
p <- heatmap_pic_new           #为下一步方便，将热图重命名为 p
p$gtable                       #布局

在这里插入图片描述
可见，我们的热图是5行6列的布局，由4个图形对象构成，分别是可视化矩阵、列名称、行名称和图例。以及每个图形对象的顺序（z）、位置（cells）、名称（name）和图形属性（grob）也一并被列出。

#绘制布局图
gtable_show_layout(p$gtable)

在这里插入图片描述
布局图与 p$gtable 一致，可以看见每个图形对象的位置，以及宽度、高度。

# 命名图形对象
plot_grob <- p$gtable$grob[[1]]
xlab_grob <- p$gtable$grob[[2]]  
ylab_grob <- p$gtable$grob[[3]]  
legend_grob <- p$gtable$grob[[4]] 

#查看高度和宽度
p$gtable$heights
p$gtable$widths

在这里插入图片描述
因为热图的原始布局是5行6列，因此对应5个行高，6个列宽。

现在，我们已经知道热图的一些原始布局信息了，如行高列宽、每个图形对象的位置等等。再回到一开始的需求，把图例放到左边，这就意味着4个图形对象的位置需要左右移动，图例（legend_grob）要向左移到可视化矩阵的位置，可视化矩阵（plot_grob）、列名称（xlab_grob）、行名称（ylab_grob）要向右移动。这也就要求，列宽需要在原始布局的列宽基础上，进行相应的调整，图例的列宽放到可视化矩阵前面，可视化矩阵及其他图形列宽按顺序后移，行高不变。

# 新的布局
my_new_gt <- gtable(widths =  unit.c(unit(5,"bigpts"),
                                     unit(0,"bigpts"),
                                     max(unit(1.1,"grobwidth",legend_grob),unit(12,"bigpts")+1.2*unit(1.1,"grobwidth",legend_grob)) + unit(1,"inches") ,
                                     unit(495,"bigpts"),
                                     unit(1,"grobwidth",ylab_grob) + unit(10,"bigpts"),
                                     unit(0,"bigpts")
),
height = unit.c(unit(0,"npc"),
                unit(5,"bigpts"),
                unit(0,"bigpts"),
                unit(330,"bigpts"),
                unit(1,"grobheight",xlab_grob) + unit(10,"bigpts")     
))

# 将4个图形对象添加到新的布局当中
gtable <- gtable_add_grob(my_new_gt,legend_grob,t=3,l=3,b=5,r=3)
gtable <- gtable_add_grob(gtable,xlab_grob,5,4)
gtable <- gtable_add_grob(gtable,ylab_grob,4,5)
gtable <- gtable_add_grob(gtable,plot_grob,4,4)

到此，我们已经实现图例位置的调整了，效果如下：
在这里插入图片描述
然而，又出现了个问题，我们图例的文字部分显示不全，所以图例位置还得往下移动一小节。（对这个children，个人理解是一种子级的概念，如这个图例（legend_grob），由2个子级构成，一部分是图棒，另一部分是旁边的文字说明，所以向下移动意味着这两个子级的y轴都要向下移动）

legend_grob$children
legend_grob$children[[1]]$y <- legend_grob$children[[1]]$y - unit(0.05,"inches")
legend_grob$children[[2]]$y <- legend_grob$children[[2]]$y - unit(0.05,"inches")

到此为止，我们大功告成，请看最终效果：
在这里插入图片描述
全部代码：

# 加载安装包
library(psych)
library(pheatmap)
library(ggplot2)
library(gtable)
library(grid)

# 导入R自带数据集
mtcars

# 构建相关关系矩阵
data_corr <- corr.test(mtcars, method="pearson", adjust="none")
data_r <- data_corr$r     # 相关系数
data_p <- data_corr$p     # p值

# 绘制标注有显著性的热图
getSig <- function(dc) {
  sc <- ''
  if (dc < 0.001) sc <- '***'
  else if (dc < 0.01) sc <- '**'
  else if (dc < 0.05) sc <- '*'
  sc
}   

sig_mat <- matrix(sapply(data_p, getSig), nrow=nrow(data_p))
heatmap_pic_new <- pheatmap(data_r,cellwidth = 45,cellheight = 30, 
                            cluster_row = F,cluster_col = F,angle_col=0, 
                            display_numbers=sig_mat, fontsize_number=15)

# 调整图例位置
p <- heatmap_pic_new

p$gtable       #查看布局
gtable_show_layout(p$gtable)   #绘制布局图

plot_grob <- p$gtable$grob[[1]]
xlab_grob <- p$gtable$grob[[2]]  
ylab_grob <- p$gtable$grob[[3]]  
legend_grob <- p$gtable$grob[[4]] 

legend_grob$children
legend_grob$children[[1]]$y <- legend_grob$children[[1]]$y - unit(0.05,"inches")
legend_grob$children[[2]]$y <- legend_grob$children[[2]]$y - unit(0.05,"inches")

p$gtable$heights
p$gtable$widths

my_new_gt <- gtable(widths =  unit.c(unit(5,"bigpts"),
                                     unit(0,"bigpts"),
                                     max(unit(1.1,"grobwidth",legend_grob),unit(12,"bigpts")+1.2*unit(1.1,"grobwidth",legend_grob)) + unit(1,"inches") ,
                                     unit(495,"bigpts"),
                                     unit(1,"grobwidth",ylab_grob) + unit(10,"bigpts"),
                                     unit(0,"bigpts")
),
height = unit.c(unit(0,"npc"),
                unit(5,"bigpts"),
                unit(0,"bigpts"),
                unit(330,"bigpts"),
                unit(1,"grobheight",xlab_grob) + unit(10,"bigpts")     
))

gtable <- gtable_add_grob(my_new_gt,legend_grob,t=3,l=3,b=5,r=3)
gtable <- gtable_add_grob(gtable,xlab_grob,5,4)
gtable <- gtable_add_grob(gtable,ylab_grob,4,5)
gtable <- gtable_add_grob(gtable,plot_grob,4,4)

png(filename = 'C:/Users/w/Desktop/mtcars_legend_1.png',width = 2500,height = 2000,res = 300)
grid.draw(gtable)
dev.off()