时间戳

首页 > 解决方案 > 由线条连接的条形图/如何连接在 R / ggplot2 中使用 grid.arrange 排列的两个图形

r - 由线条连接的条形图/如何连接在 R / ggplot2 中使用 grid.arrange 排列的两个图形

问题描述

在 Facebook 研究中，我发现了这些漂亮的条形图，这些条形图由线条连接以指示排名变化： 脸书的解决方案

https://research.fb.com/do-jobs-run-in-families/

我想使用 ggplot2 创建它们。条形图部分很简单：

library(ggplot2)
library(ggpubr)
state1 <- data.frame(state=c(rep("ALABAMA",3), rep("CALIFORNIA",3)), 
                 value=c(61,94,27,10,30,77), 
                 type=rep(c("state","local","fed"),2),
                 cumSum=c(rep(182,3), rep(117,3)))
state2 <- data.frame(state=c(rep("ALABAMA",3), rep("CALIFORNIA",3)), 
                 value=c(10,30,7,61,94,27), 
                 type=rep(c("state","local","fed"),2),
                 cumSum=c(rep(117,3), rep(182,3)))
fill <- c("#40b8d0", "#b2d183", "#F9756D")

p1 <- ggplot(data = state1) +
  geom_bar(aes(x = reorder(state, value), y = value, fill = type), stat="identity") +
  theme_bw() + 
  scale_fill_manual(values=fill) + 
  labs(x="", y="Total budget in 1M$") +
  theme(legend.position="none", 
        legend.direction="horizontal", 
        legend.title = element_blank(),
        axis.line = element_line(size=1, colour = "black"),
        panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        panel.border = element_blank(), panel.background = element_blank()) +
  coord_flip() 

p2 <- ggplot(data = state2) +
  geom_bar(aes(x = reorder(state, value), y = value, fill = type), stat="identity") +
  theme_bw() + 
  scale_fill_manual(values=fill) + labs(x="", y="Total budget in 1M$") +
  theme(legend.position="none", 
        legend.direction="horizontal", 
        legend.title = element_blank(),
        axis.line = element_line(size=1, colour = "black"),
        panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        panel.border = element_blank(), 
        panel.background = element_blank()) +
  scale_x_discrete(position = "top") + 
  scale_y_reverse() +
  coord_flip()

p3 <- ggarrange(p1, p2, common.legend = TRUE, legend = "bottom")

但我无法想出解决线路部分的方法。当添加行时，例如到左侧

p3 + geom_segment(aes(x = rep(1:2, each=3), xend = rep(1:10, each=3), 
                   y = cumSum[order(cumSum)], yend=cumSum[order(cumSum)]+10), size = 1.2)

问题是这些线将无法跨越到右侧。它看起来像这样： 到目前为止我的版本

基本上，我想将左侧的“加利福尼亚”栏与右侧的凯福尼亚栏连接起来。

为此，我认为，我必须以某种方式访问​​图表的上级。我查看了视口，并能够用由 geom_segment 制成的图表覆盖两个条形图，但后来我无法找出线条的正确布局：

subplot <- ggplot(data = state1) + 
  geom_segment(aes(x = rep(1:2, each=3), xend = rep(1:2, each=3), 
                   y = cumSum[order(cumSum)], yend =cumSum[order(cumSum)]+10), 
               size = 1.2)

vp <- viewport(width = 1, height = 1, x = 1, y = unit(0.7, "lines"), 
               just ="right", "bottom"))
print(p3)
print(subplot, vp = vp)

非常感谢帮助或指针。

标签： rggplot2bar-chartdata-visualizationr-grid

解决方案

这是一个非常有趣的问题。我使用patchwork库对其进行了近似，它允许您将ggplots 添加在一起并为您提供一种控制其布局的简单方法——我更喜欢它而不是grid.arrange基于任何东西，并且在某些事情上它比cowplot.

我扩展数据集只是为了在两个数据框中获得更多值。

library(tidyverse)
library(patchwork)

set.seed(1017)

state1 <- data_frame(
  state = rep(state.name[1:5], each = 3),
  value = floor(runif(15, 1, 100)),
  type = rep(c("state", "local", "fed"), times = 5)
)

state2 <- data_frame(
  state = rep(state.name[1:5], each = 3),
  value = floor(runif(15, 1, 100)),
  type = rep(c("state", "local", "fed"), times = 5)
)

然后我制作了一个数据框，根据原始数据框中的其他值（state1 或 state2）为每个状态分配等级。

ranks <- bind_rows(
  state1 %>% mutate(position = 1),
  state2 %>% mutate(position = 2)
)  %>%
  group_by(position, state) %>%
  summarise(state_total = sum(value)) %>%
  mutate(rank = dense_rank(state_total)) %>%
  ungroup()

我制作了一个快速主题以保持最小化并删除轴标记：

theme_min <- function(...) theme_minimal(...) +
  theme(panel.grid = element_blank(), legend.position = "none", axis.title = element_blank())

凹凸图（中间）基于ranks数据框，没有标签。使用因子而不是数值变量来表示位置和排名让我可以更好地控制间距，并让排名与离散的 1 到 5 值对齐，以匹配条形图中的状态名称。

p_ranks <- ggplot(ranks, aes(x = as.factor(position), y = as.factor(rank), group = state)) +
  geom_path() +
  scale_x_discrete(breaks = NULL, expand = expand_scale(add = 0.1)) +
  scale_y_discrete(breaks = NULL) +
  theme_min()
p_ranks

对于左侧的条形图，我按值对状态进行排序并将值变为负值以指向左侧，然后为其赋予相同的最小主题：

p_left <- state1 %>%
  mutate(state = as.factor(state) %>% fct_reorder(value, sum)) %>%
  arrange(state) %>%
  mutate(value = value * -1) %>%
  ggplot(aes(x = state, y = value, fill = type)) +
    geom_col(position = "stack") +
    coord_flip() +
    scale_y_continuous(breaks = NULL) +
    theme_min() +
    scale_fill_brewer()
p_left

右边的条形图几乎相同，除了值保持正数并且我将 x 轴移动到顶部（当我翻转坐标时变为正确）：

p_right <- state2 %>%
  mutate(state = as.factor(state) %>% fct_reorder(value, sum)) %>%
  arrange(state) %>%
  ggplot(aes(x = state, y = value, fill = type)) +
    geom_col(position = "stack") +
    coord_flip() +
    scale_x_discrete(position = "top") +
    scale_y_continuous(breaks = NULL) +
    theme_min() +
    scale_fill_brewer()

然后因为我已经加载patchwork了，我可以将这些图添加在一起并指定布局。

p_left + p_ranks + p_right +
  plot_layout(nrow = 1)

您可能需要更多地调整间距和边距，例如使用expand_scale凹凸图调用。我没有尝试过沿 y 轴使用轴标记（即翻转后的底部），但我有一种感觉，如果你不在行列中添加一个虚拟轴，事情可能会失控。还有很多事情要做，但这是你提出的一个很酷的可视化项目！

推荐阅读