R 数据可视化 —— 绘制多个 Y 轴(补充)

前言

上一节所介绍的绘制多个 Y 轴,只能在图形的右侧依次添加 Y 轴。

Y 轴数量过多的情况下(当然,轴不应该太多),将轴平均地放置在左右两侧会更美观些。

因此,这节主要介绍如何在图形的左侧添加 Y

添加 Y 轴

总的来说,将 Y 轴添加到左侧会更简单,不需要对坐标轴、刻度标签及轴标签进行转换。主要获取到轴对象及轴标签对象,将其添加到左侧即可。

对于下面两张图

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 对象

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

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

合并主绘图区域的代码是一样的

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 轴标签的位置信息

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

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

首先,添加一个 3mm 的空白间距。注意是在轴标签位置的左侧添加是(pos$l - 1

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

然后将 Y 轴添加到一个新的列

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)

添加轴标签也是类似的

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")

这样就可以啦。

我们可以将上次的代码改写,使其可以根据传入图形的数量来决定轴的添加位置。改写的代码如下

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]
  
  # 修改对齐
  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_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")
  # 添加轴标签
  # 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
}
# 右侧添加轴
add_yaxis_right <- function(g1, g2, pos) {
  # ============ 2. 轴标签 ============ #
  index <- which(g2$layout$name == "ylab-l")
  ylab <- g2$grobs[[index]]
  ylab <- hinvert_title_grob(ylab)
  # 添加轴标签
  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. 轴设置 ============ #
  index <- which(g2$layout$name == "axis-l")
  yaxis <- g2$grobs[[index]]
  # 将 Y 轴线移动到最左边
  yaxis$children[[1]]$x <- unit.c(unit(0, "npc"), unit(0, "npc"))
  # 交换刻度线和刻度标签
  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")
  # 刻度标签位置转换和对齐
  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. 主绘图区 ============ #
  # 获取主绘图区域
  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
}

# 接受可变参数,可添加多个 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) {
      # 为轴标签添加旋转
      args[[i]] <- args[[i]] + 
        theme(axis.title.y = element_text(angle = 270))
    }
    args[[i]] <- args[[i]] + my_theme
    # 获取 gtable 对象
    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

测试效果

先添加第三张图

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)

再添加两张,当然这样做是没什么道理的。只是为了说明函数依然能够完美工作

plot_multi_yaxis(p1, p2, p3, p4, p1, p2)
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 203,271评论 5 476
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 85,275评论 2 380
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 150,151评论 0 336
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 54,550评论 1 273
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 63,553评论 5 365
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 48,559评论 1 281
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 37,924评论 3 395
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 36,580评论 0 257
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 40,826评论 1 297
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 35,578评论 2 320
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 37,661评论 1 329
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 33,363评论 4 318
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 38,940评论 3 307
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 29,926评论 0 19
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 31,156评论 1 259
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 42,872评论 2 349
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 42,391评论 2 342

推荐阅读更多精彩内容