拼图

几种R语言拼图方式

Posted by CHY on July 9, 2020

如何拼出高质量的图片,也是科研工作中必不可少的技能,故在此记录几种在 R 语言中可以用到的拼图方式。
个人推荐第二种 patchwork 包的使用。

cowplot 包拼图

cowplot 包本身是用来设置图形颜色的,但也可以进行图片的拼接。

require(cowplot)
theme_set(theme_cowplot(font_size=12)) # reduce default font size
plot.mpg <- ggplot(mpg, aes(x = cty, y = hwy, colour = factor(cyl))) +
  geom_point(size=2.5)
plot.diamonds <- ggplot(diamonds, aes(clarity, fill = cut)) + geom_bar() +
  theme(axis.text.x = element_text(angle=70, vjust=0.5))
plot_grid(plot.mpg, plot.diamonds, labels = c('A', 'B'))  # 合并操作

# labels="AUTO"或labels="auto",标签会自动按照大写或小写排列
plot_grid(plot.mpg, plot.diamonds, labels = "AUTO")

# 对齐操作
plot_grid(plot.mpg, plot.diamonds, labels = "AUTO", align = 'h')
plot_grid(plot.mpg, plot.diamonds, labels = "AUTO", ncol = 1, align = 'v')

# 更复杂的对齐操作
plot.iris <- ggplot(iris, aes(Sepal.Length, Sepal.Width)) +
  geom_point() + facet_grid(. ~ Species) + stat_smooth(method = "lm") +
  background_grid(major = 'y', minor = "none") + # add thin horizontal lines
  panel_border() # and a border around each panel
plot_grid(plot.iris, plot.mpg, labels = "AUTO", ncol = 1,
          align = 'v', axis = 'l') # aligning vertically along the left axis

# 函数plot_grid()可以处理几种不同的图形类型,包括ggplot类,gtable以及基本图形等。

# 图形精细化调节
# label_szie调节标签大小
plot_grid(plot.mpg, plot.diamonds, labels = "AUTO", align = 'h', label_size = 12)

# 调节标签字体、颜色
plot_grid(plot.mpg, plot.diamonds, labels = "AUTO", align = 'h', label_fontfamily = "serif",label_fontface = "plain", label_colour = "blue")

# label_x和label_y参数可以移动标签, 另外可以通过hjust和vjust参数进行矫正
plot_grid(plot.mpg, plot.diamonds, labels = "AUTO", align = 'h', label_size = 12, label_x = 0, label_y = 0, hjust = -0.5, vjust = -0.5 )

# 调节行列的相对高度和宽度
plot_grid(plot.mpg, plot.diamonds, labels = "AUTO", align = 'h', rel_widths = c(1, 1.3))

# 嵌套
bottom_row <- plot_grid(plot.mpg, plot.diamonds, labels = c('B', 'C'), align = 'h', rel_widths = c(1, 1.3))
plot_grid(plot.iris, bottom_row, labels = c('A', ''), ncol = 1, rel_heights = c(1, 1.2))

patchwork 包拼图

devtools::install_github("thomasp85/patchwork")
p_load(patchwork) # 加载包
library(ggplot2)
library(patchwork)
p1 <- ggplot(mtcars) + geom_point(aes(mpg, disp))
p2 <- ggplot(mtcars) + geom_boxplot(aes(gear, disp, group = gear))
p1 + p2   # 使用+号即可
# 不创建对象直接添加
ggplot(mtcars) +
  geom_point(aes(mpg, disp)) +
  ggplot(mtcars) +
  geom_boxplot(aes(gear, disp, group = gear))
# 布局函数plot_layout对拼接细节指定
p1 + p2 + plot_layout(ncol = 1, heights = c(3, 1))
# 图形间填充空白格
p1 + plot_spacer() + p2
# 增加花括号的使用进行嵌套可以布置更复杂的图形(也可以是括号)
p3 <- ggplot(mtcars) + geom_smooth(aes(disp, qsec))
p4 <- ggplot(mtcars) + geom_bar(aes(carb))

p4 + {
  p1 + {
    p2 +
      p3 +
      plot_layout(ncol = 1)
  }
} +
  plot_layout(ncol = 1)

# -操作符将左右两边的对象放在同一个嵌套层,而不是像+号把右边放入左边的嵌套层
p1 + p2 + p3 + plot_layout(ncol = 1)
p1 + p2 - p3 + plot_layout(ncol = 1)

# |与/操作符可以用来水平和垂直布局。
(p1 | p2 | p3) /  p4

# 修改图片 * 将操作应用到当前嵌套层
(p1 + (p2 + p3) + p4 + plot_layout(ncol = 1)) * theme_bw()

# 修改图片 & 用递归的方式应用到所有层面
p1 + (p2 + p3) + p4 + plot_layout(ncol = 1) & theme_bw()

ggplotify 包拼图

ggplotify 包是有著名的 Y 叔开发的,代码简单,功能强大,值得好好学习。

library("grid")
library("ggplotify")
# 图形转换为grob对象
p1 <- as.grob(~barplot(1:10))  # 简单绘制三个图形
p2 <- as.grob(expression(plot(rnorm(10))))
p3 <- as.grob(function() plot(sin))
library("vcd")
data(Titanic)
p4 <- as.grob(~mosaic(Titanic))
library("lattice")
data(mtcars)
p5 <- as.grob(densityplot(~mpg|cyl, data=mtcars))

# grid.draw绘图及pushViewport嵌入
grid.newpage()
grid.draw(p1)
vp = viewport(x=.35, y=.75, width=.35, height=.3)
pushViewport(vp)
grid.draw(p2)
upViewport()

# 也可以使用ggplot2
# grob对象转换为ggplot对象
library(ggplot2)
p1 <- as.ggplot(~barplot(1:10)) +
    annotate("text", x = .6, y = .5,
             label = "Hello Base Plot", size = 5,
             color = 'firebrick', angle=45)
p2 <- as.ggplot(expression(plot(rnorm(10))))
p3 <- as.ggplot(function() plot(sin))
p4 <- as.ggplot(~mosaic(Titanic))
p5 <- as.ggplot(densityplot(~mpg|cyl, data=mtcars))

# 图形排列
library(cowplot)
library(colorspace)
col <- rainbow_hcl(3)
names(col) <- unique(iris$Species)
color <- col[iris$Species]
p6 <- as.ggplot(~plot(iris$Sepal.Length, iris$Sepal.Width, col=color, pch=15))
p7 <- ggplot(iris, aes(Sepal.Length, Sepal.Width, color=Species)) +
    geom_point(shape=15) + scale_color_manual(values=col, name="")
legend <- get_legend(p7)
## also able to annotate base or other plots using ggplot2
library(ggimage)
p8 <- p6 + geom_subview(x=.7, y=.78, subview=legend)
p9 <- as.ggplot(~image(volcano))
plot_grid(p1, p2, p3, p4, p5, p6, p7, p8, p9, ncol=3, labels=LETTERS[1:9])

aplot 包

在 aplot 里,提供了 insert_top, insert_bottom, insert_left 和 insert_right 四个函数,以一个图为主图,然后在周围加注释图。

library(ggplot2)
library(aplot)
p <- ggplot(mtcars, aes(mpg, disp)) + geom_point()
p2 <- ggplot(mtcars, aes(mpg)) +
  geom_density(fill='steelblue', alpha=.5) +
  ggtree::theme_dendrogram()
p3 <- ggplot(mtcars, aes(x=1, y=disp)) +
  geom_boxplot(fill='firebrick', alpha=.5) +
  theme_void()
ap <- p %>%
  insert_top(p2, height=.3) %>%
  insert_right(p3, width=.1)
ggsave(filename="aplot.png", plot=ap)
# 针对树状图及聚类图的整合
library(ggtree)
set.seed(2020-03-27)
x <- rtree(10)
d <- data.frame(taxa=x$tip.label, value = abs(rnorm(10)))
p <- ggtree(x) + geom_tiplab(align = TRUE) + xlim(NA, 3)
library(ggstance)
p2 <- ggplot(d, aes(value, taxa)) + geom_colh() +
  scale_x_continuous(expand=c(0,0))
p2 %>% insert_left(p)
# 示例
library(readr)
library(tidyr)
library(dplyr)
library(ggplot2)
library(ggtree)

file <- system.file("extdata", "scRNA_dotplot_data.tsv.gz", package="aplot")
gene_cluster <- readr::read_tsv(file)

dot_plot <- gene_cluster %>%
  mutate(`% Expressing` = (cell_exp_ct/cell_ct) * 100) %>%
  filter(count > 0, `% Expressing` > 1) %>%
  ggplot(aes(x=cluster, y = Gene, color = count, size = `% Expressing`)) +
  geom_point() +
  cowplot::theme_cowplot() +
  theme(axis.line  = element_blank()) +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) +
  ylab(NULL) +
  theme(axis.ticks = element_blank()) +
  scale_color_gradientn(colours = viridis::viridis(20), limits = c(0,4), oob = scales::squish, name = 'log2 (count + 1)') +
  scale_y_discrete(position = "right")


mat <- gene_cluster %>%
  select(-cell_ct, -cell_exp_ct, -Group) %>%  # drop unused columns to faciliate widening
  pivot_wider(names_from = cluster, values_from = count) %>%
  data.frame() # make df as tibbles -> matrix annoying
row.names(mat) <- mat$Gene  # put gene in `row`
mat <- mat[,-1] #drop gene column as now in rows
clust <- hclust(dist(mat %>% as.matrix())) # hclust with distance matrix

ggtree_plot <- ggtree::ggtree(clust)

v_clust <- hclust(dist(mat %>% as.matrix() %>% t()))
ggtree_plot_col <- ggtree(v_clust) + layout_dendrogram()

labels= ggplot(gene_cluster, aes(cluster, y=1, fill=Group)) + geom_tile() +
  scale_fill_brewer(palette = 'Set1',name="Cell Type") +
  theme_void()

dot_plot %>%
  insert_left(ggtree_plot, width=.2) %>%
  insert_top(labels, height=.02) %>%
  insert_top(ggtree_plot_col, height=.1)

参考链接

ggplotify——连接各类 R 图形
ggplot2 拼图包 patchwork 推荐与使用
cowplot(四)图形排列
aplot 包:让你画出更复杂的图