89-R可视化21-利用aplot拼图实现类似热图注释柱效果

北野茶缸子

发布于 2022-02-08 15:23:16

1.1K00

代码可运行

文章被收录于专栏：北野茶缸子的专栏北野茶缸子的专栏

运行总次数：0

代码可运行

Date : [[2022-01-03_Mon]]
Tags : #R/index/02 #R/R可视化 #R/R数据科学 #R/R包
参考：
- R中的图片注释神包aplot - 简书 (jianshu.com)[1]

前言

大家可能对这幅图并不陌生：

这其实就是pheatmap 画的非常简单的一张图。通过源代码我们可以发现它其实也是借助了grid 包操作。

但对于pheatmap 这种成熟函数来说，仅仅是提供参数进行调用的。

那么我们可否通过ggplot 而非grid 底层，实现类似的注释柱的绘制呢？

开始操作

这里主要是借助拼图方案。

在[[88-R可视化20-R的几种基于ggplot的拼图解决方案]] 中，我们刚刚介绍了aplot 这种天然适合注释图的解决方案。

这里来实际上手操作一下。

真的是非常的简单，我直接把全部代码贴给大家好了：

my_packages<- c("ggplot2", "data.table", "tidyverse", 
                "RColorBrewer", "paletteer","ggfittext",
                "aplot","patchwork")
tmp <- sapply(my_packages, function(x) library(x, character.only = T)); rm(tmp, my_packages)

my_data2 <- data.frame(
  counts = runif(10, -1, 10),
  id = 0:9,
  type = rep(c("a","b"), each = 5)
)

p1 <- ggplot() + geom_rect(data = my_data2,aes(xmin = -.5, xmax = 4.5,
                                               ymin = -Inf, ymax = Inf),fill = "blue", alpha=0.03) + 
  geom_rect(data = my_data2, aes(xmin = 4.5, xmax = 9.5,
                                 ymin = -Inf, ymax = Inf),fill = "red", alpha=0.03) + 
  geom_col(data = my_data2, aes(id, counts), fill = "red") + labs(x = NULL) +
  scale_x_continuous(breaks=seq(0,9,1), 
                     expand=c(0,0),
                     label = paste0("GSE", "00", 0:9)) + 
  scale_y_continuous(expand=c(0,0), limits = c(-2,10)) + 
  theme(axis.text.x = element_text(angle = 90, size = 12))
p2 <- ggplot(data = my_data2) + geom_tile(aes(id, 1, fill = type), alpha = 0.3) + 
  theme(panel.grid = element_blank(), 
        panel.background = element_blank(), axis.line = element_blank(), 
        axis.ticks = element_blank(), axis.text = element_blank(), 
        axis.title = element_blank(),
        legend.position = "none") + scale_fill_manual(values = c("blue", "red")) + 
  geom_text(x= 2, y=1, label="normal") + 
  geom_text(x = 7, y = 1, label = "tumor")
# wrap_plots(p1, p2, heights = c(11,1))
p1 %>% insert_bottom(p2, height = .1)

主要的技术要点就是，这个注释柱的theme 需要设置好，利用geom_tile 或geom_rect 绘制一个一等一的裸露的色块：

theme(panel.grid = element_blank(), 
        panel.background = element_blank(), axis.line = element_blank(), 
        axis.ticks = element_blank(), axis.text = element_blank(), 
        axis.title = element_blank(),
        legend.position = "none")

至于这个底下注释图上的文本效果，后面再分享给大家。

这时候可能有同学会问，我想拼接多个图，可不可以呢？当然没问题。

两种注释柱拼的模式

堆叠感

第一种是实现堆叠在一起的错觉：

其实这仅仅是一个注释柱：

> my_data3
   value  anno type3
1      0 anno1     a
2      1 anno1     b
3      2 anno1     a
4      3 anno1     c
5      4 anno1     c
6      5 anno1     c
7      6 anno1     c
8      7 anno1     b
9      8 anno1     c
10     9 anno1     a
11     0 anno2     b
12     1 anno2     b
13     2 anno2     c
14     3 anno2     a
15     4 anno2     c
16     5 anno2     a
17     6 anno2     c
18     7 anno2     a
19     8 anno2     c
20     9 anno2     b

其x 值重复了两次，实现了两种映射：

ggplot(data = my_data3) + geom_tile(aes(value, anno, fill = type3)) + 
  theme(panel.grid = element_blank(), 
        panel.background = element_blank(), axis.line = element_blank(), 
        axis.ticks = element_blank(), axis.text = element_blank(), 
        axis.title = element_blank())

此外，我们还可以实现标记不同注释图其含义的效果，即保留色块图的y轴文字：

p3 <- ggplot(data = my_data3) + geom_tile(aes(value, anno, fill = type3)) + 
  theme(panel.grid = element_blank(), 
        panel.background = element_blank(), axis.line = element_blank(), 
        axis.ticks = element_blank(), axis.text.x = element_blank(), 
        axis.title = element_blank()) + scale_y_discrete(position="right")

p1 %>% insert_bottom(p2, height = .1) %>% 
  insert_top(p3, height=.1)

这样的好处是，注释柱可以堆叠在一起，比较节约空间；但是，不同类型的色块柱的图例却会“缝合”在一起，产生misunderstanding。

不过，这个问题其实是可以通过调解legend 进行解决的，这里先挖个坑。

抽离感

其实也就是两层拼图了。

my_data2 <- data.frame(
  counts = runif(10, -1, 10),
  id = 0:9,
  type = rep(c("a","b"), each = 5),
  anno1 = rep("anno1", 10),
  anno2 = rep("anno2", 10),
  type2 = rep(c("a","b"), each = 5),
  type3 = sample(c("a","b","c"), 10, replace = T)
)

p4 <- ggplot(data = my_data2) + geom_tile(aes(id, anno1, fill = type2)) + 
  theme(panel.grid = element_blank(), 
        panel.background = element_blank(), axis.line = element_blank(), 
        axis.ticks = element_blank(), axis.text.x = element_blank(), 
        axis.title = element_blank()) + scale_y_discrete(position="right")
p5 <- ggplot(data = my_data2) + geom_tile(aes(id, anno2, fill = type3)) + 
  theme(panel.grid = element_blank(), 
        panel.background = element_blank(), axis.line = element_blank(), 
        axis.ticks = element_blank(), axis.text.x = element_blank(), 
        axis.title = element_blank()) + scale_y_discrete(position="right")

p1 %>% insert_bottom(p2, height = .1) %>% 
  insert_top(p4, height=.1) %>%
  insert_top(p5, height=.1)

不知道你们的感受如何，这种拉大的空隙，我看着还是挺不舒服的。

给注释图添加文本

其实就是借助[[66-R可视化10-自由的在ggplot上添加文本（柱状图加计数）]] 的geom_text 手动添加。

从我的代码不难看出：

p2 <- ggplot(data = my_data2) + geom_tile(aes(id, 1, fill = type), alpha = 0.3) + 
  theme(panel.grid = element_blank(), 
        panel.background = element_blank(), axis.line = element_blank(), 
        axis.ticks = element_blank(), axis.text = element_blank(), 
        axis.title = element_blank(),
        legend.position = "none") + scale_fill_manual(values = c("blue", "red")) + 
  geom_text(x= 2, y=1, label="normal") + 
  geom_text(x = 7, y = 1, label = "tumor")

这个设置过程其实还是蛮痛苦的，主要是我的主图是一张连续性数据，参见：[[87-R可视化19-利用其他图层映射自由的控制背景的颜色]]。因为你不得不手动设置text，才能让文本达到一个居中，且比较满意的位置。

> p1 %>% insert_bottom(p3, height = .1) 
错误: Discrete value supplied to continuous scale

因此从这里来看，aplot 的拼图，还需要考虑不同图层之间的类型关系，其使用复杂上，也比patchwork 要高一些了。

如果你并不在乎对齐，暴力的patchwork 其实也非常方便了：[[88-R可视化20-R的几种基于ggplot的拼图解决方案]]

只是这里存在一个硬伤：因为是两个独立的ggplot 对象，因此注释图中的背景主题存在被我们blank了，但是其还活在patchwork 的心中，就会造成消失了还没有完全消失的结果：

其实对于一般的图形来说，是可以直接借助label 参数，但是，这其中也有问题。

比如当我尝试给予不同于主图的映射时:

pp <- ggplot() + 
  geom_col(data = my_data5, aes(id, counts, fill = type)) + labs(x = NULL)
p3 <- ggplot(data = my_data5) + geom_tile(aes(fill = type, x = type, y = 1), alpha = 0.3) + 
  theme(panel.grid = element_blank(), 
        panel.background = element_blank(), axis.line = element_blank(), 
        axis.ticks = element_blank(), axis.text = element_blank(), 
        axis.title = element_blank(),
        legend.position = "none") + scale_fill_manual(values = c("blue", "red")) + 
  geom_text(aes(x = type, y = 1,label = type))
pp %>% aplot::insert_bottom(p3, height = .1)

我必须将geom_tile 与主图映射的x 对应相同列才能出图，否则会警告：

Warning messages:
1: Removed 10 rows containing missing values (geom_tile). 
2: Position guide is perpendicular to the intended axis. Did you mean to specify a different guide `position`?

而如果映射一致的话底下的文本又会显示多次了。

有没有更好的方法呢？

参考资料

[1]R中的图片注释神包aplot - 简书 (jianshu.com): https://www.jianshu.com/p/904166e52ea1

本文参与腾讯云自媒体同步曝光计划，分享自微信公众号。

原始发表：2022-01-17，如有侵权请联系 cloudcommunity@tencent.com 删除

编程算法

本文分享自北野茶缸子微信公众号，前往查看

如有侵权，请联系 cloudcommunity@tencent.com 删除。

本文参与腾讯云自媒体同步曝光计划，欢迎热爱写作的你一起参与！

编程算法

登录后参与评论

0 条评论

热度