Die Daten
Im Folgenden lade ich den Koalitionsvertrag von der Homepage der SPD runter und lese ihn pro Zeile ein. Jeder Zeile füge ich noch das Kapitel hinzu. Zudem definiere ich gleich noch Füllwörter, die später herausgefiltert werden sollen.
library(pdftools)
library(dplyr)
library(tibble)
library(readr)
library(stopwords)
text_Koalition <- pdf_text("https://www.spd.de/fileadmin/Dokumente/Koalitionsvertrag/Koalitionsvertrag_2021-2025.pdf") %>%
read_lines() %>%
as.data.frame() %>%
rownames_to_column(., var="line") %>%
`colnames<-`(c("line", "text")) %>%
mutate(text = as.character(text)) %>%
mutate(line = as.numeric(line)) %>%
mutate(Kapitel = ifelse(line>=49 & line<=160, "Präambel",
ifelse(line>=162 & line<=667, "Moderner_Staat",
ifelse(line>=669 & line<=1939, "Klima",
ifelse(line>=1941 & line<=2793, "Soziales",
ifelse(line>=2795 & line<=3074, "Familie",
ifelse(line>=3076 & line<=3888, "Innen",
ifelse(line>=3890 & line<=4746, "Europa",
ifelse(line>=4748 & line<=5197, "Finanzen",
ifelse(line>=5199 & line<=5321, "Arbeitsweise",
" "))))))))))
custom_stop_words <- bind_rows(tibble(word = c("z", "sowie", "dass", "dafür", "insbesondere", "u", "a", "sgb",
"ii", "bzw", "vn", "b"), lexicon = c("custom")),
tibble(word = stopwords("de"), lexicon = c("stopwords")))die häufigsten Begriffe
Nun schauen wir direkt auf die häufigsten Begriffe. Gibt es Überraschungen?
library(tidytext)
library(unine)
library(ggplot2)
library(viridis)
text_Koalition %>%
unnest_tokens(word, text) %>%
anti_join(custom_stop_words) %>%
mutate(stem = german_stemmer(word)) %>%
count(stem, sort = TRUE) %>%
top_n(15) %>%
mutate(stem = reorder(stem, n)) %>%
ggplot(aes(x = stem, y = n, fill = stem)) +
geom_col(show.legend = FALSE) +
coord_flip() +
scale_fill_viridis(discrete = TRUE, option="cividis") +
theme_minimal() +
labs(x = NULL, y = NULL,
title = paste("stark & europäisch - noch wenig Mehrwert"),
subtitle = ("die häufigsten Wortstämme"))
Aber für was steht der Wortstamm “ford” in der letzten Nennung? Fordern oder Fördern? Das können wir herausfinden: zum Glück kommt “fördern” eindeutig häufiger vor als “fordern”. Wäre auch komisch in einem Koalitionsprogramm Forderungen zu stellen.
text_Koalition %>%
unnest_tokens(word, text) %>%
filter(grepl("förd", word) | grepl("ford", word) ) %>%
mutate(stem = german_stemmer(word)) %>%
mutate(combi = paste(word, " (", stem, ")")) %>%
count(combi, sort = TRUE) %>%
filter(n>1) %>%
mutate(combi = reorder(combi, n)) %>%
ggplot(aes(x = combi, y = n, fill = combi)) +
geom_col(show.legend = FALSE) +
coord_flip() +
scale_fill_viridis(discrete = TRUE, option="cividis") +
theme_minimal() +
labs(x = NULL, y = NULL,
title = paste("mehr fördern statt fordern"),
subtitle = ("Wort (Wortstamm) auf der y-Achse"))
Doch viel mehr lesen wir hier noch nicht raus. Vielleicht lohnt sich der Blick auf die häufigsten Bigramme? Hier sehen wir schon zwei mögliche große Schwerpunkte des Programms:
library(tidyr)
bigrams_Koalition <- text_Koalition %>%
unnest_tokens(bigram, text, token = "ngrams", n = 2) %>%
separate(bigram, c("word1", "word2"), sep = " ") %>%
filter(!word1 %in% custom_stop_words$word,
!word2 %in% custom_stop_words$word) %>%
drop_na(word1) %>%
drop_na(word2) %>%
mutate(word1 = german_stemmer(word1)) %>%
mutate(word2 = german_stemmer(word2)) %>%
unite(bigram, word1, word2, sep = " ")
bigrams_Koalition<-bigrams_Koalition[-grep("\\b\\d+\\b", bigrams_Koalition$bigram),] #remove numbers
bigrams_Koalition %>%
count(bigram, sort = TRUE) %>%
slice(1:15) %>%
mutate(bigram = reorder(bigram, n)) %>%
ggplot(aes(x = bigram, y = n, fill = bigram)) +
geom_col(show.legend = FALSE) +
coord_flip() +
scale_fill_viridis(discrete = TRUE, option="cividis") +
theme_minimal() +
labs(x = NULL, y = NULL,
title = paste("viel EU, viel Erneuerbare Energien"),
subtitle = ("die häufigsten Bigramme, Angabe der Wortstämme"))
Und wird mit dem Blick auf Trigramme noch mehr deutlich? Leider nicht; “level playing field” ist das häufigste Trigramm; diese Forderung nach gleichen Rahmenbedingungen kommt in mehreren Abschnitten vor. Einen Mehrwert haben wir hier nicht.
trigrams_Koalition <- text_Koalition %>%
unnest_tokens(trigram, text, token = "ngrams", n = 3) %>%
separate(trigram, c("word1", "word2", "word3"), sep = " ") %>%
filter(!word1 %in% custom_stop_words$word,
!word2 %in% custom_stop_words$word,
!word3 %in% custom_stop_words$word) %>%
drop_na(word1) %>%
drop_na(word2) %>%
drop_na(word3) %>%
mutate(word1 = german_stemmer(word1)) %>%
mutate(word2 = german_stemmer(word2)) %>%
mutate(word3 = german_stemmer(word3)) %>%
unite(trigram, word1, word2, word3, sep = " ")
trigrams_Koalition <- trigrams_Koalition[-grep("\\b\\d+\\b", trigrams_Koalition$trigram),] #remove numbers
trigrams_Koalition %>%
count(trigram, sort = TRUE) %>%
slice(1:15) %>%
mutate(trigram = reorder(trigram, n)) %>%
ggplot(aes(x = trigram, y = n, fill = trigram)) +
geom_col(show.legend = FALSE) +
coord_flip() +
scale_fill_viridis(discrete = TRUE, option="cividis") +
theme_minimal() +
labs(x = NULL, y = NULL,
title = paste("gleiche Rahmenbedingungen - auch kein großer Mehrwert"),
subtitle = ("die häufigsten Trigramme, Angabe der Wortstämme"))
Also zurück zu den Bigrammen. Können wir hier Informationen über die einzelnen Kapitel schlussfolgern? Wir bekommen einen guten Einblick; die jeweils häufigsten Begriffe sind angesichts der Thematik aber auch nicht überraschend.
bigrams_Koalition %>%
filter(Kapitel != " ") %>%
group_by(Kapitel) %>%
count(bigram, sort = TRUE) %>%
slice(1:5) %>%
ungroup() %>%
mutate(Kapitel = as.factor(Kapitel), bigram = reorder_within(bigram, n, Kapitel)) %>%
ggplot(aes(x=bigram, y=n, fill=bigram))+
geom_col()+
coord_flip() +
scale_x_reordered() +
scale_fill_viridis(discrete = TRUE, option="cividis") +
facet_wrap(~factor(Kapitel, levels=c("Präambel", "Moderner_Staat", "Klima", "Soziales", "Familie", "Innen",
"Europa", "Finanzen", "Arbeitsweise")), scales="free") +
theme_minimal() +
theme(legend.position="none", panel.grid.major = element_blank(), strip.background = element_blank()) +
labs(x = NULL, y = NULL,
title = paste("die Sicht auf die Kapitel"),
subtitle = ("die häufigsten Wortstämme"))
der Sentimentwert
Bleibt uns noch der Blick auf den Sentimentwert. Wie positiv/negativ wird geschrieben? Hierfür benutze ich das Leipzig Corpora Collection, wie hier beschrieben: https://aufschrieb.blogspot.com/2020/05/sentiment-analyse-von-deutschen-texten.html
library(reshape2)
sentiment1 <- text_Koalition %>%
mutate(text = as.character(text)) %>%
unnest_tokens(word, text) %>%
anti_join(custom_stop_words, by = "word") %>%
left_join(SentiWS_df, by="word") %>%
drop_na() %>%
count(Polarität) %>%
spread(Polarität, n, fill=0) %>%
mutate(score = positive - negative) %>%
mutate(relation = positive/negative)
sentiment1 %>%
select(negative, positive) %>%
melt() %>%
ggplot(aes(x = variable, y = value, fill=variable)) +
geom_col(show.legend = FALSE) +
coord_flip() +
scale_fill_manual(breaks = c("negative", "positive"), values=c("#F4C7A7", "#BBF68F")) +
theme_minimal() +
labs(x = NULL, y = NULL,
title = paste("eine positive Perspektive im Programm"),
subtitle = paste("Verhältnis positiver zu negativer Wörter: ", round(sentiment1$relation,1)))
Aber wie stark positiv oder negativ sind diese Begriffe? Hierzu schauen wir auf den Gesamt-Sentimentscore; Durchschnittswert des Sentiment-Scores der einzelnen Wörter. Wir sehen, dass die vielen positiven Wörter gar nicht so positiv sind; und/oder dass die negativen Wörter sehr stark negativ sind.
sentiment2 <- text_Koalition %>%
mutate(text = as.character(text)) %>%
unnest_tokens(word, text) %>%
anti_join(custom_stop_words, by = "word") %>%
left_join(SentiWS_df, by="word") %>%
drop_na() %>%
summarise(sentiment = mean(sentiment))
sentiment2 %>%
melt(.) %>%
ggplot() +
geom_point(aes(x = value, y=variable)) +
geom_rect(aes(ymin=0.8, ymax=1.2, xmin=-1, xmax=0), fill ="#F4C7A7") +
geom_rect(aes(ymin=0.8, ymax=1.2, xmin=0, xmax=1), fill ="#BBF68F") +
geom_point(aes(x = value, y=variable)) +
theme(axis.ticks.x=element_blank(),
axis.ticks.y=element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
legend.position="none") +
labs(x = NULL, y = NULL,
title = paste("Sentimentwert Koalitionsvertrag", round(sentiment2$sentiment,4)),
subtitle = paste("auf der Skala von -1 bis +1"))
Auch hier können wir die einzelnen Kapitel betrachten:
sentiment2_Kapitel <- text_Koalition %>%
group_by(Kapitel) %>%
mutate(text = as.character(text)) %>%
unnest_tokens(word, text) %>%
anti_join(custom_stop_words, by = "word") %>%
left_join(SentiWS_df, by="word") %>%
drop_na() %>%
summarise(sentiment = mean(sentiment)) %>%
ungroup()
sentiment2_Kapitel %>%
filter(Kapitel != " ") %>%
melt(.) %>%
mutate(Kapitel = factor(Kapitel, levels=c("Arbeitsweise", "Finanzen", "Europa", "Innen", "Familie",
"Soziales", "Klima", "Moderner_Staat", "Präambel"))) %>%
ggplot() +
geom_point(aes(x=value, y=Kapitel)) +
geom_rect(aes(ymin=0.5, ymax=9.5, xmin=-0.25, xmax=0), fill ="#F4C7A7") +
geom_rect(aes(ymin=0.5, ymax=9.5, xmin=0, xmax=0.25), fill ="#BBF68F") +
geom_point(aes(x = value, y=Kapitel)) +
theme(axis.ticks.x=element_blank(),
axis.ticks.y=element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
legend.position="none") +
labs(x = NULL, y = NULL,
title = paste("eine verhältnismäßig positive gemeinsame Arbeitsweise"),
subtitle = paste("auf der Skala von -1 bis +1"))
Wir sehen, dass wir eine erste grobe Einschätzung zum Parteiprogramm bekommen; mehr aber auch nicht. Für weitere Analysen lohnt sich insofern wohl tatsächlich der Blick ins Koalitionsprogramm selbst.