Methodik und Programmcode des Interaktiv-Projekts “Der Sound zum tiefen Fall der SPD”.

Paket mit Zusatzfunktionen zum Struktrurieren, Analysieren und Visualisieren von Daten installieren und laden.

#install.packages("tidyverse")
library(tidyverse)

Umfragedaten für die SPD seit 1998 laden. Quelle: wahlrecht.de

d <- read.csv('https://interaktiv.morgenpost.de/spd-absturz-sound/data/spd-absturz-sound-rohdaten.csv') %>% 
  mutate(value=as.numeric(value), date=as.Date(date,format='%Y-%m-%d')) %>% # Datenformate korrigieren
  arrange(date) # Daten nach Veröffentlichungsdatum der Umfragen sortieren

tail(d)
##            date           inst party value
## 3833 2018-02-19           INSA   spd  15.5
## 3834 2018-02-22 Infratestdimap   spd  17.0
## 3835 2018-02-23     Allensbach   spd  17.5
## 3836 2018-02-24          Emnid   spd  17.0
## 3837 2018-02-24          Forsa   spd  18.0
## 3838 2018-02-26           INSA   spd  15.5

Bei den Daten handelt es sich laut Angaben der Institute um repräsentative Umfragen, bei denen aber statistische und systematische Fehler auftreten können. Zu jedem Zeitpunkt berechnen wir deshalb einen Durchschnitt der umliegenden fünf Prozent der Umfragen aller sieben Institute. Umfragewerte, die näher an dem Zeitpunkt liegen, gehen dabei stärker in das Ergebnis ein als weiter entfernt liegende. Für die Berechnung dieses lokal gewichteten arithmetischen Mittels, wenden wir den Loess-Algorithmus an.

model <- loess(d$value~as.numeric(d$date), span=0.05) # Loess-Modell mit einer Nachbarschaftsgröße/Span von 5% an die Daten anpassen

loess <- data.frame(date = d$date, value = predict(model)) # Loess-Kurve für die Veröffentlichungsdaten der Umfragen berechnen

Die berechnete Loess-Kurve für die Umfragedaten der SPD sieht dann so aus:

ggplot(data=d, aes(x=date, y=value)) + 
  geom_point(color="#DB4240", alpha=0.09, stroke=0, size=2) + 
  geom_line(data=loess, aes(date, value), color = "#DB4240", size=1) +
  scale_y_continuous(expand=c(0, 0), limits=c(0,55)) +
  theme_classic()

Da jeder Wert exakt einem Ton zugeordnet werden muss, müssen wir die Werte runden. Dafür nehmen wir jeweils den ersten Punkt der Loess-Kurve eines Monats. Daraus ergibt sich die folgende Grafik.

mnly <- seq(as.Date('1998/1/1'), as.Date('2018/3/1'),origin="1970-01-01", by="months") # Immer den ersten des Monats zwischen 1998 und heute als Datum auswählen
rnd_mnly_loess <- data.frame(date = mnly, value = round(predict(model, as.numeric(mnly)))) # Datensatz aus Monatsanfangsdaten und den gerundeten durch das Modell vorhergesagten Werten

ggplot(data=d, aes(x=date, y=value)) + 
  geom_point(color="#DB4240", alpha=0.09, stroke=0, size=2) + 
  geom_line(data=rnd_mnly_loess, aes(date, value), color = "#DB4240", size=1) +
  scale_y_continuous(expand=c(0, 0), limits=c(0,55)) +
  theme_classic()

Übereinandergelegt zeigen sich die geringen Unterschiede zwischen originaler (schwarz) und “vertonbarer” (rot) Loess-Kurve.

ggplot() + 
  geom_line(data=loess, aes(date, value), color = "black", size=1) +
  geom_line(data=rnd_mnly_loess, aes(date, value), color = "#DB4240", size=1) +
  scale_y_continuous(expand=c(0, 0), limits=c(0,55)) +
  theme_classic()