ggplot2 带有 2 个数据集的分组条形图

Question

我有 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”标签和中断 对应数据，因为我不能使用转换公式？

我做错了什么以及如何做对？

Answer 1

您可以将两个数据集合二为一，对 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")