geom_sankey：间距和对齐节点

Question

我已经按照

ggsankey 教程

，使用

R

的

ggplot

+ geom_sankey 成功创建了 Sankey 图像。但是，我按照这篇文章（如何跳过 ggsankey 中具有 NA 值的节点？）来解决数据中的“NA”。

但是，我想：

1. 正确对齐节点的每个单独列（下面称为“较早”、“最新”和“当前”），使节点框相对于彼此按时间顺序排列，从左到右流动；
2. 去掉图中出现的空方块；
3. 使第一列节点（例如“早期”）的节点大小与其他节点相似。

可重现的示例

devtools::install_github("davidsjoberg/ggsankey")
library(ggsankey); library(ggplot2)

#制作 df

Years <- data.frame(Earlier = c(rep(2012, 2), paste(2013), paste(2014), rep(2015, 2), rep(2018, 2), rep(2022, 2), rep(NA, 31)),
           Latest = c(rep(2023, 4), rep(2022, 6), rep(2021, 10), rep(2020, 3), rep(2019, 6), rep(2018, 3), rep(2017, 3), rep(2013, 4), rep(NA, 2)),
           Current = c(rep(2023, 10), rep(2022, 12), rep(2021, 11), rep(2020, 1), rep(NA, 7)))

#洗牌

set.seed(123)
Years[sample(1:nrow(Years)), ]

df_stack <- Years %>% make_long(Earlier, Latest, Current)
head(df_stack)

#绘图

ggplot(df_stack, aes(x = x, 
                       next_x = next_x,
                       node = node,
                       next_node = next_node, 
                       fill = factor(node), 
                       label = node,
                       color = factor(node))) + 
  geom_sankey(flow.alpha = 0.5, node.color = 1, 
              smooth = 6, width = 0.2,) +  #width = width of nodes
  geom_sankey_label(size = 3.5, color = 1, fill = "white") +
  scale_fill_viridis_d(direction = -1, option = "turbo") + 
  scale_colour_viridis_d(direction = -1, option = "turbo") +
  theme_sankey(base_size = 15) +
  theme(legend.position = "none") + xlab('') 

生成下图。我也在这张图片上指出了第 2 点和第 3 点（上面）。

对于第 1 点（上文）——我想按时间顺序排列年份以便于解释。这是一个非常粗略的草图，说明了节点之间应相互尊重的位置。它应该看起来像上面的图片，但它是我通过这张令人遗憾的图片得到的节点的顺序和间距。

额外信息： 会话信息() R版本4.3.0 (2023-04-21) 平台：aarch64-apple-darwin20（64位） 运行环境：macOS Ventura 13.6

版本：ggsankey_0.0.99999

任何帮助解决这个泥潭的帮助将不胜感激。谢谢。

Answer 1

空白框来自

df_stack$node

列中的缺失值。您可以通过过滤 NA 来删除这些框。

library(ggsankey)
library(ggplot2)
library(dplyr)

Years <- data.frame(Earlier = c(rep(2012, 2), 2013, 2014, rep(2015, 2), rep(2018, 2), rep(2022, 2), rep(NA, 31)),
                    Latest = c(rep(2023, 4), rep(2022, 6), rep(2021, 10), rep(2020, 3), rep(2019, 6), rep(2018, 3), rep(2017, 3), rep(2013, 4), rep(NA, 2)),
                    Current = c(rep(2023, 10), rep(2022, 12), rep(2021, 11), rep(2020, 1), rep(NA, 7)))

df_stack <- Years %>% 
  make_long(Earlier, Latest, Current) %>% 
  filter(!is.na(node))

# plot
ggplot(df_stack, aes(x = x, 
                     next_x = next_x,
                     node = node,
                     next_node = next_node, 
                     fill = factor(node), 
                     label = node,
                     color = factor(node))) + 
  geom_sankey(flow.alpha = 0.5, node.color = 1, 
              smooth = 6, width = 0.2,) +  
  geom_sankey_label(size = 3.5, color = 1, fill = "white") +
  scale_fill_viridis_d(direction = -1, option = "turbo") + 
  scale_colour_viridis_d(direction = -1, option = "turbo") +
  theme_sankey(base_size = 15) +
  theme(legend.position = "none") + xlab('') 

^{创建于 2023 年 11 月 10 日，使用 reprex v2.0.2}