绘制两个不同比例的 Y 轴
我正在尝试用 2 个 Y 轴在 R 中构建一个图。在 Excel 中这是一项相当常规的任务，但在 R 中却是一个很好的冒险。
所以，这是我的数据集：
| 日期 | 拉脱维亚 | 立陶宛 | 波兰 | 俄罗斯联邦 | 乌克兰 |
|---|---|---|---|---|---|
| 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 |
| 2021 年第一季度 | 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"
)
- 然后，我为图表部分准备了一个数据集，其中主要 Y 轴有 4 个数据点：
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）
2 个答案:
答案 0 :(得分：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 绘制它，它为“类别”的每个值创建一个新窗口。使用 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')
这给出了这个情节
答案 1 :(得分：0)
如果您只需要乌克兰数据的辅助 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))
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？