EU-Wahl 2024 (https://x.com/matschnetzer/status/1810339285112918478)

euwahl_sankey.R

library(tidyverse)
library(ggsankey)
library(ggtext)
library(colorspace)

# Daten von https://www.bmi.gv.at/412/Europawahlen/Europawahl_2024/files/endgueltiges_Ergebnis_Europawahl_26062024.xlsx
raw <- readxl::read_xlsx("endgueltiges_Ergebnis_Europawahl_26062024.xlsx")

# Daten auswählen, neue Variablen generieren, in Long-Format bringen
data <- raw |> filter(Gebietsname == "Österreich") |> 
  select(Wahlberechtigt = Wahlberechtigte, `Wähler:innen` = Stimmen, Ungültig = `...5`,
         Gültig = `...6`, ÖVP, SPÖ, FPÖ, GRÜNE, NEOS, DNA, KPÖ) |> 
  mutate(across(everything(), as.numeric),
         Bevölkerung = 9158750,
         `Nicht wahlberechtigt` = Bevölkerung - Wahlberechtigt,
         `Nichtwähler:innen` = Wahlberechtigt - `Wähler:innen`) |> 
  pivot_longer(everything(), names_to = "Kategorie", values_to = "Anzahl") |> 
  mutate(Anteil = Anzahl/9158750*100,
         Kategorie = factor(Kategorie))


# Ablauf des Sankey Plot in einem Dataframe organisieren (Namen = Stages des Sankey Plot)
df <- 
  tribble(~Insgesamt, ~Wahlberechtigt, ~Wähler, ~Gültig, ~Partei, ~Anteil,
  "Bevölkerung", "Nicht wahlberechtigt", NA, NA, NA, data[[13,3]],
  "Bevölkerung", "Wahlberechtigt", "Nichtwähler:innen", NA, NA, data[[14,3]],
  "Bevölkerung", "Wahlberechtigt", "Wähler:innen", "Ungültig", NA, data[[3,3]],
  "Bevölkerung", "Wahlberechtigt", "Wähler:innen", "Gültig", "SPÖ", data[[6,3]],
  "Bevölkerung", "Wahlberechtigt", "Wähler:innen", "Gültig", "ÖVP", data[[5,3]],
  "Bevölkerung", "Wahlberechtigt", "Wähler:innen", "Gültig", "FPÖ", data[[7,3]],
  "Bevölkerung", "Wahlberechtigt", "Wähler:innen", "Gültig", "GRÜNE", data[[8,3]],
  "Bevölkerung", "Wahlberechtigt", "Wähler:innen", "Gültig", "NEOS", data[[9,3]],
  "Bevölkerung", "Wahlberechtigt", "Wähler:innen", "Gültig", "DNA", data[[10,3]],
  "Bevölkerung", "Wahlberechtigt", "Wähler:innen", "Gültig", "KPÖ", data[[11,3]])

# Mit ggsankey::make_long in das richtige Format bringen
dflong <- df |> make_long(Partei, Gültig, Wähler, Wahlberechtigt, Insgesamt, 
                        value = Anteil) |> 
  mutate(node = factor(node, levels = c("Bevölkerung", "Wahlberechtigt", "Nicht wahlberechtigt", "Wähler:innen", "Nichtwähler:innen", "Gültig", "Ungültig","ÖVP", "SPÖ", "FPÖ","GRÜNE","NEOS","DNA","KPÖ")))

# Daten zusammenführen
dflong <- dflong |> left_join(data, by = c("node" = "Kategorie"))

# Für deutsche Grafik, Dezimaltrenner auf Komma setzen
options(OutDec= ",")

# Grafik produzieren
dflong |> ggplot(aes(x = x, next_x = next_x, node = node, value = value, 
                 next_node = next_node, group = node)) +
  geom_sankey(aes(fill = node), flow.alpha = 1, node.alpha = 1, width = 0.15,
              smooth = 7, space = 7, type = "alluvial", linewidth = 0) +
  # LABEL: BEVÖLKERUNG
  geom_sankey_label(aes(label = glue::glue("{node} in Österreich: {round(Anzahl/1e6,2)} Mio.")), 
                    y = 2, type = "alluvial", space = 7, hjust = 0,
                    family = "Barlow Condensed", color = "white",
                    fill = NA, label.size = 0, size = 3.5,
                    data = dflong |> filter(x == "Insgesamt")) +
  # WEISSE LABELS
  geom_sankey_label(aes(label = glue::glue("{node}\n{round(Anzahl/1e6,1)} Mio.\n{round(Anteil,1)}%"),
                        color = ifelse(node %in% c("Gültig", "Wähler:innen", "Wahlberechtigt"), 
                                       "white", "transparent")), 
                   y = 2, type = "alluvial", space = 7, hjust = 0, vjust = 0,
                   family = "Barlow Condensed", lineheight = 0.9,
                   position = position_nudge(x = -0.05),
                   fill = NA, label.size = 0, size = 3.5,
                   data = dflong |> filter(!x %in% c("Insgesamt","Partei")) |> drop_na()) +
  # SCHWARZE LABELS
  geom_sankey_label(aes(y = node, label = glue::glue("{node}\n{round(Anzahl/1e6,1)} Mio.\n{round(Anteil,1)}%"),
                        color = ifelse(node %in% c("Nichtwähler:innen", "Nicht wahlberechtigt"), "black", "transparent")), 
                    type = "alluvial", space = 7, hjust = 0, vjust = 1,
                    family = "Barlow Condensed", lineheight = 0.9,
                    position = position_nudge(x = -0.07, y = -16),
                    fill = NA, label.size = 0, size = 3,
                    data = dflong |> filter(x %in% c("Wähler","Wahlberechtigt")) |> drop_na()) +
  # LABEL: UNGÜLTIG
  geom_sankey_label(aes(y = node, label = glue::glue("{node}\n{round(Anzahl/1e3,0)} Tsd.\n{round(Anteil,1)}%"),
                        color = ifelse(node == "Ungültig", "black", "transparent")), 
                    type = "alluvial", space = 7, hjust = 0, vjust = 1,
                    family = "Barlow Condensed", lineheight = 0.9,
                    position = position_nudge(x = -0.07, y = -2),
                    fill = NA, label.size = 0, size = 3,
                    data = dflong |> filter(x == "Gültig") |> drop_na()) +
  # LABEL: PARTEIEN
  geom_sankey_label(aes(y = node, label = glue::glue("{node}\n{round(Anzahl/1e3,0)}T\n{round(Anteil,1)}%")), 
                    type = "alluvial", space = 7, vjust = 1,
                    family = "Barlow Condensed", color = "black", lineheight = 0.9,
                    position = position_nudge(x = -0.1),
                    fill = NA, label.size = 0, size = 3,
                    data = dflong |> filter(x == "Partei") |> drop_na()) +
  # WEISSER TRENNSTRICH ZWISCHEN STAGES
  geom_linerange(aes(xmin = x, xmax = x, ymin = 0, ymax = Inf), 
               color = "white", linewidth = 1.5, position = position_nudge(x = -0.07),
               data = dflong |> filter(x != "Partei")) +
  # TITEL
  annotate("richtext", x = 2.4, y = 105, fill = NA, label.size =0,
           label ="<img src='eu_flag.png' height=50 />") +
  annotate("text", x = 2.15, y = 105, size = 6, color = "black", hjust = .5, vjust = 0,
           family = "Barlow Condensed", label = "EU-WAHL 2024") +
  annotate("text", x = 2.1, y = 105, size = 4, color = "black", hjust = .5, vjust = 1,
           family = "Barlow Condensed", lineheight = 0.9,
           label = "Endgültiges Ergebnis\nfür Österreich inklusive\nBriefwahl-Wahlkarten") +
  annotate("text", x = 1.8, y = 105, size = 3, color = "black", hjust = .5, vjust = 1,
           family = "Barlow Condensed", lineheight = 0.9,
           label = "Daten: BMI. Grafik: @matschnetzer") +
  scale_color_identity() +
  scale_fill_manual(values = c("ÖVP" = "#63c3d0", "SPÖ" = "#ff0000", 
                               "FPÖ" = "#0066ff", "GRÜNE" = "#92d050",
                               "NEOS" = "#e84188", "DNA" = "#900C3F",
                               "KPÖ" = "#e60000",
                               "Bevölkerung" = darken("deepskyblue3", 0.4),
                               "Wahlberechtigt" = darken("deepskyblue3", 0.2),
                               "Nicht wahlberechtigt" = "gray50",
                               "Wähler:innen" = "deepskyblue3",
                               "Nichtwähler:innen" = "gray70",
                               "Gültig" = lighten("deepskyblue3", 0.2),
                               "Ungültig" = "gray90"),
                    na.value = "transparent") +
  scale_y_discrete(expand = c(0,0)) +
  scale_x_discrete(expand = c(0.07, 0.07)) +
  labs(x = NULL, y = NULL) +
  coord_flip() +
  theme_minimal(base_family = "Barlow Condensed") +
  theme(panel.grid = element_blank(),
        plot.margin = margin(l = 0.1, t = -1, unit = "cm"),
        legend.position = "none",
        plot.title.position = "plot",
        plot.title = element_text(size = 20, family = "Fira Sans", hjust = .5,
                                  margin = margin(b = 1, unit = "lines")),
        axis.text.x = element_blank(),
        axis.text.y = element_blank())

ggsave("euwahl_sankey.png", width = 5, height = 9, dpi = 320, bg = "white")