Notes

Dieses Dokument beschreibt die Verarbeitung und Analyse der Daten, welche als Grundlage für den Artikel “Die SVP politisiert an der Basis vorbei”, welcher im Rahmen des Forschungsseminars Datenjournalismus an der UZH erstellt wurde. Die Verarbeitung und Analyse der Daten wurde in R-Studio und RMarkdown durchgeführt.

Dieser Bericht wurde am 2019-12-19 16:20:03 generiert. R-Version: 3.6.2.

Setup Markdown

# Setup
knitr::opts_chunk$set(collapse = TRUE)
knitr::opts_chunk$set(tidy = TRUE)
knitr::opts_chunk$set(echo = TRUE) 
knitr::opts_chunk$set(warning = FALSE) 
knitr::opts_chunk$set(message = FALSE) 
knitr::opts_chunk$set(fig.pos = 'H')

Load library

rm(list = ls())


# Library
library(tidyr)
library(plyr)
library(reshape2)
library(ggalt)
library(bbplot)
library(grDevices)
library(waffle)
library(extrafont)
library(magrittr)
library(hrbrthemes)
library(tidyverse)
library(ggwaffle)
library(gridExtra)
library(grid)
library(plotly)
library(dplyr)
library(kableExtra)
library(bsselectR)

Import data

Die Daten wurden von smartvote, sotomo und dem gfs Bern zur Verfügung gestellt.

# Import data
## smartvote data on the candidates for the 'National Council Elections 2019^
sv19 <- read.csv("smartvote_2019_nr.csv",
                 header = TRUE, sep = ";") 
## smartvote questionnaire 'National Council Elections 2019'
quest <- read.csv("FB_2019.csv",
                           header = TRUE, sep = ";")
## sotomo data on candidates for the 'National Council Elections 2019'
data <- read.csv("data.csv",
                           header = TRUE, sep = ";") # Parties
total <- read.csv("data_total.csv",
                           header = TRUE, sep = ";") # Total

Data Preparation

In einem ersten Schritt wurden einige Parteien umgruppiert. Die Antwortmöglichkeiten im smartvote-Fragebogen bestehen aus vier Kategorien: ‘Ja’, ‘eher Ja’, ‘eher Nein’ und ‘Nein’. Für die Analyse wurden diese in die Kategorien ‘Ja’ (Ja und eher Ja) und ‘Nein’ (Nein und eher Nein) umcodiert. Zudem wurden die unterschiedlichen Datensätze zusammengefügt & in die richtige Form gebracht.

# Prepare data
## smartvote data

### Reshuffle parties 
sv19$party_short[sv19$party_short=="ALG"] <- "Grüne"
sv19$party_short[sv19$party_short=="BastA!"] <- "Grüne"
sv19$party_short[sv19$party_short=="LDP"] <- "FDP"
sv19$party_short[sv19$party_short=="EVP"] <- "CVP"
sv19$party_short[sv19$party_short=="EDU"] <- "SVP"
sv19$party_short[sv19$party_short=="Lega"] <- "SVP"

### Filter member of parliament & parties of interest
sv19_r <- sv19 %>% 
  filter(elected == 1 & party_short %in% c("CVP", "FDP", "glp", "Grüne", "SP", "SVP"))

### drop unused levels
sv19_r$party_short = droplevels(sv19_r$party_short)

### Recode answers
sv19_r$name = paste(sv19_r$firstname, sv19_r$lastname, sep=" ") #Generate variable "name"
sv19_rr <- sv19_r %>%  
  select(name,
         party = party_short,
         rentenalter = answer_3412,
         einwanderung = answer_3428,
         steuern = answer_3436,
         gleichg.paare = answer_3432,
         kampfflugzeug = answer_3463,
         ) %>%  
  mutate_at(c(3:7), recode, `0` = 0, `25` = 0, `75` = 100, `100` = 100)

### Reshape data
sv19_rr <- melt(sv19_rr, id.vars = c("name", "party"))
colnames(sv19_rr) <- c("name", "party", "thema", "approval")

### Approval per party
sv19_pp <- sv19_rr %>% 
  group_by(party, thema) %>% 
  summarise_all(mean, na.rm = TRUE) %>%
  select(party, thema, approval) %>%
  mutate(rolle = "mp") %>%
  arrange(thema)

## Sotomo data
### Reshape data
data_r <- data %>% 
  gather(party, approval, SVP:SP) %>%
  select(party, frage, thema, approval, rolle)

## total
total_r <- total %>% 
  gather(party, approval, total) %>%
  select(party, frage, thema, approval, rolle) 

## Combinde data sets
data_n <- as.data.frame(rbind.fill(data_r, sv19_pp, total_r))

### Add missing questions
data_n$frage[data_n$thema == "rentenalter"] <- data$frage[data$thema == "rentenalter"]
data_n$frage[data_n$thema == "praemien"] <- data$frage[data$thema == "praemien"]
data_n$frage[data_n$thema == "klima"] <- data$frage[data$thema == "klima"]
data_n$frage[data_n$thema == "organspende"] <- data$frage[data$thema == "organspende"]
data_n$frage[data_n$thema == "einwanderung"] <- data$frage[data$thema == "einwanderung"]
data_n$frage[data_n$thema == "steuern"] <- data$frage[data$thema == "steuern"]
data_n$frage[data_n$thema == "gleichg.paare"] <- data$frage[data$thema == "gleichg.paare"]
data_n$frage[data_n$thema == "kampfflugzeug"] <- data$frage[data$thema == "kampfflugzeug"]

### Reshape new data set
data.final <- data_n %>% 
  spread(rolle, approval) %>% 
  mutate(diff = voter-mp) %>%
  arrange(thema, party) 

### Generate Variable "thema.neu"
data.final$thema.neu <- NA
data.final$thema.neu[data.final$thema == "rentenalter"] <- "Erhöhung Rentenalter"
data.final$thema.neu[data.final$thema == "praemien"] <- "Verbilligung der Krankenkassenprämien"
data.final$thema.neu[data.final$thema == "klima"] <- "Klimaschutzmassnahmen mit Kostenfolgen"
data.final$thema.neu[data.final$thema == "organspende"] <- "Organspende-Initiative"
data.final$thema.neu[data.final$thema == "einwanderung"] <- "Begrenzung der Einwanderung vs. Billaterale"
data.final$thema.neu[data.final$thema == "steuern"] <- "Steuersenkungen auf Bundesebene"
data.final$thema.neu[data.final$thema == "gleichg.paare"] <- "Gleiche Rechte für gleichgeschlechtliche Paare"
data.final$thema.neu[data.final$thema == "kampfflugzeug"] <- "Beschaffung neuer Kampfflugzeuge"
# Table Fragen
thema <- as.character(unique(data.final$thema.neu))
frage <- as.character(unique(data.final$frage))

table <- as.data.frame(cbind(thema, frage))
colnames(table) <- c("Thema", "Frage")
table %>%
  kable(row.names = F) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"), full_width = T, fixed_thead = T, font_size = 13)
Thema Frage
Begrenzung der Einwanderung vs. Billaterale Ist die Begrenzung der Einwanderung für Sie wichtiger als der Erhalt der Bilateralen Verträge mit der EU?
Gleiche Rechte für gleichgeschlechtliche Paare Sollen gleichgeschlechtliche Paare in allen Bereichen die gleichen Rechte wie heterosexuelle Paare haben?
Beschaffung neuer Kampfflugzeuge Befürworten Sie die Beschaffung neuer Kampfflugzeuge für die Schweizer Armee?
Klimaschutzmassnahmen mit Kostenfolgen Befürworten Sie Massnahmen zum Klimaschutz in der Schweiz mit Kostenfolgen, die im Alltag deutlich spürbar sind (Treibstoffabgabe, Gebäudevorschriften, Road-Pricing usw.)?
Organspende-Initiative Befürworten Sie die Organspende-Initiative?
Verbilligung der Krankenkassenprämien Sind Sie dafür, dass die Krankenkassenprämien auch für mittlere Einkommen mit Steuergeldern verbilligt werden?
Erhöhung Rentenalter Befürworten Sie eine Erhöhung des Rentenalters (z. B. auf 67 Jahre)?
Steuersenkungen auf Bundesebene Haben für Sie Steuersenkungen auf Bundesebene in den nächsten vier Jahren Priorität?

Visualizations

Gesamtübersicht
# Visualization 1: General overview per party
## Dumbbell chart: Overview total differences

### Prepare data
data.plot <- data.final %>%
  filter(party == "total") %>%
  mutate(abs.diff = abs(diff)) %>%
  arrange(-abs.diff) 

data.plot$diff.n <- c("+ 14", "- 12", "- 12", "+ 11", "+ 10", "- 05", "- 05", "- 04")

## Function for labelling percentage
percent <- function(x) {
  x <- sprintf("%d%%", round(x))
}

### Create basic plot
plot <- ggplot(data.plot, aes(x = mp, xend = voter, y = reorder(thema.neu, abs.diff), group = thema.neu)) +
  geom_dumbbell(colour = "#dddddd",
                size = 3,
                colour_x = "#FAAB18",
                colour_xend = "#35AEB2") +
  bbc_style() + 
  theme(axis.text.y = element_text(size=12),
        axis.text.x = element_text(size=12),
        plot.title = element_text(size=18),
        plot.subtitle = element_text(size=16))

### Add Labels
plot <- plot +
  geom_text(aes(x = mp, y = reorder(thema.neu, abs.diff)), label= percent(data.plot$mp), color = "#717D8C", size = 3.75, vjust = 2.5) +
  geom_text(aes(x = voter, y = reorder(thema.neu, abs.diff)), label= percent(data.plot$voter), color = "#717D8C", size = 3.75, vjust = 2.5, hjust = .75) 

### Add legend
plot <- plot +
  geom_text(data=filter(data.plot, thema=="praemien"), aes(x = mp, y = reorder(thema.neu, abs.diff)), label= "Parlamentarier/innen", color = "#FAAB18", size = 4, fontface = "bold", vjust = -2, hjust = .8) +
  geom_text(data=filter(data.plot, thema=="praemien"), aes(x = voter, y = reorder(thema.neu, abs.diff)), label= "Wähler/innen", color = "#35AEB2", size = 4, fontface = "bold", vjust = -2) 

### Add 'difference column'
plot <- plot +
  geom_rect(data=data.plot, 
            aes(xmin=103, xmax=113, ymin=-Inf, ymax=Inf), fill = "#dddddd") +
  geom_text(data=data.plot, 
            aes(label=diff.n, y=reorder(thema.neu, abs.diff), x=108),size=4) +
  geom_text(data=filter(data.plot, thema=="praemien"), 
                        aes(x=108, y=reorder(thema.neu, abs.diff), label="Differenz"),
                     size=3, vjust=-2.5, fontface="bold") +
  scale_x_continuous(expand=c(0,0), limits=c(0, 113)) +
  scale_y_discrete(expand=c(0.1,0)) 

### Add annotation
plot <- plot + 
  geom_label(aes(x = 20, y = 6.5, 
                 label = "Die grösste Differenz \nzeigt sich beim Thema \n'Krankenkassenprämien'"), 
             lineheight = 1.2,
             hjust = 0,
             vjust = 0.5,
             colour = "#555555", 
             fill = "white", 
             label.size = NA, 
             family="Helvetica", 
             size = 4) +
  geom_curve(aes(x = 25, y = 7.1, xend = 40, yend = 8), 
                             colour = "#555555", 
                             size=0.1, 
                             curvature = -0.3,
                             arrow = arrow(length = unit(0.02, "npc")))
# Plot 
plot