前言

上一節(jié)所介紹的繪制多個(gè) Y 軸，只能在圖形的右側(cè)依次添加 Y 軸。

在 Y 軸數(shù)量過(guò)多的情況下（當(dāng)然，軸不應(yīng)該太多），將軸平均地放置在左右兩側(cè)會(huì)更美觀些。

因此，這節(jié)主要介紹如何在圖形的左側(cè)添加 Y 軸

添加 Y 軸

總的來(lái)說(shuō)，將 Y 軸添加到左側(cè)會(huì)更簡(jiǎn)單，不需要對(duì)坐標(biāo)軸、刻度標(biāo)簽及軸標(biāo)簽進(jìn)行轉(zhuǎn)換。主要獲取到軸對(duì)象及軸標(biāo)簽對(duì)象，將其添加到左側(cè)即可。

對(duì)于下面兩張圖

colors <- c('#5470C6', '#91CC75', '#EE6666', '#ff7f00')
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)
)

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(
        axis.text.y = element_text(color = colors[1]), 
        axis.ticks.y = element_line(color = colors[1]), 
        axis.title.y = element_text(color = colors[1]), 
        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)
  )
p1

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( 
        axis.text.y = element_text(color = colors[2]), 
        axis.ticks.y = element_line(color = colors[2]), 
        axis.title.y = element_text(color = colors[2]), 
        axis.line.y = element_line(color = colors[2]), 
        axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1)
  )
p2

獲取 gtable 對(duì)象

my_theme <- theme(panel.grid = element_blank(), panel.background = element_rect(fill = NA))

g1 <- ggplotGrob(p1 + my_theme)
g2 <- ggplotGrob(p2 + my_theme)

合并主繪圖區(qū)域的代碼是一樣的

pos <- c(subset(g1$layout, name == "panel", select = t:r))

g1 <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name == "panel")]], 
                      pos$t, pos$l, pos$b, pos$l)
plot(g1)

獲取 Y 軸及 Y 軸標(biāo)簽的位置信息

index <- which(g2$layout$name == "axis-l")
yaxis <- g2$grobs[[index]]

pos <- c(subset(g1$layout, name == "ylab-l", select = t:r))

首先，添加一個(gè) 3mm 的空白間距。注意是在軸標(biāo)簽位置的左側(cè)添加是（pos$l - 1）

g <- gtable_add_cols(g1, unit(3, "mm"), pos$l - 1)

然后將 Y 軸添加到一個(gè)新的列

g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], pos$l - 1)
g <- gtable_add_grob(g, yaxis, pos$t, pos$l, pos$b, pos$l, clip = "off")
plot(g)

添加軸標(biāo)簽也是類似的

index <- which(g2$layout$name == "ylab-l")
ylab <- g2$grobs[[index]]
g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], pos$l - 1)
g <- gtable_add_grob(g, ylab, pos$t, pos$l, pos$b, pos$l, clip = "off")

這樣就可以啦。

我們可以將上次的代碼改寫，使其可以根據(jù)傳入圖形的數(shù)量來(lái)決定軸的添加位置。改寫的代碼如下

library(ggplot2)
library(gtable)
library(grid)


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]
  
  # 修改對(duì)齊
  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
}

左側(cè)添加軸
add_yaxis_left <- function(g1, g2) {
  # 添加軸
  pos <- c(subset(g1$layout, name == "ylab-l", select = t:r))
  index <- which(g2$layout$name == "axis-l")
  yaxis <- g2$grobs[[index]]
  g <- gtable_add_cols(g1, unit(3, "mm"), pos$l - 1)
  g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], pos$l - 1)
  g <- gtable_add_grob(g, yaxis, pos$t, pos$l, pos$b, pos$l, clip = "off")
  # 添加軸標(biāo)簽
  # pos <- c(subset(g1$layout, name == "ylab-l", select = t:r))
  index <- which(g2$layout$name == "ylab-l")
  ylab <- g2$grobs[[index]]
  g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], pos$l - 1)
  g <- gtable_add_grob(g, ylab, pos$t, pos$l, pos$b, pos$l, clip = "off")
  g
}
# 右側(cè)添加軸
add_yaxis_right <- function(g1, g2, pos) {
  # ============ 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(g1, 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 軸線移動(dòng)到最左邊
  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)
  # 移動(dòng)刻度線
  ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, "npc") + unit(3, "pt")
  # 刻度標(biāo)簽位置轉(zhuǎn)換和對(duì)齊
  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
}

add_yaxis <- function(g1, g2, offset = 0) {
  # ============ 1. 主繪圖區(qū) ============ #
  # 獲取主繪圖區(qū)域
  pos <- c(subset(g1$layout, name == "panel", select = t:r))
  # 添加圖形
  g1 <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name == "panel")]], 
                       pos$t, pos$l, pos$b * ((offset - 2) * 0.00001 + 1), pos$l)
  if (offset > 3 && offset %% 2 == 0) {
    g1 <- add_yaxis_left(g1, g2)
  } else {
    g1 <- add_yaxis_right(g1, g2, pos)
  }
  g1
}

# 接受可變參數(shù)，可添加多個(gè) Y 軸
plot_multi_yaxis <- function(..., right_label_reverse = TRUE) {
  args <- list(...)
  my_theme <- theme(panel.grid = element_blank(), panel.background = element_rect(fill = NA))
  len <- length(args)
  args[[1]] <- args[[1]] + my_theme
  g <- ggplotGrob(args[[1]])
  for (i in len:2) { 
    if (i < 4 || i %% 2 && right_label_reverse) {
      # 為軸標(biāo)簽添加旋轉(zhuǎn)
      args[[i]] <- args[[i]] + 
        theme(axis.title.y = element_text(angle = 270))
    }
    args[[i]] <- args[[i]] + my_theme
    # 獲取 gtable 對(duì)象
    g2 <- ggplotGrob(args[[i]])
    g <- add_yaxis(g, g2, offset = i)
  }
  # 繪制圖形
  grid.newpage()
  grid.draw(g)
}

GitHub 代碼也更新為該版本：
https://github.com/dxsbiocc/learn/blob/main/R/plot/plot_multi_yaxis.R

測(cè)試效果

先添加第三張圖

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(
        axis.text.y = element_text(color = colors[3]), 
        axis.ticks.y = element_line(color = colors[3]), 
        axis.title.y = element_text(color = colors[3]), 
        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)

再添加第四張圖

library(dplyr)

set.seed(100)

p4 <- mutate(data, Temperature = rev(Temperature) + rnorm(12)) %>%
  ggplot(aes(category, Temperature, group = 1)) + 
  geom_line(colour = colors[4]) + 
  geom_point(aes(colour = colors[4]), 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(
    axis.text.y = element_text(color = colors[4]), 
    axis.ticks.y = element_line(color = colors[4]), 
    axis.title.y = element_text(color = colors[4]), 
    axis.line.y = element_line(color = colors[4]), 
    axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1)
  )

合并四張圖

plot_multi_yaxis(p1, p2, p3, p4)

再添加兩張，當(dāng)然這樣做是沒什么道理的。只是為了說(shuō)明函數(shù)依然能夠完美工作

plot_multi_yaxis(p1, p2, p3, p4, p1, p2)