在 ggplot2 中复制 Sankey 图

Question

我正在使用 sfo 包并准备桑基图。下面您可以看到我的代码和数据。

library(sfo)

sfo_passengers %>%
  filter(activity_period == max(activity_period)) %>%
  group_by(activity_type_code, geo_region) %>%
  summarise(total = sum(passenger_count), .groups = "drop")

sfo_passengers %>% 
  filter(operating_airline == "United Airlines",
         activity_period >= 201901 & activity_period < 202001) %>%
  mutate(terminal = ifelse(terminal == "International", "international", terminal)) %>%
  group_by(operating_airline,activity_type_code, geo_summary, geo_region,  terminal) %>%
  summarise(total = sum(passenger_count), .groups = "drop") %>%
  sankey_ly(cat_cols = c("operating_airline", "terminal","geo_summary", "geo_region", "activity_type_code"), 
            num_col = "total",
            title = "Dist. of United Airlines Passengers at SFO During 2019")

p <- plotly::last_plot()

plotly::add_annotations(p, c("Terminals", "Domestic/Int"), x = c(0.2, 0.5), y = c(1, 1), showarrow = FALSE)

现在我想在 ggplot2 中复制这个。我尝试使用下面的代码但不起作用。

# Load required libraries
library(ggplot2)
library(dplyr)

sfo_passengers_filtered <- sfo_passengers %>% 
  filter(activity_period == max(activity_period)) %>%
  group_by(activity_type_code, geo_region) %>%
  summarise(total = sum(passenger_count), .groups = "drop")

sfo_passengers_united <- sfo_passengers %>% 
  filter(operating_airline == "United Airlines",
         activity_period >= 201901 & activity_period < 202001) %>%
  mutate(terminal = ifelse(terminal == "International", "international", terminal)) %>%
  group_by(operating_airline,activity_type_code, geo_summary, geo_region,  terminal) %>%
  summarise(total = sum(passenger_count), .groups = "drop")

# Create the plot
ggplot(data = sfo_passengers_united, aes(x = terminal, y = geo_region, 
                                          fill = activity_type_code, text = paste("Passengers: ", total))) +
  geom_rect(aes(x = terminal, xend = after_scale(terminal), y = geo_region, yend = after_scale(geo_region), 
                fill = activity_type_code, alpha = total), color = "black") +
  geom_text(aes(label = total), size = 3) +
  scale_fill_brewer(palette = "Set1", name = "Activity Type") +
  scale_alpha_continuous(range = c(0.1, 1), guide = FALSE) +
  theme_minimal() +
  theme(legend.position = "bottom") +
  labs(title = "Distribution of United Airlines Passengers at SFO During 2019",
       x = "Terminals",
       y = "Geo Region")

有人可以帮我如何在 ggplot2 中复制这个图表吗？

Answer 1

使用

ggplot2

重新创建情节桑基图的一种可能选择是使用

ggsankey

:

library(dplyr, warn = FALSE)
library(sfo)
library(ggsankey)
library(ggplot2)

dat <- sfo_passengers %>%
  filter(
    operating_airline == "United Airlines",
    activity_period >= 201901 & activity_period < 202001
  ) %>%
  mutate(terminal = ifelse(terminal == "International", "international", terminal)) %>%
  group_by(operating_airline, activity_type_code, geo_summary, geo_region, terminal) %>%
  summarise(total = sum(passenger_count), .groups = "drop")

df <- dat %>%
  make_long(
    operating_airline, terminal,
    geo_summary, geo_region, activity_type_code,
    value = total
  )

ggplot(df, aes(
  x = x,
  next_x = next_x,
  node = node,
  next_node = next_node,
  fill = factor(node, unique(node))
)) +
  geom_sankey(flow.fill = "grey") +
  geom_sankey_label(
    aes(
      label = node,
      x = stage(
        x,
        after_stat = x + .075 * if_else(
          x == 5, -1, 1
        )
      ),
      hjust = if_else(
        x == "activity_type_code", 1, 0
      )
    ),
    size = 8 / .pt, fill = "white"
  ) +
  ggsci::scale_fill_d3(palette = "category20") +
  scale_x_discrete(
    breaks = c("terminal", "geo_summary"),
    labels = c("Terminals", "Domestic/Int"),
    position = "top"
  ) +
  guides(fill = "none") +
  ggthemes::theme_map(base_size = 11) +
  theme(
    axis.text.x = element_text()
  ) +
  labs(
    title = "Dist. of United Airlines Passengers at SFO During 2019"
  )