r - ggplot2 带有 2 个数据集的分组条形图
问题描述
我有 2 个要与分组条形图一起绘制的 data.frames。
第一个数据框是一个堆叠的条形图,有多种颜色,左侧有一个对应的轴。
第二个数据框是单个条形图,只有一种颜色,右侧有相应的轴。
下图说明了我的目标:
这是我的数据集和我失败的尝试:
library(ggplot2)
library(dplyr)
df1 <- structure(list(day = structure(c(1L, 1L, 1L, 1L), .Label = "2019-01-29", class = "factor"),
streckenabschn = c("something", "something", "something", "something"),
variable = c("a", "b", "c", "d"),
value = c(0, 0, 2, 8)),
row.names = c(NA, -4L), class = "data.frame")
df2 <- structure(list(day = structure(1:2, .Label = c("2015-12-25", "2019-01-29"), class = "factor"),
streckenabschn = c("something", "something"),
variable = c("x", "x"), value = c(0.6, 3.471875)),
row.names = 1:2, class = "data.frame")
cbPalette <- c('#3652a3', '#60a0df', '#b7dbff', '#dd0000', "gray")
legendLabels <- c("a", "b", "c", "d", "x")
ggplot() +
geom_bar(data = df1, aes(x=day, y=value, fill = variable),
stat = "identity", width=0.2) +
geom_bar(data = df2, aes(x=day, y=value, fill = variable),
stat = "identity", width=0.2, position = position_dodge(width=0.5)) +
scale_fill_manual(name="", values=cbPalette, labels=legendLabels) +
scale_y_continuous(sec.axis = sec_axis(~., name = "Axis 2")) +
guides(fill = guide_legend("Legend", nrow = 2, ncol=4, byrow = T)) +
theme(legend.position = "top") + ylab("Axis 1")
我的问题:
- 我怎样才能有 1 个堆叠的条形图,而另一个是“躲避”的?
- 由于无法使用转换公式,如何定义“轴 2”标签和中断以对应数据?
我做错了什么以及如何做对?
解决方案
您可以将两个数据集合并为一个,对 x 位置进行一些手动预处理,然后绘制:
library(dplyr)
w = 0.2
bind_rows(df1, df2, .id="src") %>%
mutate(x0 = as.integer(factor(day)),
dx = c(-w/2, w/2)[as.integer(factor(src))]) %>%
ggplot(aes(day, value)) +
geom_blank(aes(x = day, y = value)) + # useful to get correct labelling of axes
geom_bar(aes(x = x0 + dx, y = value, fill = variable),
stat = "identity", width = w) +
scale_fill_manual(name = "", values = cbPalette, labels = legendLabels) +
guides(fill = guide_legend(nrow = 2, ncol = 4, byrow = TRUE)) +
theme_light() + theme(legend.position = "top")
次轴
在 ggplot 中不鼓励使用辅助垂直轴,但如果您真的需要它,您可以指定自定义转换函数(线性重新缩放)并使用sec_axis
首先定义两个缩放函数:
# Functions scaling ticks and values for using secondary scale
# !! This is visually OK but lacks interpretability.
# Preferrable to use business-derived hardcoded ratio !!
# Helper function
get_max_height = function(df) {
df %>%
group_by(day) %>%
summarize(h = sum(value)) %>%
with(max(h))
}
ratio_1_2 = get_max_height(df1) / get_max_height(df2)
# from scale of df2 to scale of df1:
trans_values = function(v2) {
v2 * ratio_1_2
}
# from scale of df1 to scale of df2:
trans_ticks = function(v1) {
v1 / ratio_1_2
}
然后在数据框和图形轴中使用它们:
bind_rows(
df1 %>% mutate(day = as.character(day), y = value),
df2 %>% mutate(day = as.character(day), y = trans_values(value)),
.id="src"
) %>%
mutate(
x0 = as.integer(factor(day)),
dx = c(-w/2, w/2)[as.integer(factor(src))]
) %>%
ggplot() +
geom_blank(aes(day)) +
geom_bar(aes(x0 + dx, y, fill = variable),
stat = "identity", width = w) +
scale_y_continuous("Values 1", sec.axis = sec_axis(trans_ticks, "Values 2")) +
scale_fill_manual(name = "", values = cbPalette, labels = legendLabels) +
guides(fill = guide_legend(nrow = 2, ncol = 4, byrow = TRUE)) +
theme_light() + theme(legend.position = "top")
推荐阅读
- visual-studio - MSbuild命令行和Visual Studio在代码分析上的区别
- vba - 如何防止代码发生任何更改并能够同时查看它?(VBA)
- java - 使用 listView 和适配器显示对象
- node.js - 我的节点代码中不断出现此错误。DeprecationWarning:不推荐调用不带回调的异步函数
- node.js - 服务器重新启动后议程作业不运行
- adal - Azure AD 客户端凭据刷新访问令牌
- image - 使用 Microsoft Graph 从 Sharepoint 帖子中获取图像
- javascript - 如何在 string.match 中添加循环值?
- arduino - 尝试将代码上传到 NodeMcu 时出错,这将使我能够控制 LED 矩阵
- azure - PDI 缓慢加载到 Azure 数据库中