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

前言

上一期用 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                       #布局

R语言pheatmap包热图legend位置调整
可见,我们的热图是5行6列的布局,由4个图形对象构成,分别是可视化矩阵、列名称、行名称和图例。以及每个图形对象的顺序(z)、位置(cells)、名称(name)和图形属性(grob)也一并被列出。

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

R语言pheatmap包热图legend位置调整
布局图与 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

R语言pheatmap包热图legend位置调整
因为热图的原始布局是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)

到此,我们已经实现图例位置的调整了,效果如下:
R语言pheatmap包热图legend位置调整
然而,又出现了个问题,我们图例的文字部分显示不全,所以图例位置还得往下移动一小节。(对这个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")

到此为止,我们大功告成,请看最终效果:
R语言pheatmap包热图legend位置调整
全部代码:

# 加载安装包
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()

共计人评分,平均

到目前为止还没有投票!成为第一位评论此文章。

(0)
社会演员多的头像社会演员多普通用户
上一篇 2023年3月11日
下一篇 2023年3月11日

相关推荐