前言
上一期用 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()