cowplot——让ggplot2更加强大

cowplot——让ggplot2更加强大

这篇博客是cowplot包的小品文的学习笔记。原文一共五篇,分别是:
Introduction to cowplot
Changing the axis positions
Plot annotations
Arranging plots in a grid
Shared legends

从这些标题中也可以看出cowplot对ggplot2的功能增强的几个方面:可以改变轴的位置了、可以在图表中添加注释了、可以更容易的排列图表了以及可以多图共用图例了!

cowplot入门

theme_cowplot()主题

R
1
2
3
4
5
library(cowplot)
(plot.mpg <- ggplot(mpg, aes(x = cty, y = hwy, colour = factor(cyl))) +
geom_point(size = 2.5) +
labs(title = "图:cowplot示例") +
theme_cowplot(font_size = 20, font_family = 'STSong'))

cowplot可以和save_plot()函数一起使用:

R
1
2
save_plot("20181111a2.png", plot.mpg,
base_aspect_ratio = 1.3)

默认情况下,cowplot会禁用所有的网格线,如果需要添加网格线,最简单的方法是使用background_grid():

R
1
2
plot.mpg + background_grid(major = "xy",
minor = "xy")

图形排列

cowplot可以很好实现复合图的制作:

R
1
2
3
(plot.diamonds <- ggplot(diamonds, aes(clarity, fill = cut)) + geom_bar() +
theme(axis.text.x = element_text(angle = 70, vjust = 0.5)) +
theme_cowplot(font_size = 20, font_family = "STSong"))

默认情况下,图会被按照原样放入网格中:

R
1
plot_grid(plot.mpg, plot.diamonds, labels = c("A", "B"))

如果需要轴对齐,可以:

R
1
plot_grid(plot.mpg, plot.diamonds, labels = c("A", "B"), align = "h")

还可以通过指定行数和列数或者两者来精确地操作布局:

R
1
2
plot_grid(plot.mpg, NULL, NULL,
plot.diamonds, labels = c("A", "B", "C", "D"))

R
1
2
3
plot_grid(plot.mpg, plot.diamonds,
labels = c("A", "B"),
nrow = 2, align = "v")

plot_grid()和save_plot()可以结合起来使用:

R
1
2
3
4
5
6
7
8
plot2by2 <- plot_grid(plot.mpg,
NULL, NULL,
plot.diamonds,
labels = c("A", "B", "C", "D"), ncol = 2)
save_plot("plot2by2.png", plot2by2,
ncol = 2,
nrow = 2,
base_aspect_ratio = 1.3)

显然,效果不好。

添加绘图注释

打草稿

R
1
2
3
ggdraw(plot.mpg) +
draw_plot_label("A", size = 14) +
draw_label("草稿", angle = 45, size = 80, alpha = 0.2, fontfamily = "STSong")

事实上ggdraw()生成的是一个标准的ggplot2对象。我们也可以使用geom绘制:

R
1
2
3
4
5
t <- (0:1000)/1000
spiral <- data.frame(x = 0.45 + 0.55*t*cos(t*15),
y = 0.55 - 0.55*t*sin(t*15), t)
ggdraw(plot.mpg) +
geom_path(data = spiral, aes(x = x, y = y, colour = t), size = 6, alpha = 0.4)

图层堆叠

到目前为止,我们绘制的图都是主图位于最底层,有时你希望把主图放在最上层。在这种情况下,你可以通过ggdraw()不带任何参数调用来初始化空绘图画布,然后调用放置绘图draw_plot(),注意比较下面两幅图的差异:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
boxes <- data.frame(
x = sample((0:33)/40, 40, replace = T),
y = sample((0:33)/40, 40, replace = T)
)
# 主图位于最上层
(plot.mpg <- ggplot(mpg, aes(x = cty, y = hwy, colour = factor(cyl))) +
geom_point(size = 2.5))
ggdraw() +
geom_rect(data = boxes, aes(
xmin = x,
xmax = x + 0.15,
ymin = y,
ymax = y + 0.15
), colour = "gray60", fill = "gray80") +
draw_plot(plot.mpg) +
draw_label("主图位于灰盒图层的上层",
fontface = "bold",
fontfamily = "STSongti-SC-Bold",
x = 0.95, y = 0.95,
vjust = 1, hjust = 1,
size = 15)

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
# 主图位于灰盒层的下方
ggdraw(plot.mpg) +
geom_rect(data = boxes, aes(
xmin = x,
xmax = x + 0.15,
ymin = y,
ymax = y + 0.15
), colour = "gray60", fill = "gray80") +
draw_label("主图位于灰盒图层的下层",
fontface = "bold",
fontfamily = "STSongti-SC-Bold",
x = 0.95, y = 0.95,
vjust = 1, hjust = 1,
size = 15)

draw_plot()还允许我们将图形以任意大小放置在画布的任意位置:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
library(viridis)
ggdraw() +
draw_plot(plot.diamonds +
theme(legend.justification = "bottom"),
x = 0,
y = 0,
width = 1,
height = 1) +
draw_plot(plot.mpg +
scale_color_viridis(discrete = T) +
theme(legend.justification = "top"), 0.5, 0.52, 0.5, 0.4) +
draw_plot_label(c("A", "B"),
x = c(0, 0.5),
y = c(1, 0.92),
size = 15)

添加图片

R
1
2
3
4
p <- ggplot(iris, aes(x = Sepal.Length, fill = Species)) + geom_density(alpha = 0.7)
ggdraw() +
draw_image("http://www.czxa.top/photowall/xiaoxiao/DSC00969.JPG") +
draw_plot(p)

R
1
2
p2 <- ggdraw() + draw_image("http://www.czxa.top/photowall/xiaoxiao/DSC00969.JPG")
plot_grid(p, p2, labels = "AUTO")

改变轴的位置

R
1
2
3
4
5
6
library(cowplot)
library(grid)
theme_set(theme_cowplot(font_size = 20, font_family = "STSong"))
(p1 <- ggplot(mtcars, aes(mpg, disp)) +
geom_line(colour = "blue"))
(p1 + scale_y_continuous(position = "right"))

还可以添加双坐标轴!

R
1
2
3
4
(p1 + scale_x_continuous(sec.axis = dup_axis()))

(p1 + scale_x_continuous(sec.axis = dup_axis()) +
scale_y_continuous(sec.axis = dup_axis()))

R
1
2
3
4
5
6
7
8
9
10
11
12
13
mtcars2 <- mtcars[1:15, ]
mtcars2$name <- row.names(mtcars2)
ggplot(mtcars2, aes(x = name,
y = mpg,
fill = name)) +
geom_bar(stat = "identity", position = "identity") +
scale_y_reverse() +
guides(fill = F) +
theme(axis.text.x.top = element_text(angle = 90,
vjust = 0.5,
hjust = 0)) +
scale_x_discrete(position = "top") +
scale_fill_viridis_d()

绘制注释

draw_label(): 使用相对位置

R
1
2
3
4
5
6
7
8
9
10
(c <-  cor.test(mtcars$mpg, mtcars$disp, method = 'sp'))
label <- substitute(paste("Spearman ",
rho,
" = ",
estimate,
", P = ",
pvalue),
list(estimate = signif(c$estimate, 2),
pvalue = signif(c$p.value, 2)))
ggdraw(p1) + draw_label(label, 0.7, 0.9, fontfamily = 'STSong')

draw_label(): 使用绝对位置

R
1
p1 + draw_label(label, 20, 400, hjust = 0, vjust = 0)

使用Tex公式

R
1
2
library(latex2exp)
ggdraw(p1) + draw_label(TeX('$\\Tex 公式测试: x^2 + y^2 = z^2$'), 0.7, 0.7, fontfamily = 'STSong')

为组合图添加标题

R
1
2
3
4
5
6
7
8
# 为组合图添加标题
p1 <- ggplot(mtcars, aes(x=disp, y=mpg)) + geom_point(colour = "blue") + background_grid(minor='none')
p2 <- ggplot(mtcars, aes(x=hp, y=mpg)) + geom_point(colour = "green") + background_grid(minor='none')

p <- plot_grid(p1, p2, labels = c('A', 'B'))
title <- ggdraw() +
draw_label("MPG declines with displacement and horsepower", fontfamily = 'STSong')
plot_grid(title, p, ncol = 1, rel_heights = c(0.1, 1))

图下注释

R
1
2
p2 <- add_sub(p1, "This is an annotation. \n Annotatian can be span multiple lines.", fontfamily = 'STSong')
ggdraw(p2)

使用latex公式

R
1
2
p3 <- add_sub(p2, TeX('$a^2 + b^2 = c^2$'), size = 15, fontfamily = 'STSong')
ggdraw(p3)

为分面图添加图下注释

R
1
2
3
4
5
6
7
8
9
10
11
12
13
plot.iris <- ggplot(iris,
aes(Sepal.Length, Sepal.Width)) +
geom_point() +
facet_grid(. ~ Species) +
stat_smooth(method = 'lm') +
background_grid(major = 'y', minor = 'none') +
panel_border()
ggdraw(plot.iris)
p2 <- add_sub(plot.iris, "Annotation underneath a faceted plot, left justified.", x = 0, hjust = 0, fontfamily = 'STSong')
ggdraw(p2)

p3 <- add_sub(plot.iris, "Annotation underneath a faceted plot, right justified.", x = 1, hjust = 1, fontfamily = 'STSong')
ggdraw(p3)

将图下注释移动图内

R
1
2
3
4
5
6
7
8
9
10
ggdraw(add_sub(
p1,
"Annotation inside plot",
vpadding = grid::unit(0, "lines"),
y = 8,
x = 0.03, hjust = 0,
fontfamily = 'STSong',
size = 20,
colour = "red"
))

在网格中排列图

plot_grid()的基础使用

R
1
2
3
4
5
6
7
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'))

网格标签

使用自动标签(大写):

R
1
plot_grid(plot.mpg, plot.diamonds, labels = 'AUTO')

使用自动标签(小写):

R
1
plot_grid(plot.mpg, plot.diamonds, labels = 'auto')

设定排列方向

R
1
plot_grid(plot.mpg, plot.diamonds, labels = 'AUTO', align = 'h')

R
1
2
plot_grid(plot.mpg, plot.diamonds, labels = 'AUTO',
ncol = 1, align = 'v')

纵向排列,沿右边(r)对齐

R
1
2
plot_grid(plot.iris, plot.mpg, labels = 'AUTO',
ncol = 1, align = 'v', axis = 'r')

支持多种绘图格式

基础图表:

R
1
2
3
4
5
6
7
8
par(
xpd = NA,
bg = "transparent", # 设置图片背景透明
oma = c(2, 2, 0, 0), # 将图移到右上方
mgp = c(2, 1, 0) # 将轴标签 靠近轴
)
plot(sqrt) # 绘制平方根函数
recordedplot <- recordPlot() # 返回上一幅图

绘制函数:

R
1
2
plotfunc <- function() image(volcano)
plotfunc()

grid绘制的图:

R
1
2
3
gcircle <- grid::circleGrob()
ggdraw(gcircle)
save_plot('20181013a1.png', ggdraw(gcircle))

接下来把这几幅图合并:

R
1
2
3
plot_grid(plot.mpg, recordedplot, plotfunc, gcircle,
labels = 'AUTO', hjust = 0, vjust = 1,
scale = c(1, 1, 0.9, 0.9))

还可以设定排列比例:

R
1
2
plot_grid(plot.mpg, plot.diamonds, labels = 'AUTO',
rel_widths = c(1, 1.5))

嵌入式图表网格

R
1
2
3
4
5
6
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))

R
1
2
3
4
5
6
7
8
9
plots <- align_plots(plot.mpg, plot.iris,
align = 'v',
axis = 'l')
bottom_row <- plot_grid(plots[[1]], plot.diamonds,
labels = c('B', ''),
align = 'h',
rel_widths = c(1, 1.3))
plot_grid(plots[[2]], bottom_row, labels = c('A', ''),
ncol = 1, rel_heights = c(1, 1.2))

共用图例

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
dsamp <- diamonds[sample(nrow(diamonds), 1000), ]
p1 <- qplot(carat, price, data=dsamp, colour=clarity) +
theme(plot.margin = unit(c(6,0,6,0), "pt"))
p2 <- qplot(depth, price, data=dsamp, colour=clarity) +
theme(plot.margin = unit(c(6,0,6,0), "pt")) + ylab("")
p3 <- qplot(color, price, data=dsamp, colour=clarity) +
theme(plot.margin = unit(c(6,0,6,0), "pt")) + ylab("")

(prow <- plot_grid(p1 + theme(legend.position = "none"),
p2 + theme(legend.position = "none"),
p3 + theme(legend.position = "none"),
align = 'vh',
labels = c('A', 'B', 'C'),
hjust = -1,
nrow = 1))

侧面图例

R
1
2
legend <- get_legend(p1)
(p <- plot_grid(prow, legend, rel_widths = c(3, 0.3)))

底部图例

R
1
2
legend_b <- get_legend(p1 + theme(legend.position = 'bottom'))
(p <- plot_grid(prow, legend_b, ncol = 1, rel_heights = c(1, .2)))

如果想把图例放在中间,可以这么做:

R
1
2
bottom_row <- plot_grid(ggplot(), legend_b, ggplot(), align = 'h', rel_widths = c(0.7, 1, 0.5))
(p <- plot_grid(prow, bottom_row, ncol = 1, rel_heights = c(1, .2)))

也就是把下面也放三个网格,legend放在中间即可。

图中图例

R
1
2
3
4
5
6
7
8
9
10
prow <- plot_grid(p1 + theme(legend.position = "none"),
p2 + theme(legend.position = "none"),
NULL,
p3 + theme(legend.position = "none"),
align = 'vh',
labels = c('A', 'B', '', 'C'),
hjust = -1,
nrow = 1,
rel_widths = c(1, 1, 0.3, 1))
prow + draw_grob(legend, 2/3.3, 0, 0.3/3, 1)

一个更加复杂的例子:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
p1 <- ggplot(iris, aes(Sepal.Length, Sepal.Width, color = Species)) +
geom_point() +
facet_grid(. ~ Species) + stat_smooth(method = "lm") +
background_grid(major = 'y', minor = 'none') +
panel_border() + theme(legend.position = 'none')

p2 <- ggplot(iris, aes(Sepal.Length, fill = Species)) +
geom_density(alpha = 0.7) +
theme(legend.justification = "top")
p2a <- p2 + theme(legend.position = 'none')

p3 <- ggplot(iris, aes(Sepal.Width, fill = Species)) +
geom_density(alpha = 0.7) +
theme(legend.position = 'none')
legend <- get_legend(p2)
plots <- align_plots(p1, p2a, p3, align = 'v', axis = 'l')

bottom_row <- plot_grid(plots[[2]], plots[[3]],
legend, labels = c('B', 'C'),
rel_widths = c(1, 1, 0.3), nrow = 1)
plot_grid(plots[[1]], bottom_row, labels = c('A'), ncol = 1) +
theme(plot.margin = unit(c(0.5, 0.5, 0.5, 0.5), "cm"))

# R

评论

程振兴

程振兴 @czxa.top
截止今天,我已经在本博客上写了604.4k个字了!

Your browser is out-of-date!

Update your browser to view this website correctly. Update my browser now

×