前言
經(jīng)過前面一節(jié)的介紹娜氏，我們對 gtable 布局應(yīng)該有了較為清晰的認(rèn)識，下面讓我們來看看 ggplot 對象的布局
首先，使用 ggplot 創(chuàng)建一個(gè)圖形
p <- ggplot(mtcars, aes(mpg, disp)) + geom_point()
p
獲取 ggplot 圖形對象马澈，是一個(gè) gtable 對象
> g <- ggplotGrob(p)
> class(g)
[1] "gtable" "gTree" "grob" "gDesc"
查看對象
> g
TableGrob (12 x 9) "layout": 18 grobs
z cells name grob
1 0 ( 1-12, 1- 9) background rect[plot.background..rect.86]
2 5 ( 6- 6, 4- 4) spacer zeroGrob[NULL]
3 7 ( 7- 7, 4- 4) axis-l absoluteGrob[GRID.absoluteGrob.74]
4 3 ( 8- 8, 4- 4) spacer zeroGrob[NULL]
5 6 ( 6- 6, 5- 5) axis-t zeroGrob[NULL]
6 1 ( 7- 7, 5- 5) panel gTree[panel-1.gTree.66]
7 9 ( 8- 8, 5- 5) axis-b absoluteGrob[GRID.absoluteGrob.70]
8 4 ( 6- 6, 6- 6) spacer zeroGrob[NULL]
9 8 ( 7- 7, 6- 6) axis-r zeroGrob[NULL]
10 2 ( 8- 8, 6- 6) spacer zeroGrob[NULL]
11 10 ( 5- 5, 5- 5) xlab-t zeroGrob[NULL]
12 11 ( 9- 9, 5- 5) xlab-b titleGrob[axis.title.x.bottom..titleGrob.77]
13 12 ( 7- 7, 3- 3) ylab-l titleGrob[axis.title.y.left..titleGrob.80]
14 13 ( 7- 7, 7- 7) ylab-r zeroGrob[NULL]
15 14 ( 4- 4, 5- 5) subtitle zeroGrob[plot.subtitle..zeroGrob.82]
16 15 ( 3- 3, 5- 5) title zeroGrob[plot.title..zeroGrob.81]
17 16 (10-10, 5- 5) caption zeroGrob[plot.caption..zeroGrob.84]
18 17 ( 2- 2, 2- 2) tag zeroGrob[plot.tag..zeroGrob.83]
可以看到瓢省，每個(gè)位置所放置的對象及其名稱，共 18 個(gè)痊班。我們可以很容易地根據(jù)名稱來獲取對應(yīng)的圖形對象
主要包括主繪圖區(qū)域 panel勤婚，X 和 Y 軸及其對應(yīng)的軸標(biāo)簽，標(biāo)題涤伐，題注等
我們可以使用 gtable_show_layout 來展示整個(gè)布局
gtable_show_layout(g)
例如馒胆，(7,5) 對應(yīng)的就是名稱為 panel 的對象，(7,4) 對應(yīng)的就是左邊的 Y 軸凝果，(7,3) 對應(yīng)的就是左邊 Y 軸的標(biāo)簽祝迂。
現(xiàn)在，我們對 ggplot 對象布局已經(jīng)有了一定的了解器净，那我們要如何合并包含多個(gè)軸的圖形呢型雳？
合并圖形
首先，基于現(xiàn)在對 ggplot 的了解山害，我們應(yīng)該很容易地就能想到纠俭，通過 gtable 對象來獲取對應(yīng)位置的圖形對象，然后使用 gtable_add_grob 函數(shù)將某一個(gè)對象添加到指定 gtable 的位置中
然后浪慌，對于軸線冤荆，我們可以獲取一個(gè)圖形的 Y 軸對象，然后對軸標(biāo)簽和軸刻度線進(jìn)行一定的轉(zhuǎn)換权纤，讓其朝向右側(cè)
最后钓简，通過 gtable_add_cols 和 gtable_add_grob 將修改后的 Y 軸添加到圖形的右側(cè)
基于上面的構(gòu)想，讓我們先來看看如何組合兩張圖片
先構(gòu)造如下數(shù)據(jù)
colors <- c('#5470C6', '#91CC75', '#EE6666')
data <- data.frame(
category = factor(substr(month.name, 1, 3), levels = substr(month.name, 1, 3)),
Evaporation = c(2.0, 4.9, 7.0, 23.2, 25.6, 76.7, 135.6, 162.2, 32.6, 20.0, 6.4, 3.3),
Precipitation = c(2.6, 5.9, 9.0, 26.4, 28.7, 70.7, 175.6, 182.2, 48.7, 18.8, 6.0, 2.3),
Temperature = c(2.0, 2.2, 3.3, 4.5, 6.3, 10.2, 20.3, 23.4, 23.0, 16.5, 12.0, 6.2)
)
先繪制一年中蒸發(fā)量和降水量的直方圖
p1 <- ggplot(data, aes(category, Evaporation)) +
geom_col(fill = colors[1], width = 0.3, position = position_nudge(x = -0.2)) +
labs(x = "month", y = "Evaporation(ml)") +
scale_y_continuous(limits = c(0, 250), expand = c(0,0)) +
theme(panel.grid = element_blank(),
panel.background = element_rect(fill = NA),
axis.text.y = element_text(color = colors[1]),
axis.ticks.y = element_line(color = colors[1]),
axis.title.y = element_text(color = colors[1], angle = 270),
axis.line.y = element_line(color = colors[1]),
axis.line.x = element_line(color = "black"),
axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1)
)
p2 <- ggplot(data, aes(category, Precipitation)) +
geom_col(fill = colors[2], width = 0.3, position = position_nudge(x = 0.2)) +
labs(x = "month", y = "Precipitation(ml)") +
scale_y_continuous(limits = c(0, 250), expand = c(0,0)) +
theme(panel.grid = element_blank(),
panel.background = element_rect(fill = NA),
axis.text.y = element_text(color = colors[2]),
axis.ticks.y = element_line(color = colors[2]),
axis.title.y = element_text(color = colors[2], angle = 270),
axis.line.y = element_line(color = colors[2]),
axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1)
)
你可能注意到了，我們?yōu)橹狈綀D設(shè)置了不同的偏移，這是為了避免圖形合并時(shí)將原來的圖形覆蓋，還有一個(gè)重要的設(shè)置，就是要將背景填充色設(shè)置為 NA燎悍，否則也會覆蓋之前的圖形
然后先獲取 gtable 對象
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)
我們以第一幅圖為模板，其他圖像往里面添加汛骂，所以需要知道第一幅圖主繪圖區(qū)域的位置
pos <- c(subset(g1$layout, name == "panel", select = t:r))
獲取到位置之后崖飘，將第二幅圖的圖形對象添加進(jìn)去
g <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name == "panel")]],
pos$t, pos$l, pos$b, pos$l)
plot(g)
那現(xiàn)在要做的，就是將第二幅圖的 Y 軸添加進(jìn)去匹中。
這一步雖然可以使用 sec_axis 實(shí)現(xiàn)夏漱，但是這種方式提供的操作有限，三個(gè) Y 軸的情況也無法實(shí)現(xiàn)顶捷。
首先挂绰，獲取第二幅圖的左側(cè) Y 軸，名稱都是見名知意的 "axis-l"
index <- which(g2$layout$name == "axis-l")
yaxis <- g2$grobs[[index]]
Y 軸對象包含兩個(gè)子對象，第一個(gè)為軸線葵蒂，第二個(gè)為刻度
> yaxis$children
(polyline[GRID.polyline.2180], gtable[axis])
然后交播，將 Y 軸線移動到最左邊
yaxis$children[[1]]$x <- unit.c(unit(0, "npc"), unit(0, "npc"))
獲取刻度線和刻度標(biāo)簽的布局
> ticks <- yaxis$children[[2]]
> ticks
TableGrob (1 x 2) "axis": 2 grobs
z cells name grob
1 (1-1,1-1) axis polyline[GRID.polyline.2183]
1 2 (1-1,2-2) axis titleGrob[GRID.titleGrob.2182]
將刻度線和刻度標(biāo)簽的相對位置進(jìn)行交換
# 交換刻度線和刻度標(biāo)簽的相對位置
ticks$widths <- rev(ticks$widths)
ticks$grobs <- rev(ticks$grobs)
# 移動刻度線
ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, "npc") + unit(3, "pt")
文本標(biāo)簽的修改比較復(fù)雜，不僅要交換位置践付，還要修改文本的對齊方式秦士，在軸標(biāo)簽的設(shè)置中也可以用到，可以封裝成函數(shù)
# 水平交換文本標(biāo)簽
hinvert_title_grob <- function(grob){
# 交換寬度
widths <- grob$widths
grob$widths[1] <- widths[3]
grob$widths[3] <- widths[1]
grob$vp[[1]]$layout$widths[1] <- widths[3]
grob$vp[[1]]$layout$widths[3] <- widths[1]
# 修改對齊
grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust
grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust
grob$children[[1]]$x <- unit(1, "npc") - grob$children[[1]]$x
grob
}
之后永高，將所有的修改覆蓋原來的設(shè)置
ticks$grobs[[2]] <- hinvert_title_grob(ticks$grobs[[2]])
yaxis$children[[2]] <- ticks
最后隧土，將 Y 軸添加到圖形的右側(cè)
g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], pos$r)
g <- gtable_add_grob(g, yaxis, pos$t, pos$r + 1, pos$b, pos$r + 1, clip = "off", name = "axis-r")
plot(g)
軸已經(jīng)設(shè)置好了，就差軸標(biāo)簽了命爬，有了上面的經(jīng)驗(yàn)曹傀，可以很容易的做到這點(diǎn)
index <- which(g2$layout$name == "ylab-l")
ylab <- g2$grobs[[index]]
ylab <- hinvert_title_grob(ylab)
添加到右側(cè)
g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], pos$r)
g <- gtable_add_grob(g, ylab, pos$t, pos$r + 1, pos$b, pos$r + 1, clip = "off", name = "ylab-r")
plot(g)
誒？怎么軸標(biāo)簽在里面呢饲宛？回顧我們上面的代碼皆愉，發(fā)現(xiàn)原來我們插入的位置 pos 是第一幅圖的右側(cè)邊界，所以艇抠，我們只要交換一下插入的順序就可以了
交換之后亥啦，就得到了我們想要的結(jié)果了
將所有代碼封裝成函數(shù)，并使其能夠適用于多個(gè) Y 軸
hinvert_title_grob <- function(grob){
# 交換寬度
widths <- grob$widths
grob$widths[1] <- widths[3]
grob$widths[3] <- widths[1]
grob$vp[[1]]$layout$widths[1] <- widths[3]
grob$vp[[1]]$layout$widths[3] <- widths[1]
# 修改對齊
grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust
grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust
grob$children[[1]]$x <- unit(1, "npc") - grob$children[[1]]$x
grob
}
add_another_yaxis <- function(g1, g2, offset = 0) {
# ============ 1. 主繪圖區(qū) ============ #
# 獲取主繪圖區(qū)域
pos <- c(subset(g1$layout, name == "panel", select = t:r))
# 添加圖形
g <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name == "panel")]],
pos$t, pos$l, pos$b * ((offset - 2) * 0.00001 + 1), pos$l)
# ============ 2. 軸標(biāo)簽 ============ #
index <- which(g2$layout$name == "ylab-l")
ylab <- g2$grobs[[index]]
ylab <- hinvert_title_grob(ylab)
# 添加軸標(biāo)簽
g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], pos$r)
g <- gtable_add_grob(g, ylab, pos$t, pos$r + 1, pos$b, pos$r + 1, clip = "off", name = "ylab-r")
# ============ 3. 軸設(shè)置 ============ #
index <- which(g2$layout$name == "axis-l")
yaxis <- g2$grobs[[index]]
# 將 Y 軸線移動到最左邊
yaxis$children[[1]]$x <- unit.c(unit(0, "npc"), unit(0, "npc"))
# 交換刻度線和刻度標(biāo)簽
ticks <- yaxis$children[[2]]
ticks$widths <- rev(ticks$widths)
ticks$grobs <- rev(ticks$grobs)
# 移動刻度線
ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, "npc") + unit(3, "pt")
# 刻度標(biāo)簽位置轉(zhuǎn)換和對齊
ticks$grobs[[2]] <- hinvert_title_grob(ticks$grobs[[2]])
yaxis$children[[2]] <- ticks
# 添加軸练链，unit(3, "mm") 增加軸間距
g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l] + + unit(3, "mm"), pos$r)
g <- gtable_add_grob(g, yaxis, pos$t, pos$r + 1, pos$b, pos$r + 1, clip = "off", name = "axis-r")
g
}
# 接受可變參數(shù)翔脱，可添加多個(gè) Y 軸
plot_multi_yaxis <- function(..., right_label_reverse = TRUE) {
args <- list(...)
len <- length(args)
g <- ggplotGrob(args[[1]])
for (i in len:2) {
if (right_label_reverse) {
# 為軸標(biāo)簽添加旋轉(zhuǎn)
args[[i]] <- args[[i]] + theme(axis.title.y = element_text(angle = 270))
}
g2 <- ggplotGrob(args[[i]])
g <- add_another_yaxis(g, g2, offset = i)
}
# 繪制圖形
grid.newpage()
grid.draw(g)
}
以我的習(xí)慣來說，我可能更偏向于將右側(cè)的軸標(biāo)簽旋轉(zhuǎn) 270 度媒鼓，看起來更舒服些届吁，所以我添加了一個(gè) right_label_reverse 參數(shù)
現(xiàn)在，我們添加第三個(gè)圖形
p3 <- ggplot(data, aes(category, Temperature, group = 1)) +
geom_line(colour = colors[3]) +
geom_point(aes(colour = colors[3]), fill = "white", shape = 21, show.legend = FALSE) +
scale_y_continuous(limits = c(0, 25), expand = c(0,0)) +
labs(x = "month", y = expression(paste("Temperature (", degree, " C)"))) +
theme(panel.grid = element_blank(),
panel.background = element_rect(fill = NA),
axis.text.y = element_text(color = colors[3]),
axis.ticks.y = element_line(color = colors[3]),
axis.title.y = element_text(color = colors[3], angle = 270),
axis.line.y = element_line(color = colors[3]),
axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1)
)
合并
plot_multi_yaxis(p1, p2, p3)
OK绿鸣，畫完收工疚沐。
代碼已上傳：
https://github.com/dxsbiocc/learn/blob/main/R/plot/plot_multi_yaxis.R
