Österreich NRW 2019: Veränderung Wahlbeteiligung und Stimmanteil

library(tidyverse)
library(patchwork)
library(janitor)

wdr <- getwd()

Import files, clean data and analyse.

Import file

nrw17_imp <- readr::read_csv2(file = paste0(wdr, "/data/vergleichswahl-nrw17_angepasst.csv"),
                          locale=locale(encoding="latin1")) %>% 
  janitor::clean_names() %>% 
  rename(gkz=x1) %>% 
  mutate(bezirk=stringr::str_sub(gkz, 2, 4))

Identify level of each row.

#https://github.com/OKFNat/offenewahlen_api/blob/master/DATA.md

nrw17 <- nrw17_imp %>%
  mutate(bundesland=str_sub(gkz, 2, 2)) %>% 
  mutate(bezirk=str_sub(gkz, 3, 4)) %>% 
  mutate(gemeinde=str_sub(gkz, 5, 6)) %>% 
  mutate(level=case_when(str_sub(gkz, 2, 2)==0 ~ "gesamt",
                        str_detect(gkz, regex("^[A-Z][1-9]00[0,9][0,9]")) ~ "Bundesland",
                        str_detect(gkz, regex("^G.{1}[A-Z].+")) ~ "Regional-Wahlkreis",
                        str_detect(gkz, regex("^G[1-9][0-9][1-9]00")) ~ "Bezirk",
                        str_detect(gkz, regex("^G[1-9][0-9][1-9]99")) ~ "Bezirk", #Wahlkarten
                        str_detect(gkz, regex("^G[1-9][0-9][1-9][0-8][0-9]")) ~ "Gemeinde",
                        TRUE ~ as.character("u"))) %>% 
  mutate(wahlkarten=case_when(str_detect(gkz, regex("99$"))~ "ja",
                              TRUE ~ as.character("nein"))) 
  
nrw17_bezirk <- nrw17 %>% 
  filter(wahlkarten=="nein") %>% 
  filter(level=="Bezirk")

calculate turnout

nrw17_bezirk <- nrw17_bezirk %>% 
  mutate(beteiligung_rel=abgegebene/wahlberechtigte*100) %>% 
  mutate_at(vars(spo, ovp, fpo, grune, neos), .funs=list(perc=~.x/gultige))
  
nrw17_long<- nrw17_bezirk %>% 
  select(contains("perc"), gebietsname, gkz, beteiligung_rel) %>% 
  pivot_longer(., cols=contains("perc"), names_to = "party", values_to="party_perc") %>% 
  rename_at(vars(beteiligung_rel, party_perc), function(x) paste0(x, "_17"))

Import 2019 results

file <- "wahl_20190930_213406.csv"
stand <- stringr::str_extract_all(file, "[0-9]+") %>% unlist() %>% paste(., collapse="-")
stand <- lubridate::ymd_hms(stand, tz="Europe/Vienna")

nrw19_imp <- readr::read_csv2(file = paste0(wdr, "/data/", file),
                              locale=locale(encoding="latin1")) %>% 
  janitor::remove_empty(., which=c("cols")) %>% 
  janitor::clean_names() %>% 
  rename(gkz=x1) %>% 
  mutate(bezirk=stringr::str_sub(gkz, 2, 4))

Identify level of each row.

nrw19 <- nrw19_imp %>%
  mutate(bundesland=str_sub(gkz, 2, 2)) %>% 
  mutate(bezirk=str_sub(gkz, 3, 4)) %>% 
  mutate(gemeinde=str_sub(gkz, 5, 6)) %>% 
  mutate(level=case_when(str_sub(gkz, 2, 2)==0 ~ "gesamt",
                         str_detect(gkz, regex("^[A-Z][1-9]00[0,9][0,9]")) ~ "Bundesland",
                         str_detect(gkz, regex("^G.{1}[A-Z].+")) ~ "Regional-Wahlkreis",
                         str_detect(gkz, regex("^G[1-9][0-9][1-9]00")) ~ "Bezirk",
                         str_detect(gkz, regex("^G[1-9][0-9][1-9]99")) ~ "Bezirk",
                         str_detect(gkz, regex("^G[1-9][0-9][1-9][0-8][0-9]")) ~ "Gemeinde",
                         TRUE ~ as.character("u"))) %>% 
  mutate(wahlkarten=case_when(str_detect(gkz, regex("99$"))~ "ja",
                              TRUE ~ as.character("nein"))) #%>% 
#select(level, gebietsname, gkz, wahlkarten, bundesland, abgegebene, bezirk, gemeinde)

Select only Bezirk (already includes mail votes)

nrw19_bezirk <- nrw19 %>% 
  filter(wahlkarten=="nein") %>% 
  filter(level=="Bezirk")

nrw19_bezirk <- nrw19_bezirk %>% 
  mutate(beteiligung_rel=abgegebene/wahlberechtigte*100) %>% 
  mutate_at(vars(spo, ovp, fpo, grune, neos), .funs=list(perc=~.x/gultige))

nrw19_long<- nrw19_bezirk %>% 
  select(contains("perc"), gebietsname, gkz, beteiligung_rel) %>% 
  pivot_longer(., cols=contains("perc"), names_to = "party", values_to="party_perc")

row-bind 2017 and 2019 resuls

nrw <- nrw19_long %>% 
  rename_at(vars(beteiligung_rel, party_perc), function(x) paste0(x, "_19")) %>% 
  left_join(., nrw17_long, 
            by=c("gkz"="gkz", "party"="party", "gebietsname"="gebietsname")) %>% 
  mutate(party_perc_diff=(party_perc_19-party_perc_17)*100,
         beteiligung_rel_diff=beteiligung_rel_19-beteiligung_rel_17)

Plot

Define plot function to be applied for each party.

fn_plot  <- function(df){
  
df %>% 
  ggplot()+
  geom_point(aes(x=beteiligung_rel_diff,
                 y=party_perc_diff,
                 color=party,
                 fill=party))+
  geom_smooth(aes(x=beteiligung_rel_diff,
                  y=party_perc_diff),
              color="orange")+
  geom_label(aes(x=1, 
                y=25,
                label=stringr::str_wrap(text, 28)),
            color="black",
            label.size = 0,
            lineheight = 0.8,
            fill="grey80",
            size=3.5,
            hjust=0,
            vjust=1)  +
  geom_hline(yintercept=0)+
  geom_vline(xintercept=0)+
  lemon::facet_rep_wrap(vars(party),
                        repeat.tick.labels = T)+
  scale_y_continuous(limits=c(-25, 25))+
  scale_x_continuous(limits=c(-8, 8))+
  scale_fill_manual(values=c("GRÜNE"="#A3C630", "NEOS"="#EA5290", "FPÖ"="#005DA8",
                              "SPÖ"="#FC0204", "ÖVP"="#5DC2CC"))+
  scale_color_manual(values=c("GRÜNE"="#A3C630", "NEOS"="#EA5290", "FPÖ"="#005DA8",
                               "SPÖ"="#FC0204", "ÖVP"="#5DC2CC"))+
  labs(x=c("Beteiligung NRW19 < NRW17 | Beteiligung NRW19 > NRW17\nVeränderung Wahlbeteiligung"),
       y=c("Differenz Stimmanteil\nNRW19 < NRW17 | NRW19 > NRW17"))+
  hrbrthemes::theme_ipsum_ps()+
  theme(
    legend.position = "none",
    strip.text=element_text(face="bold"),
    axis.title.x=element_text(hjust=c(0.5)),
    axis.title.y=element_text(hjust=c(0.5), vjust=c(0.5))
    )
}

Define annotations

df_annotation <- data.frame(party=as_factor(c("ÖVP", "FPÖ","SPÖ","GRÜNE","NEOS")),
                            text=c("In den wenigen Bezirken in denen die ÖVP verloren hat, war der Rückgang der Wahlbeteiligung am geringsten", 
                                   "Je stärker der Rückgang der Wahlbeteiligung desto stärker die Verluste der FPÖ.",
                                   "Je stärker die Wahlbeteiligung zurückging, desto geringer waren die Verluste der SPÖ.",
                                   "Die Grünen hatten den stärksten Stimmenzugewinn in Bezirken in denen die Wahlbeteiligung am geringsten zurückging.",
                                   "Veränderung der Wahlbeteiligung ist nicht mit Veränderung des Stimmenanteils der Neos assoziiert."))

Merge election and annotation data. Split data per party and apply plot function

plot_list <- nrw %>% 
  mutate(party=map_chr(party, function(x) str_remove_all(x, "_.*")) %>% stringr::str_to_upper()) %>% 
  mutate(party=case_when(party=="OVP" ~ "ÖVP",
                         party=="FPO" ~ "FPÖ",
                     party=="SPO" ~ "SPÖ",
                     party=="GRUNE" ~ "GRÜNE",
                     party=="NEOS" ~ "NEOS",
                     TRUE ~ as.character(party))) %>%
  mutate(party=forcats::fct_relevel(party, "ÖVP", "FPÖ", "SPÖ", "GRÜNE","NEOS")) %>% 
  left_join(., df_annotation, by=c("party")) %>% 
  group_split(party) %>% 
  map(., fn_plot)

Combine different plots to one joint plot

plot_combined <- wrap_plots(plot_list)+plot_layout(ncol=2, nrow=3)+
  plot_annotation(title=paste0("Österreichische Nationalratswahlen 2019:", str_to_upper("\nVeränderung Wahlbeteiligung und Stimmenanteil auf Bezirksebene (v. NRW 2017).")),
                  caption = glue::glue("data: https://www.data.gv.at, Stand: {stand}\n\nRoland Schmidt | @zoowalk | werk.statt.codes"),
                  theme=theme(plot.title = element_text(face="bold"),
                              plot.caption = element_text(face="plain")))
plot_combined

Save plot.

ggsave(filename=paste0(Sys.Date(),"_änderung_wahlbeteiligung_stimmanteil", ".png"),
       path=paste0(wdr, "/graphs"),
       plot=plot_combined,
       device="png",
       width=13,
       height=6.9,
       dpi=300,
       units=c("cm"),
       limitsize = F)

Interactive plot with cross-talk ——————————————————–

Not polished, only for crude analysis. Click on one point (district), to see its position in other graphs, for other parties..

library(plotly)
library(crosstalk)

shared_df <- SharedData$new(nrw, key = ~gebietsname)

plot_int <- shared_df %>% 
  ggplot()+
  geom_point(aes(x=beteiligung_rel_diff,
                 y=party_perc_diff,
                 color=party,
                 fill=party))+
  # geom_smooth(aes(x=beteiligung_rel_diff,
  #                 y=party_perc_diff),
  #             color="orange")+
  geom_hline(yintercept=0)+
  geom_vline(xintercept=0)+
  lemon::facet_rep_wrap(vars(party),
                        labeller=as_labeller(function(x) str_remove_all(x, "_perc") %>% stringr::str_to_upper()),
                        nrow=3,
                        repeat.tick.labels = T)+
  scale_fill_manual(values=c("grune_perc"="#A3C630", "neos_perc"="#EA5290", "fpo_perc"="#005DA8",
                              "spo_perc"="#FC0204", "ovp_perc"="#5DC2CC"))+
  scale_color_manual(values=c("grune_perc"="#A3C630", "neos_perc"="#EA5290", "fpo_perc"="#005DA8",
                               "spo_perc"="#FC0204", "ovp_perc"="#5DC2CC"))+
  scale_y_continuous(limits=c(-25, 25))+
  scale_x_continuous(limits=c(-8, 8))+
  labs(x=c("Beteiligung NRW19 < NRW17 | Beteiligung NRW19 > NRW17\nVeränderung Wahlbeteiligung"),
       y=c("Stimmenveränderung in %-Puntke\nNRW19 < NRW17 | NRW19 > NRW17"))+
  hrbrthemes::theme_ipsum_ps()+
  theme(
    legend.position = "none",
    strip.text=element_text(face="bold"),
    axis.title.x=element_text(hjust=c(0.5)),
    axis.title.y=element_text(hjust=c(0.5), vjust=c(0.5))
  )

ggplotly(plot_int)