Vorverarbeitung

Für die Verarbeitung der Wahlprogramme werden die Bibliotheken readtext und quanteda benötigt. Zudem wird die Biliothek udpipe benutzt, um das Korpus zu lemmatisieren. Die dazugehörige Funktion ist in der Datei functions/lemmatize.R gespeichert. 

library(quanteda)
library(readtext)
library(tidyverse)
library(udpipe)

source("functions/lemmatize.R")

Weil die Lemmatisierung einige Zeit braucht, ist die lemmatisierte Version des Korpus schon unter RData/lemmatized_corpus.RData abgespeichert. Zudem werden Stoppwörter geladen, die auf den quanteda eigenen Stoppwörtern aufbauen, aber noch einige zusätzliche enthalten.

# Load lemmatized corpus
load("RData/lemmatized_corpus.RData")
# Load custom stopwords
load("RData/custom_stopwords.RData")

Die Stoppwörter werden dann aus den Wahlprogrammen herausgefiltert. Danach kann eine Document-Feature-Matrix erstellt werden.

# Convert characters in year column to integers
docvars(programs, field="year") <- as.integer(docvars(programs, field="year"))

# Create tokens object for whole corpus, filter out stopwords.
program_toks <- tokens(programs,remove_punct = TRUE) %>% tokens_remove(custom_stops)

# Create dfm for corpus
program_dfm <- dfm(program_toks)

Vergleich der häufigsten Terme zwischen den Parteien

Die folgenden 30 Terme treten insgesamt am häufigsten in den Wahlprogrammen zur Bundestagswahl auf. Eine Liste mit den 100 häufigsten Termen kann unter data/bag_of_words.csv abgerufen werden.

##          feature frequency rank docfreq group
## 1         müssen      6186    1       7   all
## 2         mensch      3099    2       7   all
## 3            gut      2905    3       7   all
## 4         sollen      2747    4       7   all
## 5    deutschland      2739    5       7   all
## 6           mehr      2739    5       7   all
## 7            neu      2519    7       7   all
## 8         sozial      2395    8       7   all
## 9           land      2146    9       7   all
## 10        setzen      1826   10       7   all
## 11      brauchen      1724   11       7   all
## 12    europäisch      1688   12       7   all
## 13       stärken      1644   13       7   all
## 14          kind      1518   14       7   all
## 15      schaffen      1498   15       7   all
## 16    öffentlich      1459   16       7   all
## 17         stark      1324   17       7   all
## 18         leben      1252   18       7   all
## 19          jahr      1249   19       7   all
## 20  gesellschaft      1232   20       7   all
## 21   unternehmen      1229   21       7   all
## 22       deutsch      1179   22       7   all
## 23       fördern      1151   23       7   all
## 24        arbeit      1148   24       7   all
## 25        europa      1146   25       7   all
## 26         recht      1146   25       7   all
## 27            eu      1145   27       7   all
## 28        dürfen      1099   28       7   all
## 29 international      1090   29       7   all
## 30       politik      1071   30       7   all

Um zu vergleichen, wie sich die relative Häufigkeit dieser Terme zwischen den Parteien unterscheidet, wird ein data frame erstellt, indem die relative Häufigkeit eines Terms für jede Partei gespeichert ist. Zur Berechnung der relativen Häufigkeit wird die Frequenz eines Terms durch die Summe aller Terme einer Partei dividiert. Die Frequenz wird also relativ zur Länge eines Wahlprogramms normalisiert.

top.30 <- head(textstat_frequency(dfm(program_dfm, groups="party")), 30)
parties <- c("AfD", "CDU", "SPD", "PDS", "FDP", "DIELINKE", "B90dieGruene")

# Intialize data frame
terms.ranked <- data.frame(matrix(ncol = 3, nrow = 0))
colnames(terms.ranked) <- c("feature", "party", "relative")

# Iterate over parties and get relative frequency for each term.
for (i in 1:length(parties)){
  # Get programs for each party.
  stat.party <- dfm_subset(program_dfm, party == parties[i]) %>%
    textstat_frequency()
  # Get full term frequency for each party.
  sum.freq <- sum(stat.party$frequency)
  # Only keep top 30 terms.
  stat.party.filtered <- filter(stat.party, feature %in% top.30$feature)
  tmp.data <- data.frame(feature=stat.party.filtered$feature,
                         party=parties[i],
                         relativ=stat.party.filtered$frequency/sum.freq)
  terms.ranked <- rbind(terms.ranked, tmp.data)
}

head(terms.ranked, 20)
##        feature party     relativ
## 1       müssen   AfD 0.012223516
## 2  deutschland   AfD 0.011447419
## 3      deutsch   AfD 0.008925107
## 4       sollen   AfD 0.007081878
## 5         land   AfD 0.004365541
## 6         kind   AfD 0.004365541
## 7           eu   AfD 0.003201397
## 8   europäisch   AfD 0.003007373
## 9       dürfen   AfD 0.002910361
## 10        jahr   AfD 0.002910361
## 11      europa   AfD 0.002813349
## 12     stärken   AfD 0.002425301
## 13       recht   AfD 0.002328289
## 14        mehr   AfD 0.002231277
## 15      mensch   AfD 0.002231277
## 16      setzen   AfD 0.002134265
## 17      sozial   AfD 0.002134265
## 18    brauchen   AfD 0.001940241
## 19     fördern   AfD 0.001940241
## 20         neu   AfD 0.001940241

In einer Heatmap werden diese Häufigkeiten dann zwischen den Parteien verglichen. Niedrige relative Häufigkeiten sind dabei blau, hohe dagegen rot.

TF-IDF Scores

Im Weiteren wird anhand der AfD erklärt, wie die TF-IDF Werte für eine Partei errechnet werden. In dem hier gezeigten Plot werden nur etwa 30 Terme, mit den höchsten TF-IDF Wert für jede Partei gezeigt. Für jede Partei ist eine Liste mit den 100 höchstbewerteten Termen in dem Verzeichnis data enthalten. Für die Darstellung der Terme werden zudem Selbstbezeichnungen wie afd herausgefiltert, weil diese oft einen sehr hohen Score haben, aber nicht sehr aussagekräftig sind.

# Group dfm by party
party.dfm <- dfm(program_dfm, groups = "party")
# Create tfidf
tfidf <- dfm_tfidf(party.dfm)

# Get scores for AfD
tfidf.afd <- dfm_subset(tfidf, party == "AfD")

# Filter out self referential terms.
top.afd <- head(textstat_frequency(tfidf.afd, force =TRUE), 30) %>% filter(feature != "afd")
ggplot(top.afd , aes(x=feature, y=frequency)) +
  geom_segment( aes(x=top.afd $feature, xend=top.afd $feature, y=0, yend=frequency), color="skyblue") +
  geom_point( color="blue", size=4, alpha=0.6) +
  theme_light() +
  coord_flip() +
  theme(
    panel.grid.major.y = element_blank(),
    panel.border = element_blank(),
    axis.ticks.y = element_blank()
  )+
  labs(x ="Term", y="TF-IDF-Score")+
  ggtitle("Alternative für Deutschland - Terme mit höchsten TF-IDF-Wert")

Die Plots für die übrigen Parteien wurden analog erstellt: