具有两个不同比例的 Y 轴的绘图答案

【问题标题】：plot with two Y-axis of different scales具有两个不同比例的 Y 轴的绘图
【发布时间】：2021-06-15 18:34:48
【问题描述】：

我正在尝试在 R 中构建一个带有 2 个 Y 轴的图。在 Excel 中这是一项相当常规的任务，但在 R 中却是一次不错的冒险。

所以，这是我的数据集：

Date	Latvia	Lithuania	Poland	Russian Federation	Ukraine
2012	77.21	67.97	72.97	71.41	148.29
2013	75.40	65.62	72.83	71.03	149.45
2014	75.10	63.86	71.55	72.95	153.65
2015	68.77	59.54	65.86	71.61	162.92
2016	64.80	55.83	62.14	69.70	154.51
2017	63.81	54.14	60.80	70.29	153.99
2018	62.88	53.31	59.62	70.82	153.07
2019	62.36	51.94	58.12	71.18	150.26
2020	63.89	51.69	58.94	73.00	154.26
1Q2021	65.36	51.25	57.78	72.69	156.25

我需要建立一个有 5 行的图表：

一个 Y 轴上的拉脱维亚、立陶宛、波兰和俄罗斯的数据点，
乌克兰的数据点 - 另一个。

我使用以下部分代码来读取和准备图表的数据：

Excel 文件中的后端数据：

data_3.2 <- read.xlsx(
"BEO_charts.xlsx", 
sheet = 22,
rows = c(25:33),
cols = c(2:7),
colNames = FALSE,
skipEmptyRows = TRUE,
skipEmptyCols = TRUE,
detectDates = TRUE
)

colnames(data_3.2) <- c(
  "date",
  "Latvia",
  "Lithuania",
  "Poland",
  "RF",
  "Ukraine"
)

然后我为图表的一部分准备一个数据集，其中包含 4 个数据点作为主 Y 轴：

p3.2left <- 
  subset.data.frame(
  data_3.2, 
  select = c(
    "date",
    "Latvia",
    "Lithuania",
    "Poland",
    "RF")
  ) %>% 
  
  melt(
    id.vars = 'date', 
    variable.name = "GDP_var",
    value.name = "GDP_val",
    measure.vars = c(
      "Latvia",
      "Lithuania",
      "Poland",
      "RF")
    ) %>% 
  
  ggplot(
    aes (
      x = date, 
      y= GDP_val,
      group = GDP_var,
      colour = GDP_var
      )
    ) +
  scale_y_continuous(limits = c(50,80), breaks = seq(50,80,5), expand = c(0.025,0), position = "left")+
  #scale_x_date(date_breaks = )
  labs (x = "", y = "") +
  geom_line(size = 1)+ 
  scale_colour_manual (
    guide = "legend", 
    name = NULL,
    breaks = c(
      "Latvia",
      "Lithuania",
      "Poland",
      "RF"),
    labels = c(
      "Латвия (левая ось)", 
      "Литва (левая ось)",
      "Польша (левая ось)",
      "Россия (левая ось)"), 
    values = c(
      "#332288", 
      "#88CCEE",
      "#44AA99",
      "#117733"
      )) +
  theme(
    axis.text.x = element_text(angle = 90, vjust = .5, size = 5, colour = "black"),
    axis.text.y = element_text(size = 5, colour = "black"),
    panel.background = element_rect(fill = NA),
    panel.grid = element_blank(),
    axis.line.y = element_line(colour= "#ABABAB"),
    axis.ticks.length = unit(0,"cm"),
    axis.title.y = element_text(size = 5, angle = 90, colour = "black", margin = margin(t = 0, r = 0, b = 0, l = 0)),
    legend.position = "bottom",
    legend.direction = "vertical",
    legend.title = element_blank(),
    legend.spacing.x = unit(0,"cm"),
    legend.key = element_blank(),
    legend.key.height = unit(.5, "cm"),
    legend.text = element_text(size = 5),
    legend.background = element_rect(fill = "transparent", colour = NA),
    legend.box.margin = unit (c(-9,1,1,1), "mm"),
    plot.margin = unit (c(0,5,0,0), "mm")
    )

然后 - 对于辅助 Y 轴的数据点：

p3.2right <- 
  subset.data.frame(
  data_3.2, 
  select = c(
    "date",
    "Ukraine")
  ) %>%
  
  ggplot(
    aes (
      x = date, 
      y= Ukraine,
      colour = "#999933"
      )
    ) +
  scale_y_continuous(limits = c(145,165), breaks = seq(145,165,5), expand = c(0.025,0)) +
  scale_x_date(date_labels = "%Y", date_breaks = "1 year") +
  geom_line(size = 1)+ 
  scale_colour_identity (
    guide = "legend", 
    label = "Украина (правая ось)",
      ) +
  labs(x=NULL, y=NULL) +
  theme(
    axis.text.x = element_text(angle = 90, vjust = .5, size = 5, colour = "black"),
    axis.text.y = element_text(size = 5, colour = "black"),
    panel.background = element_rect(fill = NA),
    panel.grid = element_blank(),
    axis.line.y = element_line(colour= "#ABABAB"),
    axis.ticks.length = unit(0,"cm"),
    axis.title.y = element_text(size = 5, angle = 90, colour = "black", margin = margin(t = 0, r = 0, b = 0, l = 0)),
    legend.position = "bottom",
    legend.direction = "vertical",
    legend.title = element_blank(),
    legend.spacing.x = unit(0,"cm"),
    legend.key = element_blank(),
    legend.key.height = unit(.5, "cm"),
    legend.text = element_text(size = 5),
    legend.box.margin = unit (c(0,1,1,1), "mm"),
    plot.margin = unit (c(0,5,0,0), "mm")
    )

最后，我使用了之前运行良好（但由于某些原因现在停止运行）的代码来满足我的需要 - 在一张图表上放置 2 个图：

# extract gtable
g1 <- ggplot_gtable(ggplot_build(p3.2left))
g2 <- ggplot_gtable(ggplot_build(p3.2right))

# overlap the panel of 2nd plot on that of 1st plot
pp <- c(subset(g1$layout, name == "panel", se = t:r))
g <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name == "panel")]], pp$t,
                     pp$l, pp$b, pp$l)
# axis tweaks
ia <- which(g2$layout$name == "axis-r")
ga <- g2$grobs[[ia]]
ax <- ga$children[[2]]
ax$widths <- rev(ax$widths)
ax$grobs <- rev(ax$grobs)

g <- gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1)
g <- gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b)


#add legend to the code
leg1 <- g1$grobs[[which(g1$layout$name == "guide-box")]]
leg2 <- g2$grobs[[which(g2$layout$name == "guide-box")]]

leg = gtable:::cbind_gtable(leg1, leg2, "first")            
leg$widths[5:6] = unit(0, "cm")

g$grobs[[which(g$layout$name == "guide-box")]] <- 
  gtable:::cbind_gtable(leg1, leg2, "first")
grid.draw(g)

我在以下代码行中收到以下错误：

g <- gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b)

Error: grobs must either be a single grob or a list of grobs

我不擅长 R 的 'gtable' 包，希望能得到任何支持来纠正我的代码（或工作流程），以便最终构建此图表并提高我在 R 中的编程技能。

附：我在 Ubuntu 20.04.2 LTS 上使用 R（版本 1.4.1717）

【问题讨论】：

如果您需要构建一个 5 行图表，为什么要将两个图并排放置？

标签： r ggplot2 gtable

【解决方案1】：

您可以更长时间地旋转您的数据，并像这样使用facet_wrap。首先创建初始数据框：

## data
library(tidyverse)
df = rbind(c(2012,  77.21, 67.97,   72.97, 71.41,   148.29),
           c(2013,  75.40, 65.62,   72.83, 71.03,   149.45),
           c(2014,  75.10, 63.86,   71.55, 72.95,   153.65),
           c(2015,  68.77, 59.54,   65.86, 71.61,   162.92),
           c(2016,  64.80, 55.83,   62.14, 69.70,   154.51),
           c(2017,  63.81, 54.14,   60.80, 70.29,   153.99),
           c(2018,  62.88, 53.31,   59.62, 70.82,   153.07),
           c(2019,  62.36, 51.94,   58.12, 71.18,   150.26),
           c(2020,  63.89, 51.69,   58.94, 73.00,   154.26),
           c(2021,  65.36, 51.25,   57.78, 72.69,   156.25)) %>% 
  data.frame()
colnames(df) = c('Date', 'Latvia', 'Lithuania', 'Poland',   'Russian Federation',   'Ukraine')
df

这给出了一个看起来像这样的数据框

   Date Latvia Lithuania Poland Russian Federation Ukraine
1  2012  77.21     67.97  72.97              71.41  148.29
2  2013  75.40     65.62  72.83              71.03  149.45
3  2014  75.10     63.86  71.55              72.95  153.65
4  2015  68.77     59.54  65.86              71.61  162.92
5  2016  64.80     55.83  62.14              69.70  154.51
6  2017  63.81     54.14  60.80              70.29  153.99
7  2018  62.88     53.31  59.62              70.82  153.07
8  2019  62.36     51.94  58.12              71.18  150.26
9  2020  63.89     51.69  58.94              73.00  154.26
10 2021  65.36     51.25  57.78              72.69  156.25

然后把这个数据长格式

## Pivot longer
df.long = df %>% 
  pivot_longer(cols=-Date,
               names_to='Country', 
               values_to='value') 

## Create a column that is Ukraine or other
df.long = df.long %>%
  mutate(Category = ifelse(Country=='Ukraine', 'Ukraine', 'Other Countries'))
head(df.long)

这给了这个

A tibble: 6 x 4
   Date Country            value Category       
  <dbl> <chr>              <dbl> <chr>          
1  2012 Latvia              77.2 Other Countries
2  2012 Lithuania           68.0 Other Countries
3  2012 Poland              73.0 Other Countries
4  2012 Russian Federation  71.4 Other Countries
5  2012 Ukraine            148.  Ukraine        
6  2013 Latvia              75.4 Other Countries

现在使用 facet_wrap 绘制它，它为“Category”的每个值创建一个新窗口。使用scales = 'free_y' 指定您不希望 y 轴处于相同比例：

ggplot(df.long, aes(x=Date, y=value, group=Country, color=Country))+
  geom_line()+
  facet_wrap(~Category, nrow=1, scales='free_y')

这给出了这个情节

【讨论】：

先生们，我无话可说，只有情绪。你帮了我很多！感谢您的时间和努力。我也看到我对 R 的了解很原始，这让我认真思考如何改进它。但更重要的是，我解决问题的方法比你的复杂得多。你让我的代码看起来优雅而简单。为了更加精通 R 编码（即书籍、在线课程等），我必须请您进一步支持我应该如何/做什么。很高兴听到你的想法。再次感谢您！
不客气。很高兴我能帮上忙！一种潜在的资源是 R for Data Science r4ds.had.co.nz 一书。我还没有读过这本书，但我听说过它的好东西。
我想一个普遍的评论是，在使用 ggplot 的很多情况下，将数据转换为“长格式”的方法往往非常有用。

【解决方案2】：

如果您想要的只是乌克兰数据的辅助 y 轴，那么以下方法可能会解决问题。
为了使要点更清楚，我简化了代码并从绘图代码中删除了scale_color_manual 和theme。相反，我为颜色和自定义主题创建了一个变量。

诀窍是预先计算比例因子mult。

library(ggplot2)
library(dplyr)
library(tidyr)

mult <- max(data_3.2[[6]])/max(data_3.2[2:5])

data_3.2 %>%
  pivot_longer(-date) %>%
  ggplot(aes(date, color = name)) +
  geom_line(
    data = . %>% filter(name != "Ukraine"),
    aes(y = value),
    size = 1
  ) +
  geom_line(
    data = . %>% filter(name == "Ukraine"),
    aes(y = value/mult),
    size = 1
  ) +
  scale_y_continuous(
    limits = c(50, 80), 
    breaks = seq(50, 80, 5), 
    expand = c(0.025, 0),
    sec.axis = sec_axis(
      ~ . * mult, 
      name = "Ukraine",
      breaks = seq(70, 165, 5)
    )
  ) +
  labs(x = NULL, y = NULL) +
  scale_color_dkolkin +
  theme_dkolkin()

颜色

scale_color_dkolkin <- scale_colour_manual (
  guide = "legend", 
  name = NULL,
  breaks = c(
    "Latvia",
    "Lithuania",
    "Poland",
    "RF",
    "Ukraine"
  ),
  labels = c(
    "Латвия (левая ось)", 
    "Литва (левая ось)",
    "Польша (левая ось)",
    "Россия (левая ось)",
    "Украина (правая ось)"
  ), 
  values = c(
    "#332288", 
    "#88CCEE",
    "#44AA99",
    "#117733",
    "#999933"
  ))

自定义主题

theme_dkolkin <- function(){ 
  theme_bw() %+replace%    #replace elements we want to change
    theme(
      axis.text = element_text(size = 5, colour = "black"),
      axis.text.x = element_text(angle = 90, vjust = .5),
      axis.line.y = element_line(colour= "#ABABAB"),
      axis.title.y = element_text(size = 5, angle = 90, colour = "black", margin = margin(t = 0, r = 0, b = 0, l = 0)),
      axis.ticks.length = unit(0,"cm"),
      panel.background = element_rect(fill = NA),
      panel.grid = element_blank(),
      legend.position = "bottom",
      legend.direction = "vertical", 
      legend.title = element_blank(),
      legend.spacing.x = unit(0,"cm"),
      legend.key = element_blank(),
      legend.key.height = unit(.5, "cm"),
      legend.text = element_text(size = 5),
      legend.box.margin = unit (c(0,1,1,1), "mm"),
      plot.margin = unit (c(0,5,0,0), "mm")
    )
}

数据

data_3.2 <-
structure(list(date = 2012:2021, Latvia = c(77.21, 75.4, 75.1, 
68.77, 64.8, 63.81, 62.88, 62.36, 63.89, 65.36), Lithuania = c(67.97, 
65.62, 63.86, 59.54, 55.83, 54.14, 53.31, 51.94, 51.69, 51.25
), Poland = c(72.97, 72.83, 71.55, 65.86, 62.14, 60.8, 59.62, 
58.12, 58.94, 57.78), RF = c(71.41, 71.03, 72.95, 71.61, 69.7, 
70.29, 70.82, 71.18, 73, 72.69), Ukraine = c(148.29, 149.45, 
153.65, 162.92, 154.51, 153.99, 153.07, 150.26, 154.26, 156.25
)), class = "data.frame", row.names = c(NA, -10L))

【讨论】：

先生们，我没有言语，只有情绪。你帮了我很多！感谢您的时间和努力。我也看到我对 R 的了解很原始，这让我认真思考如何改进它。但更重要的是，我解决问题的方法比你的复杂得多。你让我的代码看起来优雅而简单。为了更加精通 R 编码（即书籍、在线课程等），我必须请您进一步支持我应该如何/做什么。很高兴听到你的想法。再次感谢您！
@dkolkin 谢谢！乐意效劳。至于更精通 R，请转到主要来源，CRAN。左下角有指向文档材料的链接，包括您可以免费下载的手册和书籍。