Natural Language Processing
Geschichte als politisches Argument
Maja Lichman
Das Projekt
Ziel dieses Projekts ist die maschinelle Untersuchung deutscher politischer Reden im Hinblick auf die folgenden Fragestellungen:
- Welche geschichtlichen Ereignisse werden besonders häufig in deutschen politischen Reden erwähnt?
- Welche aktuellen Themen tauchen in politischen Reden neben geschichtlichen Themen auf? Oder anders gefragt: Worüber reden Politiker eigentlich, wenn sie über Geschichte sprechen?
Die maschinelle Analyse der Reden wird mithilfe des Structural Topic Model (STM) durchgeführt.
Die politischen Reden, die für die Untersuchung verwendet wurden, stammen aus dem frei zugänglichen Korpus Politische Reden (1982–2020), das im Portal des Digitalen Wörterbuchs der deutschen Sprache (DWDS) verfügbar ist. Dieses Korpus besteht im Wesentlichen aus vier Teilkorpora, die nach den politischen Ämtern der Sprecher unterteilt sind.
Für die Analyse wurden jene Reden herausgefiltert, die sich unter anderem mit geschichtlichen Themen befassen. Nach der Auswahl der Reden erfolgten vor der Anwendung des STM-Verfahrens die üblichen Preprocessing-Schritte, darunter die deutsche Lemmatisierung, sowie die Ermittlung der statistisch optimalen Anzahl zu explorierender Themen.
Nach der Anwendung des STM wurden neben der manuellen Analyse der Themen die folgenden Auswertungen durchgeführt:
- Themenkorrelation: Untersuchung, wie häufig Themen gemeinsam in denselben Dokumenten auftreten.
- Themenverteilung nach Teilkorpora: Ermittlung der Themen, die in den jeweiligen Teilkorpora besonders häufig vorkommen.
- Thementrends: Analyse der Verteilung der Themen im zeitlichen Verlauf.
Import der Pakete:
library(XML)
library(xml2)
library(quanteda)
library(ggplot2)
library(RColorBrewer)
library(udpipe)
library(stm)
library(topicmodels)
library(dplyr)
library(tidytext)
library(purrr)
library(tidyr)
library(writexl)
library(readxl)
library(remotes)
library(tidystm)
library(wordcloud)Erstellung des geschichtsbezogenen Korpus
Das bereits erwähnte Korpus Politische Reden (1982–2020) umfasst insgesamt 15240 Reden. 6685 davon wurden von deutschen Politiker gehalten, welche die vier höchsten Staatsämter innehatten: Bundespräsidenten/-innen, Bundeskanzler/-innen, Bundestagspräsidenten/-innen und Außenminister/-innen. Diese Reden sind in vier Teilkorpora unterteilt.
Die Korpora liegen im XML-Format vor und enthalten neben den
Redetexten auch umfangreiche Metadaten. Zu den Metadaten gehören unter
anderem der Name des Redners oder der Rednerin, das Datum, der Ort, der
Titel und Untertitel der Rede sowie die zugehörige URL. In den
XML-Dateien sind die Reden als Elemente und die Metadaten als Attribute
der jeweiligen Elemente gespeichert.
Die vier Teilkorpora wurden in R geladen und in vier Dataframes
(df1, df2, df3,
df4) umgewandelt. Alle Dataframes enthalten jeweils
fünf Spalten, die folgende Informationen umfassen:
- Text: Den vollständigen Text der Reden.
- Person: Die Namen der Redner oder Rednerinnen.
- Datum: Angaben zum Datum der Rede.
- Titel: Den Titel der Reden.
- Korpus: Den Namen des Teilkorpus, aus dem die Reden stammen.
Laden der Reden:
doc1 <- read_xml("Bundestagspräsidenten.xml")
rows1 <- xml_children(doc1) #ermöglicht Zugriff auf die Attribute
datum1 <- xml_attr(rows1, "datum") #Datum der Reden
person1 <- xml_attr(rows1, "person") #Redner/in
titel1 <- xml_attr(rows1, "titel") #Titel der Rede
elements1 <- xml_find_all(doc1, ".//rohtext") #Text der Rede
element_text1 <- xml_text(elements1) #Rohtext ohne Tags
df1 <- data.frame(Person = person1, Text = element_text1, Datum = datum1, Titel = titel1, Korpus = "Bundestagspräsidenten") #Dataframe mit 5 Spalten
dim(df1)## [1] 383 5Laden der Reden:
doc2 <- read_xml("AuswärtigesAmt.xml")
rows2 <- xml_children(doc2) #ermöglicht Zugriff auf die Attribute
datum2 <- xml_attr(rows2, "datum") #Datum der Reden
person2 <- xml_attr(rows2, "person") #Redner/in
titel2 <- xml_attr(rows2, "titel") #Titel der Rede
elements2 <- xml_find_all(doc2, ".//rohtext") #Text der Rede
element_text2 <- xml_text(elements2) #Rohtext ohne Tags
df2 <- data.frame(Person = person2, Text = element_text2, Datum = datum2, Titel = titel2, Korpus = "AuswährtigesAmt") #Dataframe mit 5 Spalten
dim(df2)## [1] 1274 5Laden der Reden:
doc3 <- read_xml("Bundespräsidenten.xml")
rows3 <- xml_children(doc3) #ermöglicht Zugriff auf die Attribute
datum3 <- xml_attr(rows3, "datum") #Datum der Reden
person3 <- xml_attr(rows3, "person") #Redner/in
titel3 <- xml_attr(rows3, "titel") #Titel der Rede
elements3 <- xml_find_all(doc3, ".//rohtext") #Text der Rede
element_text3 <- xml_text(elements3) #Rohtext ohne Tags
df3 <- data.frame(Person = person3, Text = element_text3, Datum = datum3, Titel = titel3, Korpus = "Bundespräsidenten") #Dataframe mit 5 Spalten
dim(df3)## [1] 2045 5Laden der Reden:
doc4 <- read_xml("Bundesregierung.xml")
rows4 <- xml_children(doc4) #ermöglicht Zugriff auf die Attribute
datum4 <- xml_attr(rows4, "datum") #Datum der Reden
person4 <- xml_attr(rows4, "person") #Redner/in
titel4 <- xml_attr(rows4, "titel")#Titel der Rede
elements4 <- xml_find_all(doc4, ".//rohtext") #Text der Rede
element_text4 <- xml_text(elements4) #Rohtext ohne Tags
df4 <- data.frame(Person = person4, Text = element_text4, Datum = datum4, Titel = titel4, Korpus = "Bundesregierung") #Dataframe mit 5 Spalten
dim(df4)## [1] 2983 5Anschließend wurden die vier Dataframes zu einem einzigen Dataframe namens df zusammengeführt. Dieser enthält weiterhin fünf Spalten und umfasst nun insgesamt 6.685 Zeilen (entsprechend 6.685 Reden). Aus diesem zusammengeführten Korpus wurden anschließend die Reden ausgewählt, die sich mit geschichtlichen Themen befassen.
Zusammenfügung der Reden:
df <- rbind(df1, df2, df3, df4)
dim(df)## [1] 6685 5ggplot(df, aes(x = Korpus)) + geom_bar(width = 0.5, fill = "lightblue", alpha=0.8) +
labs(x = '', y = 'Häufigkeit', caption = "Abbildung 1.") +
geom_text(stat = 'count', aes(label = scales::percent(after_stat(count)/sum(after_stat(count)))), vjust = -0.5, size = 3) +
geom_hline(yintercept = 0, size = 1, colour="#333333") +
theme_minimal() +
theme(legend.position = "none") +
ggtitle("Verteilung der Teilkorpora")
Als nächster Zwischenschritt wurden aus der Spalte Datum mithilfe eines RegEx die Jahreszahlen extrahiert. Diese wurden in einer neuen Spalte namens Jahr im Dataframe df gespeichert. Angaben zu Tag und Monat der Reden wurden dabei nicht berücksichtigt, da sie für die Untersuchung aufgrund des großen Betrachtungszeitraums von 1982 bis 2020 nicht erforderlich sind.
Extraktion der Jahreszahlen:
reg_expression <- '[0-9]{4}' #vierstellige Zahl, genauere Angaben sind in diesem Fall nicht erforderlich
extract.Jahr <- regmatches(df$Datum, regexpr(reg_expression, df$Datum)) #Extraktion
df$Jahr <- as.integer(extract.Jahr) #neue Spalte für Jahreszahlenggplot(df, aes(x = Jahr)) +
geom_histogram(fill = "lightblue", binwidth = 0.5) +
labs(x = "Jahr", y = "Häufigkeit", caption = "Abbildung 2.") +
geom_hline(yintercept = 0, size = 1, colour="#333333") +
ggtitle("Verteilung der Reden") +
theme_minimal()
Ermittlung der geschichtsbezogenen Reden
Für die Untersuchung wurden nicht alle Reden aus dem Dataframe df übernommen, sondern nur jene, die sich mit dem Thema Geschichte befassen. Zur Identifikation solcher Reden wurde ein Dictionary erstellt, das nach Wörtern sucht, die dem übergeordneten Konzept „Geschichte“ zugeordnet werden können. Dieses Dictionary umfasst verschiedene Formen des Wortes Geschichte (z. B. „Weltgeschichte“), Wörter wie historisch, geschichtlich sowie das Wort Vergangenheit.
Diese Methode liefert keine exakten Ergebnisse, da es möglich ist, über geschichtliche Ereignisse zu sprechen, ohne die genannten Begriffe oder ihre Variationen zu verwenden. Ich gehe jedoch davon aus, dass Politiker, die Geschichte als Argument nutzen, diese Begriffe zumindest in vielen Fällen auch explizit in ihren Reden betonen.
Zur Anwendung des Dictionaries wurden folgende Schritte durchgeführt:
- Tokenisierung: Die Reden wurden in einzelne Wörter zerlegt.
- Oberflächliche Bereinigung: Alle Großbuchstaben wurden durch Kleinbuchstaben ersetzt, um die Anzahl der Varianten (z. B. „geschichtlich“ und „Geschichtlich“) zu reduzieren.
- Dokument-Feature-Matrix: Die tokenisierten Reden wurden in eine Dokument-Feature-Matrix (DFM) umgewandelt. Diese Matrix gibt die Häufigkeit aller Wörter an, die in einem Dokument (hier: einer Rede) vorkommen.
Anhand der DFM wurde die Häufigkeit der Wörter, die dem Konzept „Geschichte“ zugeordnet sind, pro Rede ermittelt.
Tokenisierung, Bereinigung und Kleinschreibung:
toks <- tokens(as.character(df$Text),remove_punct = TRUE, remove_symbols = TRUE) #Tokenisierung und (zunächst oberflächliche) Bereinigung der Texte
toks <- tokens_remove(tokens_tolower(toks)) #Kleinschreibung Erstellung des Dictionaries:
d <- list(geschichte = c("geschichte", "*geschichte", "vergangenheit", "geschichtl*", "geschichts*", "historisch*")) #übergeordnetes Konzept Geschichte und die dazugehörigen Wörter
dict <- dictionary(d) #Dictionary
dict## Dictionary object with 1 key entry.
## - [geschichte]:
## - geschichte, *geschichte, vergangenheit, geschichtl*, geschichts*, historisch*Geschichtsbezogene Wörter pro Rede:
dtm_dic <- dfm(toks) %>%
dfm_lookup(dictionary = dict)
print(dtm_dic)## Document-feature matrix of: 6,685 documents, 1 feature (32.00% sparse) and 0 docvars.
## features
## docs geschichte
## text1 10
## text2 12
## text3 3
## text4 7
## text5 12
## text6 10
## [ reached max_ndoc ... 6,679 more documents ]Das Ergebnis der Anwendung des Dictionaries auf die Reden ist eine Dokument-Feature-Matrix (DFM), die ausschließlich die Häufigkeit der Wörter enthält, die dem Konzept “Geschichte” zugeordnet sind.
dtm.dic <- convert(dtm_dic, to = "data.frame") #Umwandlung der DFM in Dataframe
df.neu <- data.frame(df, Geschichte = dtm.dic$geschichte) #df bekommt neue Spalte Geschichte, die die Anzahl der Konzeptwörter pro Rede beinhält
agr_g <- aggregate(df.neu$Geschichte, by = list(Jahr = df.neu$Jahr), FUN = sum) #Summierung der Konzeptwörter 'Geschichte' pro Jahrto.plot <- reshape2::melt(agr_g, id.var = "Jahr") #von wide to long
legend_title <- "Konzeptwörter:"
ggplot(to.plot, aes(x = Jahr, y = value, colour = variable, group = variable)) +
geom_line(linewidth = 0.7) +
geom_hline(yintercept = 0, size = 1, colour="#333333") +
scale_color_manual(legend_title, values = c("darkblue"), labels = c("Geschichte")) +
labs(x = "Jahr", y = "Häufigkeit", caption = "Abbildung 3.") +
ggtitle("Verteilung der Konzeptwörter pro Jahr") +
theme_minimal() 
min(df.neu$Geschichte)## [1] 0max(df.neu$Geschichte)## [1] 94mean(df.neu$Geschichte)## [1] 2.713089Für die Untersuchung wurden die Reden ausgewählt, in denen die Anzahl der Konzeptwörter bei drei oder mehr liegt (dies entspricht einem Wert, der etwas über dem Mittelwert liegt). Ziel dieser Festlegung war es, Texte auszuschließen, in denen geschichtliche Themen nur am Rande erwähnt werden, sowie Texte, in denen das Wort Geschichte eine andere semantische Bedeutung hat (z. B. „Vorfall“ oder „Erzählung“).
Diese Entscheidung basiert auf der zuvor genannten Annahme, dass Politiker, die Geschichte als Argument nutzen, dies in vielen Fällen auch durch eine entsprechende Häufigkeit dieser Begriffe in ihren Reden betonen.
Ausschluss der Reden mit wenigen Konzeptwörtern:
df_geschichte <- df.neu[df.neu$Geschichte >= 3,] # Ausschluss der Reden
dim(df_geschichte)## [1] 2282 7ggplot(df_geschichte, aes(x = Jahr, fill = after_stat(count))) +
geom_histogram(binwidth = 0.5) +
labs(x = "Jahr", y = "Häufigkeit", caption = "Abbildung 4.") +
ggtitle("Verteilung der Reden") +
geom_hline(yintercept = 0, size = 1, colour="#333333") +
theme_minimal() +
theme(legend.position = "none")
Abbildung 4 zeigt die Anzahl der Reden im neuen Korpus df_geschichte pro Jahr. Wie zu erkennen ist, ist das neue Korpus ähnlich unausgewogen wie das ursprüngliche Korpus df (Abb.2). Um eine größere Ausgewogenheit zu erreichen, wurden die Reden aus den Jahren 1983 bis 1996 von der Untersuchung ausgeschlossen.
Ausschluss der Jahre mit wenigen Reden:
df_geschichte <- df_geschichte[df_geschichte$Jahr > 1995, ] #Ausschluss der Reden
dim(df_geschichte)## [1] 2159 7max(df_geschichte$Jahr)## [1] 2017min(df_geschichte$Jahr)## [1] 1996mean(df_geschichte$Geschichte)## [1] 6.447429ggplot(df_geschichte, aes(x = Jahr, fill = after_stat(count))) +
geom_histogram(binwidth = 0.3) +
labs(x = "Jahr", y = "Häufigkeit", caption = "Abbildung 5.") +
ggtitle("Verteilung der Reden im geschichtsbezogenen Korpus") +
theme_minimal() +
geom_hline(yintercept = 0, size = 1, colour="#333333") +
theme(legend.position = "none")
Abbildung 5 zeigt die Verteilung der Reden pro Jahr im Korpus df_geschichte, das nun 2.159 Reden umfasst. Diese Reden stammen aus dem Zeitraum 1996 bis 2017.
ggplot(df_geschichte, aes(x = Korpus, fill = after_stat(count))) + geom_bar(width = 0.5, alpha=0.7) +
labs(x = '', y = 'Häufigkeit', caption = "Abbildung 6.") +
geom_text(stat = 'count', aes(label = scales::percent(after_stat(count)/sum(after_stat(count)))), vjust = -0.5, size = 3) +
geom_hline(yintercept = 0, size = 1, colour="#333333") +
theme_minimal() +
theme(legend.position = "none") +
ggtitle("Verteilung der Teilkorpora im geschichtsbezogenen Korpus")
Bereinigung der Reden
Um die Texte der Reden für das Topic Modelling vorzubereiten, wurden sie zunächst tokenisiert und bereinigt. Anschließend erfolgte die Entfernung von Standard-Stoppwörtern sowie die Durchführung einer deutschen Lemmatisierung. Abschließend wurden spezifische, für politische Reden relevante Stoppwörter aus den Texten entfernt.
Tokenisierung und Bereinigung:
toks_geschichte <- tokens(as.character(df_geschichte$Text), # Tokenisierung
remove_punct = T, #Entfernung der Zeichen
remove_numbers = T, #Entfernung der Zahlen
remove_symbols = T, #Entfernung der Symbole
remove_separators = T) #Entfernung der Trennzeichen
head(toks_geschichte, 4)## Tokens consisting of 4 documents.
## text1 :
## [1] "Der" "du" "von" "dem" "Himmel" "bist"
## [7] "Alle" "Freud" "und" "Schmerzen" "stillest" "Den"
## [ ... and 1,843 more ]
##
## text2 :
## [1] "Sehr" "geehrter" "Herr" "Vorsitzender" "lieber"
## [6] "Peter" "Heesen" "liebe" "Kolleginnen" "und"
## [11] "Kollegen" "aus"
## [ ... and 4,616 more ]
##
## text3 :
## [1] "Sehr" "geehrter" "Herr" "Bundespräsident"
## [5] "Verehrte" "Gäste" "Liebe" "Kolleginnen"
## [9] "und" "Kollegen" "Die" "erneute"
## [ ... and 2,201 more ]
##
## text4 :
## [1] "Sehr" "geehrter" "Herr" "Präsident" "lieber"
## [6] "Wolfgang" "Schulhoff" "sehr" "geehrte" "Frau"
## [11] "Ministerin" "lieber"
## [ ... and 3,740 more ]Entfernung der Stopwörter:
german_stopwords <- stopwords("german")
head(german_stopwords, 20)## [1] "aber" "alle" "allem" "allen" "aller" "alles" "als"
## [8] "also" "am" "an" "ander" "andere" "anderem" "anderen"
## [15] "anderer" "anderes" "anderm" "andern" "anderr" "anders"toks_geschichte <- tokens_remove(toks_geschichte, german_stopwords)
head(toks_geschichte, 4)## Tokens consisting of 4 documents.
## text1 :
## [1] "Himmel" "Freud" "Schmerzen" "stillest" "doppelt"
## [6] "elend" "Doppelt" "Erquickung" "füllest" "Ach"
## [11] "Treibens" "müde"
## [ ... and 955 more ]
##
## text2 :
## [1] "geehrter" "Herr" "Vorsitzender" "lieber"
## [5] "Peter" "Heesen" "liebe" "Kolleginnen"
## [9] "Kollegen" "Parlamenten" "Regierungenund" "öffentlichen"
## [ ... and 2,401 more ]
##
## text3 :
## [1] "geehrter" "Herr" "Bundespräsident" "Verehrte"
## [5] "Gäste" "Liebe" "Kolleginnen" "Kollegen"
## [9] "erneute" "Wahl" "Präsidenten" "Deutschen"
## [ ... and 1,151 more ]
##
## text4 :
## [1] "geehrter" "Herr" "Präsident" "lieber" "Wolfgang"
## [6] "Schulhoff" "geehrte" "Frau" "Ministerin" "lieber"
## [11] "Kollege" "Steinbrück"
## [ ... and 1,881 more ]Deutsche Lemmatisierung
Bei der Lemmatisierung werden alle Wörter eines Textes auf ihre Grundform zurückgeführt, damit sie von der Maschine als zusammengehörig erkannt und einheitlich behandelt werden.
#ud_model <- udpipe_download_model("german") # Modell mit benötigten Wörterbüchern herrunterladen
#ud_model <- udpipe_load_model(ud_model) #Modell in R laden
#toks.character <- sapply(toks_geschichte, paste, collapse = ' ') # eine String-Liste, die eine Wiederzuordnung der lemmatisierten Tokens zu den richtigen Texten ermöglicht
#toks.df <- data.frame(doc.id = 1:length(toks_geschichte), text = toks.character) # df mit Texten und ihren IDs
#x <- udpipe_annotate(ud_model, x = toks.df$text, doc_id = toks.df$doc.id) # Reden mit udpipe annotieren (Lemmas und POS)
#x <- as.data.frame(x) #df
#head(x[, c("token", "lemma", "upos")], 10)
#df.final <- aggregate(lemma ~ doc_id, data = x, FUN = paste, collapse = ' ') # Lemmas werden nach doc_id wieder zusammengefügt
#toks.final <- tokens(as.character(df.final$lemma)) #Lemmas als Tokens
#head(df.final$doc_id) # andere Reihenfolge, weil doc_id ein String ist
#df.final$doc_id <- as.integer(df.final$doc_id) # doc_id zu Integer
#data_ordered <- df.final[order(df.final$doc_id), ] # neu geordnet
#head(data_ordered$doc_id)
#data_stm <- data.frame(Text = data_ordered$lemma, Datum = df_geschichte$Jahr, Korpus = df_geschichte$Korpus) # df für STM, Text und benötigten Metadaten
#save(data_stm, file = "lemma_stm.RData") # die Ergebnisse werden gespeichert, da die Lemmatisierung sehr lange dauertload("lemma_stm.RData")toks_stm <- tokens(data_stm$Text,
remove_punct = T, #Entfernung der Zeichen
remove_numbers = T, #Entfernung der Zahlen
remove_symbols = T, #Entfernung der Symbole
remove_separators = T) # Entfernung der Trennzeichen
head(toks_stm, 4)## Tokens consisting of 4 documents.
## text1 :
## [1] "Himmel" "Freud" "Schmerz" "still" "doppelt"
## [6] "elend" "doppelt" "Erquickung" "füllest" "ach"
## [11] "Treiben" "müde"
## [ ... and 964 more ]
##
## text2 :
## [1] "geehrter" "Herr" "Vorsitzende" "lieb"
## [5] "Peter" "Heesen" "lieb" "Kolleginnen"
## [9] "Kollegen" "Parlamenten" "Regierungenund" "öffentlich"
## [ ... and 2,424 more ]
##
## text3 :
## [1] "geehrter" "Herr" "Bundespräsident" "verehrte"
## [5] "Gäst" "Liebe" "Kolleginnen" "Kollegen"
## [9] "erneut" "Wahl" "Präsident" "deutsch"
## [ ... and 1,162 more ]
##
## text4 :
## [1] "geehrter" "Herr" "Präsident" "lieber" "Wolfgang"
## [6] "Schulhoff" "geehrt" "Frau" "Ministerin" "lieber"
## [11] "Kollege" "Steinbrück"
## [ ... and 1,891 more ]Entfernung der zusätzlichen Stoppwörter:
data_txt <- read.table("weitere_stoppwoerter.txt") # Liste zusätzlicher Stoppwörter einlesen
additional_stopwords <- as.character(data_txt$V1)
head(additional_stopwords, 20)## [1] "a" "allgemein" "and" "antrag" "auch"
## [6] "beachtlich" "beide" "beim" "beispiel" "bekommen"
## [11] "bellevue" "bereich" "bereits" "bestehen" "brauchen"
## [16] "dabei" "dafür" "dame" "damen" "dank"toks_stm <- tokens_remove(tokens_tolower(toks_stm), c(stopwords("de"), additional_stopwords)) #zusätzliche Stoppwörter entfernen
head(toks_stm, 4) ## Tokens consisting of 4 documents.
## text1 :
## [1] "himmel" "freud" "schmerz" "still" "doppelt"
## [6] "elend" "doppelt" "erquickung" "füllest" "ach"
## [11] "treiben" "müde"
## [ ... and 738 more ]
##
## text2 :
## [1] "geehrter" "vorsitzende" "peter" "heesen"
## [5] "parlamenten" "regierungenund" "öffentlich" "verwaltung"
## [9] "verehren" "gast" "bedank" "herzlich"
## [ ... and 1,803 more ]
##
## text3 :
## [1] "geehrter" "bundespräsident" "gäst" "erneut"
## [5] "wahl" "präsident" "bundestag" "hoch"
## [9] "auszeichnung" "verpflichtung" "bewußt" "vier"
## [ ... and 848 more ]
##
## text4 :
## [1] "geehrter" "präsident"
## [3] "wolfgang" "schulhoff"
## [5] "geehrt" "ministerin"
## [7] "steinbrück" "lieben"
## [9] "aktiv" "ehemalig"
## [11] "bundestag" "nordrhein-westfälischen"
## [ ... and 1,429 more ]Structural Topic Modelling
Topic Modelling ist ein Verfahren des unüberwachten maschinellen Lernens, das auf Wahrscheinlichkeitsrechnung basiert und zur Exploration größerer Textsammlungen verwendet wird. Es ermöglicht die eigenständige Erkennung von Mustern in Dokumenten ohne Voraussetzungen wie vordefinierte Kategorien, Annotationen oder Trainingsdaten. Diese Muster, die als Topics bezeichnet werden, bestehen aus Gruppen von Wörtern, die in den Dokumenten besonders häufig gemeinsam vorkommen und vom Nutzer als sinnvolle Themen interpretiert werden können. Die Ermittlung der Topics erfolgt mithilfe des Bag-of-Words-Modells, bei dem ausschließlich die Worthäufigkeit pro Dokument berücksichtigt wird, während syntaktische und grammatikalische Zusammenhänge ignoriert werden.
Das Structural Topic Model (STM) stellt eine Erweiterung der Latent Dirichlet Allocation (LDA) dar, die als eine der bekanntesten Methoden des Topic Modelling gilt. Beide Verfahren basieren auf einem 2-stufigen Clustering. Das Ergebnis der LDA- und STM-Verfahren ist die Zuordnung der Wörter zu den Topics (erste Stufe) sowie die Zuordnung der Topics zu den Dokumenten (zweite Stufe). Ein Dokument kann dabei durch mehrere Topics in unterschiedlichen Anteilen repräsentiert werden. Diese Zuordnungen erfolgen iterativ und algorithmisch, wobei die gemeinsame Likelihood der Themen- und Wortverteilungen maximiert wird.
Die Zuordnung der Wörter zu den Topics wird durch den Parameter β beschrieben. β gibt an, wie wahrscheinlich es ist, dass ein Wort einem bestimmten Topic zugeordnet wird, also wie häufig das Wort gemeinsam mit anderen Wörtern des Topics in Dokumenten auftaucht. Je höher der Wert von β, desto wichtiger ist das Wort für das Topic.
Die Zuordnung der Topics zu den Dokumenten wird durch den Parameter θ beschrieben. θ gibt an, wie stark der Zusammenhang zwischen einem Dokument und einem Topic ist. Ein höherer Wert für θ bedeutet, dass das Dokument stärker von diesem Topic repräsentiert wird.
Der Hauptunterschied zwischen LDA und STM besteht darin, dass beim STM zusätzlich Metadaten (wie Autor, Erscheinungsjahr, Quelle, Geschlecht) in die Berechnung einbezogen werden können. Während LDA die Gleichverteilung der Wörter über alle Dokumente hinweg annimmt, geht man beim STM davon aus, dass in ähnlichen Dokumenten (mit gleichen Metadaten) mit höherer Wahrscheinlichkeit die gleichen Wörter auftreten.
Reduktion der DFM und Einbezug der Metadaten:
dtm_stm <- dfm(toks_stm)
dtm_stm <- dfm_trim(dtm_stm, #Reduktion der DFM
min_docfreq = 0.01,
max_docfreq = 0.5,
docfreq_type = 'prop'
)Für das Topic Modelling-Verfahren müssen die bereits tokenisierten, bereinigten und lemmatisierten Reden in eine Document-Feature-Matrix (DFM) umgewandelt werden. Diese DFM enthält 98.622 Wörter, deren Anzahl reduziert werden kann. So können aus der DFM Wörter ausgeschlossen werden, die entweder besonders häufig oder selten vorkommen und daher zu allgemein oder zu spezifisch für eine sinnvolle Interpretation sind. Zum Schluss werden die Metadaten (Covariate) Jahr und Korpus einbezogen. Es wird angenommen, dass sie auf die Verteilung der Wörter über die Dokumente hinweg haben können.
docvars(dtm_stm, "datum") <- df_geschichte$Jahr #Covariate Jahr
docvars(dtm_stm, "korpus") <- df_geschichte$Korpus #Covariate Korpus
dtm_stm## Document-feature matrix of: 2,159 documents, 7,587 features (94.82% sparse) and 2 docvars.
## features
## docs himmel schmerz still doppelt elend ach treiben müde all lust
## text1 2 1 2 4 2 2 1 1 1 1
## text2 0 0 0 0 0 0 0 0 0 0
## text3 0 0 0 0 0 0 0 0 0 0
## text4 0 0 0 0 1 0 0 0 1 0
## text5 0 0 0 0 0 0 0 1 1 0
## text6 0 0 0 0 0 0 0 0 1 0
## [ reached max_ndoc ... 2,153 more documents, reached max_nfeat ... 7,577 more features ]Bestimmung von K
Zu den zentralen Input-Parametern eines Topic Modells gehören neben den Dokumenten und deren Metadaten auch die Anzahl der Topics (K).
Für die Bestimmung des optimalen K wurden mehrere Modelle mit unterschiedlichen K-Werten berechnet und deren relevante Maßzahlen miteinander verglichen. Die maßgeblichen Maßzahlen sind Semantic Coherence und Exclusivity. Semantic Coherence gibt an, wie häufig die Wörter eines Topics in Dokumenten gemeinsam auftreten, während Exclusivity beschreibt, wie exklusiv die Wörter für ein bestimmtes Topic sind. Exklusive Wörter weisen eine hohe Wahrscheinlichkeit für ein bestimmtes Topic und eine niedrige Wahrscheinlichkeit für andere Topics auf. Die beiden Maßzahlen sind gegensätzlich: Mit steigender Anzahl von K verschlechtert sich Semantic Coherence, während Exclusivity zunimmt.
In diesem Projekt wurden Berechnungen für Modelle mit K-Werten zwischen 10 und 90 durchgeführt.
#many_models <- tibble(K = seq(10, 90, 10)) %>% # reduzierte Anzahl von Modellen
#mutate(model = map(K, ~ stm(documents = dtm_stm, # Texte
#data = docvars(dtm_stm), # Metadaten
#K = .,
#prevalence =~ s(datum) + korpus,
#max.em.its = 75,
#seed = 404,
#init.type = "Spectral",
#verbose = F)))
#save(many_models, file = "Many_models.RData")Maßzahlen Semantic Coherence und Exclusivity:
load("Many_models.RData")
model_scores <- many_models %>%
mutate(exclusivity = map(model, exclusivity),
semantic_coherence = map(model, semanticCoherence, dtm_stm)) %>%
select(K, exclusivity, semantic_coherence)
model_scores %>%
unnest(c(exclusivity, semantic_coherence)) %>%
group_by(K) %>%
summarize(exclusivity = mean(exclusivity),
semantic_coherence = mean(semantic_coherence)) %>% # Mittelwerte pro Modell
ggplot(aes(x = semantic_coherence, y = exclusivity, label = as.factor(K), color = as.factor(K))) +
geom_point() +
geom_text(nudge_x= 0.6, size = 3) +
ggtitle("Bestimmung von K") +
labs(x = "Semantic Coherence", y = "Exclusivity", caption = "Abbildung 10.") +
theme_minimal() +
theme(legend.position = "none")
Laut Abbildung 10 zeigen zwei Modelle mit K-Werten von 30 und 40 besonders gute Ergebnisse. Beide Modelle weisen vergleichsweise hohe Exclusivity-Werte bei gleichzeitig hohen Semantic Coherence-Werten auf.
Eine weitere Maßzahl, die im Rahmen der Bestimmung des optimalen K ermittelt werden kann, ist Robustness. Dieser Wert gibt an, wie ähnlich die Modellergebnisse (also die Topics) für verschiedene K-Werte sind. Je höher der Wert, desto ähnlicher bzw. stabiler sind die Modellergebnisse. Die Robustness wird anhand der Änderungsrate der Topic-Document-Zuordnung gemessen.
Maßzahl K-Robust:
#fm <- vector()
#k.cand <-seq(20,90,10)
#start.time <- Sys.time()
#for(k in 1:(length(k.cand)-1) ){
#if(k == 1){
#model <- stm(
#documents = dtm_stm,
#data = docvars(dtm_stm),
#K = k.cand[k],
#prevalence =~ s(datum) + korpus,
#max.em.its = 75,
#seed = 404,
#init.type = "Spectral",
#verbose = F)
#theta <- data.frame(model$theta)
#theta$max <- apply(theta, 1, which.max)
#}
#k2 <- k + 1
#model <- stm(
#documents = dtm_stm,
#data = docvars(dtm_stm),
#K = k.cand[k2],
#prevalence =~ s(datum) + korpus,
#max.em.its = 75,
#seed = 4023330,
#init.type = "Spectral",
#verbose = F)
#theta2 <- data.frame(model$theta)
#theta2$max <- apply(theta2, 1, which.max)
#cat(k, k.cand[k], ncol(theta), '\n')
#cat(k2, k.cand[k2], ncol(theta2), '\n')
#fm[k] <- dendextend::FM_index_R(theta$max, theta2$max, assume_sorted_vectors = TRUE)
#theta <- theta2
#}
#df_robust <- data.frame(FM.Index = fm, K = k.cand[-length(k.cand)] )
#save(df_robust, file = "Robust_K.RData")load("Robust_K.RData")
ggplot(data=df_robust, aes(x=K, y=FM.Index)) +
geom_line(color = "red") +
geom_point(color = "red") +
ggtitle("K-Robust") +
geom_hline(yintercept = 0.5, size = 1, colour="#333333") +
labs(x = "Anzahl der Topics (K)", caption = "Abbildung 11.") +
theme_minimal()
Abbildung 11 zeigt, dass die größte Ähnlichkeit der Topics (und damit auch die Stabilität der Modelle) bei einem K-Wert von 60 erreicht wird. Die Robustness beträgt hier etwa 0,72. Ein lokales Maximum des Robustness-Wertes wird bei K-Werten von 40 und 80 erreicht, mit Werten von etwa 0,625 bzw. 0,66. Diese Werte geben an, wie viele Topics (d.h. 72%, 62,5% und 66%) von Modell zu Modell „vererbt“ werden.
Um jedoch eine endgültige Entscheidung bezüglich des K-Wertes zu treffen, ist auf jeden Fall auch ein manueller Vergleich verschiedener Modelle erforderlich. Die aus meiner Perspektive besseren Ergebnisse – d.h. die relativ leicht interpretierbaren Topics – lieferte das model_40, also das Modell mit dem K-Wert von 40. Die Modelle mit höheren K-Werten (also model_60 und model_80) ermittelten zwar die gleichen Topics wie model_40, aber die neu hinzugefügten Topics waren oft schwer interpretierbar oder stellten nur eine unerwünschte Feingliederung der bereits vorhandenen Topics dar. Aus diesem Grund wurde model_40, welche auch die relativ guten Semantic Coherence- und Exclusivity-Werte aufwies, für die Untersuchung ausgewählt.
Erstellung des Modells mit K = 40
#final_model_40 <- stm(
#documents = dtm_stm, #Dokumente
#data = docvars(dtm_stm), # Metadaten
#K = 40, # Anzahl von K
#prevalence =~ s(datum) + korpus,
#max.em.its = 75, # maximale Anzahl der Iterationen
#seed = 4023330,
#init.type = "Spectral", # um deterministische Ergebnisse zu bekommen
#verbose = F)
#save(final_model_40, file = "final_modell_40.RData") # Speicherung der ErgebnisseErgebnisse
Probs und Frex
load("final_modell_40.RData")
l <- labelTopics(final_model_40, topics = 40, n = 10)
prob <- list() #Wörter nach ß geordnet, d.h. wie wichtig ist ein Wort für das Topic
frex <- list() #Wörter, die für das Topic exclusiv sind, d. h. kommen in anderen Topics relativ selten vor
for(i in c(1:40)){
prob[[i]] <- paste(l$prob[i,], collapse = ' ')
frex[[i]] <- paste(l$frex[i,], collapse = ' ')
}
topic_labels <- data.frame(Prob = unlist(prob), Frex = unlist(frex), Topics = 1:40)
head(topic_labels)## Prob
## 1 kultur auswärtig institut kulturell amt goethe lateinamerika bildung außenpolitik austausch
## 2 gewalt flüchtling terrorismus terror sicherheit schutz antisemitismus terrorist anschlag kampf
## 3 arbeitsplatz mark d notwendig bundesregierung zahl million sozial chance wirtschaft
## 4 glauben krise unternehmen marktwirtschaft wirtschaft sozial glaub stelle bundesrepublik erreichen
## 5 kind bürger lernen erleben familie all schule helfen unterschiedlich kennen
## 6 union eu mitgliedstaat bürger kommission vertrag parlament rat bürgerinnen krise
## Frex
## 1 auswärtig institut lateinamerika goethe bildungspolitik kulturpolitik amt italien ausland spanien
## 2 terrorist anschlag flüchtling terrorismus terror migration gewalt haß flüchtlingen antisemitisch
## 3 mark d arbeitsplatz steuerreform dollar arbeitslosigkeit sozialstaat betrieb standort selbständigkeit
## 4 saarland marktwirtschaft bank glaub anbelangen produkt nachhaltigkeit anschauen krise ansonsten
## 5 kind eltern schüler gefühl bundespräsident erzählen einheimisch einwanderung hören angst
## 6 mitgliedstaat eu kommission union präsidentschaft lissabon binnenmarkt rat vertrag brüssel
## Topics
## 1 1
## 2 2
## 3 3
## 4 4
## 5 5
## 6 6Zunächst wurden die Ergebnisse der Berechnung in einer Excel-Tabelle gespeichert. In den Zeilen sind die einzelnen Topics aufgeführt. In der Spalte Prob befinden sich die dem Topic zugehörigen Wörter, die nach dem Parameter β geordnet sind, d. h. nach der Wichtigkeit der Wörter für das Topic. In der Spalte Frex stehen die Wörter, die exklusiv für das Topic sind, also in diesem Topic besonders häufig auftreten und in anderen Topics dagegen selten vorkommen. Die Spalte Topics enthält die Nummerierung der einzelnen Topics. Anschließend habe ich die Spalte TopicLabels manuell hinzugefügt, in der die Namen der Topics eingetragen wurden.
#write_xlsx(topic_labels, paste('Description_40.xlsx', sep = ''))doc_gamma <- tidy(final_model_40, matrix = "gamma", document_names = dtm_stm$meta$title)terms <- labelTopics(final_model_40)
names(terms)## [1] "prob" "frex" "lift" "score" "topicnums"top_terms <- tibble(topic = terms$topicnums,
prob = apply(terms$prob, 1, paste, collapse = ", "),
frex = apply(terms$frex, 1, paste, collapse = ", "))
gamma_by_topic <- doc_gamma %>%
group_by(topic) %>%
summarise(gamma = mean(gamma)) %>%
arrange(desc(gamma)) %>%
left_join(top_terms, by = "topic") %>%
mutate(topic = paste0("Topic ", topic),
topic = reorder(topic, gamma))Unten ist die Auflistung der Topics zu sehen (Abbildungen 12 und 13), die nach ihrer Prävalenz geordnet sind. Die Labels der Balken repräsentieren die Werte Prob (Abb.12) und Frex (Abb. 13), die nach dem Parameter β (d. h. der Wichtigkeit für das Topic) geordnet sind.
gamma_by_topic %>%
ggplot(aes(topic, gamma, label = prob, fill = gamma)) +
geom_col(show.legend = FALSE) +
geom_text(hjust = 0, nudge_y = 0.0005, size = 3) +
coord_flip() +
scale_fill_gradient(low = "navy", high = "darkred") +
scale_y_continuous(expand = c(0, 0), limits = c(0, 0.11), labels = scales::percent) +
theme_minimal() +
theme(panel.grid.minor = element_blank(),
panel.grid.major = element_blank()) +
labs(x = NULL, y = expression(gamma), caption = "Abbildung 13.") +
ggtitle("Topic-Prevalence mit Probs")
gamma_by_topic %>%
ggplot(aes(topic, gamma, label = frex, fill = gamma)) +
geom_col(show.legend = FALSE) +
geom_text(hjust = 0, nudge_y = 0.0005, size = 3) +
coord_flip() +
scale_y_continuous(expand = c(0, 0), limits = c(0, 0.11), labels = scales::percent) +
theme_minimal() +
theme(panel.grid.minor = element_blank(),
panel.grid.major = element_blank()) +
labs(x = NULL, y = expression(gamma), caption = "Abbildung 12.") +
ggtitle("Topic-Prevalence mit Frex")
Mit Wordclouds können die wichtigsten Wörter der einzelnen Topics visualisert werden.
topic_terms <- tidy(final_model_40, matrix = "beta") %>%
filter(topic == 19) %>% # Filter für das erste Topic
arrange(desc(beta))
gradient_colors <- colorRampPalette(c("skyblue", "navy"))(50)
wordcloud(words = topic_terms$term, freq = topic_terms$beta, scale = c(3, 0.3), max.words = 30, colors = gradient_colors)
title(main = "Topic 19. Regulierung des Arbeitsmarktes", xlab = "Abbildung 14.")
topic_terms <- tidy(final_model_40, matrix = "beta") %>%
filter(topic == 15) %>% # Filter für das erste Topic
arrange(desc(beta))
gradient_colors <- colorRampPalette(c("skyblue", "navy"))(50)
wordcloud(words = topic_terms$term, freq = topic_terms$beta, scale = c(3, 0.3), max.words = 30, colors = gradient_colors)
title(main = "Topic 19. Deutsche Diktaturen", xlab = "Abbildung 15.")
topic_terms <- tidy(final_model_40, matrix = "beta") %>%
filter(topic == 25) %>% # Filter für das erste Topic
arrange(desc(beta))
gradient_colors <- colorRampPalette(c("skyblue", "navy"))(50)
wordcloud(words = topic_terms$term, freq = topic_terms$beta, scale = c(3, 0.3), max.words = 30, colors = gradient_colors)
title(main = "Topic 25. USA", xlab = "Abbildung 16.")
Benennung der Topics:
labels <- read_excel("TopicDescription_40.xlsx") # Tabelle mit Topic-Namen einlesen
df_labels <- data.frame(Topics = labels$Topics, TopicLabel = labels$TopicLabels)
head(df_labels, 10)## Topics TopicLabel
## 1 1 Kultur: Internationaler Austausch
## 2 2 Terrorismus
## 3 3 Wirtschaftliche Stabilität
## 4 4 Wirtschaftskrise
## 5 5 Kinder: Bildung und Integration
## 6 6 EU: Allgemein
## 7 7 Forschung und Lehre
## 8 8 EU: Kulturelle Identität
## 9 9 Festreden
## 10 10 HolocaustNach der manuellen Benennung der Topics wurden diese den übergeordneten Themenbereichen zugeordnet. Einige Topics wurden mehreren Themenbereichen zugeordnet. Die Topics 27, 36 und 39 wurden nicht weiter berücksichtigt und aus den Analysen ausgeschlossen, da sie schwer zu interpretieren waren. Ebenfalls ausgeschlossen wurde das Topic 9 (Festreden), da es sich häufig auf Geburtstagsreden bezog. Die sieben übergeordneten Themenbereiche sind: Geschichte, Wirtschaft, EU, Ausland, Konflikte, Kultur und Sozialer Frieden.
Geschichte: Topic 10: Holocaust, Topic 15: Deutsche Diktaturen, Topic 18: Weltkriege, Topic 23: Sinti und Roma: Völkermord, Topic 24: Jüdisch-Deutsche Geschichte, Topic 26: DDR: Widerstand, Topic 28: NS: Widerstand, Topic 30: Osteuropa: Vertreibung, Topic 32: Reformation
Wirtschaft: Topic 3: Wirtschaftliche Stabilität, Topic 4: Wirtschaftskrise, Topic 12: EU: Wirtschaft, Topic 19: Regulierung des Arbeitsmarktes, Topic 20: Festreden: EU-Wirtschaft
EU:, Topic 6: EU: Allgemein, Topic 8: EU: Kulturelle Identität, Topic 12: EU: Wirtschaft, Topic 20: Festreden: EU-Wirtschaft
Ausland: Topic 1: Kultur: Internationaler Austausch, Topic 13: Russland, Topic 16: Frankreich, Topic 21: Internationale Beziehungen, Topic 25: USA, Topic 29: Globalisierung, Topic 33: Konflikte: Afghanistan, Kosovo, Topic 35: Konflikte: Syrien, Ukraine, Topic 37: Israel
Konflikte: Topic 2: Terrorismus, Topic 33: Konflikte: Afghanistan, Kosovo, Topic 35: Konflikte: Syrien, Ukraine, Topic 37: Israel
Kultur: Topic 1: Kultur: Internationaler Austausch, Topic 7: Forschung und Lehre, Topic 8: EU: Kulturelle Identität, Topic 11: Massenmedien, Topic 17: Kulturelles Erbe, Topic 31: Deutsche Literatur, Topic 38: Kulturelles Leben, Topic 40: Denkmalpflege
Sozialer Frieden: Topic 2: Terrorismus, Topic 5: Kinder: Bildung und Integration, Topic 14: Stabilität der Demokratie, Topic 22: Islam: religiöse Toleranz, Topic 34: Familie und Intergenerationalität
Korrelation der Topics
Als nächster Schritt der Untersuchung wurden die Themenkorrelationen ermittelt, d. h. es wird angeschaut wie häufig die Themen gemeinsam in Dokumenten auftreten. Die Themenkorrelation wurde anhand der heatmap visualisiert. Die dunkelblauen Rechtecke kennzeichnen die Themencluster.
corr <- cor(final_model_40$theta[, 1:40])
dissimilarity <- 1 - corr
dist_mat <- as.dist(dissimilarity)
colnames(corr) <- paste(df_labels$Topics, df_labels$TopicLabel, sep = ".")
rownames(corr) <- paste(df_labels$Topics, df_labels$TopicLabel, sep = ".")
diag(corr) <- 0
corrplot::corrplot(corr, order = "hclust",
hclust.method = "complete",
is.corr=FALSE,
method="color",
cl.pos = "b",
addrect = 8,
tl.cex = .45,
tl.col = "black",
rect.col = "darkblue",
rect.lwd = 2,
col = colorRampPalette(c("darkred","white","midnightblue"))(100))
Verteilung der Topics in Korpora
In diesem Schritt wurde untersucht, welche geschichtsbezogenen Themen in welchen vier Teilkorpora besonders oft auftauchen. Dafür wurden die Funktionen estimateEffect und extract.estimateEffect verwendet.
prep <- estimateEffect(1:40 ~ korpus, final_model_40, meta = docvars(dtm_stm), uncertainty = "None")
effect_40 <- extract.estimateEffect(prep, "korpus", method = "pointestimate") # Extraktion der Estimates-Werte
effect_40$Topics <- as.numeric(effect_40$topic) # neue Spalte mit Topic-Nummer
effect_40 <- merge(effect_40, df_labels, by = 'Topics') # Zusammenfügung der Data Frames
effect_40$Label <- paste(effect_40$Topics, effect_40$TopicLabel, sep = ". ") #neue Spalte mit Topic-Nummer und Topic-Name
ggplot(effect_40, aes(x = Label, y = estimate, group = covariate.value, color = covariate.value)) +
geom_point(size = 2) +
geom_smooth(se = FALSE) +
labs(x = "", y = "Estimate", caption = "Abbildung 17.") +
ggtitle("Verteilung der Topics in Korpora") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "bottom",legend.title=element_blank())
Thementrends
Zuletzt wurde untersucht, wie sich die Topics im Laufe der Zeit verhalten.
theta.df <- as.data.frame(cbind(docvars(dtm_stm)$datum, final_model_40$theta))
colnames(theta.df) <- c("datum", paste("topic.",1:40, sep = ""))
theta.df <- aggregate(.~datum, FUN = mean, data = theta.df) # theta-Mittelwerte pro Jahr
k <- 40
theta.df <- as.data.frame(t(theta.df[,2:(k+1)]))
colnames(theta.df) <- 1996:2017
theta.df$topic <- rownames(theta.df)
curve.df.long <- reshape2::melt(theta.df, id.vars = c("topic"))
colnames(curve.df.long) <- c("Topic","Jahr","avg.theta")
curve.df.long$Topics <- as.numeric(stringr::str_extract(curve.df.long$Topic, "\\d+"))
curve.df.long <- merge(curve.df.long, df_labels, by = 'Topics')
curve.df.long$Label <- paste(curve.df.long$Topics, curve.df.long$TopicLabel, sep = ". ")
curve.df.long$Jahr <- as.numeric(as.character(curve.df.long$Jahr))select <- c(10, 15, 18, 23, 24, 26, 28, 30, 32)
ggplot(curve.df.long[curve.df.long$Topics %in% select,],
aes(x = Jahr, y = avg.theta, group = Label, colour = Label)) +
geom_line(linetype = "solid") +
ggtitle("Geschichte") +
theme_minimal() +
theme(legend.position="none") +
labs(y = 'Häufigkeit', caption = "Abbildung 18.") +
geom_hline(yintercept = 0, size = 1, colour="#333333") +
facet_wrap(.~Label)
select <- c(3, 4, 12, 19, 20)
ggplot(curve.df.long[curve.df.long$Topics %in% select,],
aes(x = Jahr, y = avg.theta, group = Label, colour = Label)) +
geom_line(linetype = "solid") +
ggtitle("Wirtschaft") +
theme_minimal() +
theme(legend.position="none") +
geom_hline(yintercept = 0, size = 1, colour="#333333") +
labs(y = 'Häufigkeit', caption = "Abbildung 19.") +
facet_wrap(.~Label)
select <- c(13, 16, 21, 29, 33, 35, 37, 6)
ggplot(curve.df.long[curve.df.long$Topics %in% select,],
aes(x = Jahr, y = avg.theta, group = Label, colour = Label)) +
geom_line(linetype = "solid") +
ggtitle("Ausland") +
theme_minimal() +
theme(legend.position="none") +
labs(y = 'Häufigkeit', caption = "Abbildung 20.") +
geom_hline(yintercept = 0, size = 1, colour="#333333") +
facet_wrap(.~Label) 
select <- c(1, 7, 8, 11, 17, 31, 38, 40)
ggplot(curve.df.long[curve.df.long$Topics %in% select,],
aes(x = Jahr, y = avg.theta, group = Label, colour = Label)) +
geom_line(linetype = "solid") +
ggtitle("Kultur") +
theme_minimal() +
theme(legend.position="none") +
labs(y = 'Häufigkeit', caption = "Abbildung 21.") +
facet_wrap(.~Label) 
select <- c(2, 5, 14, 22, 34)
ggplot(curve.df.long[curve.df.long$Topics %in% select,],
aes(x = Jahr, y = avg.theta, group = Label, colour = Label)) +
geom_line(linetype = "solid") +
ggtitle("Sozialer Frieden") +
theme_minimal() +
theme(legend.position="none") +
geom_hline(yintercept = 0, size = 1, colour="#333333") +
labs(y = 'Häufigkeit', caption = "Abbildung 22.") +
facet_wrap(.~Label)
Fazit
Im Rahmen der Untersuchung des Korpus df_geschichte wurden insgesamt 40 Topics identifiziert, von denen vier aus der Analyse ausgeschlossen wurden. Neun dieser Topics aus dem Themenbereich Geschichte – Holocaust, Deutsche Diktaturen, Weltkriege, DDR: Widerstand, NS: Widerstand, Deutsch-Jüdische Geschichte, Osteuropa: Vertreibung, Reformation und Sinti und Roma: Völkermord – befassen sich (mit Ausnahme der Reformation) mit negativen historischen Ereignissen. Die ersten drei für das Korpus besonders relevanten Topics sind höchstwahrscheinlich mit Reden verbunden, in denen die traditionelle Erinnerungskultur gepflegt wird. Die übrigen Topics stammen vermutlich aus eher zweckgebundenen Reden, die aktuelle gesellschaftliche und politische Themen ansprechen. Dies lässt sich an häufig in diesen Topics vorkommenden Begriffen wie Toleranz, Einheit, Demokratie und Dialog ablesen.
Das angewandte Clustering-Verfahren hat insbesondere gezeigt, dass das geschichtsbezogene Topic Deutsch-Jüdische Geschichte oft mit den aktuellen Topics Terrorismus und Israel sowie das Topic Konflikte: Syrien, Ukraine (jedoch nicht mit Konflikte: Afghanistan, Kosovo) häufig zusammen in Dokumenten vorkommen. Zusätzlich bildet eine Clusterbildung der aktuellen Topics Islam: religiöse Toleranz, Terrorismus, Stabilität der Demokratie, und Kinder: Bildung und Integration mit geschichtlichen Topic Reformation eine thematische Einheit. Dies könnte darauf hindeuten, dass Politiker historische religiöse Konflikte, die erfolgreich gelöst wurden, als Vorbilder für die Bewältigung gegenwärtiger (teilweise religiös motivierter) Konflikte betrachten.
Die 27 aktuellen (nicht geschichtsbezogenen) Topics lassen sich in sechs Hauptkategorien unterteilen: EU, Ausland, Konflikte, Kultur, Wirtschaft und Sozialer Frieden. Eine genauere Analyse der Topic-Trends zeigt jedoch, dass die Themen aus dem Bereich Wirtschaft in den Reden relativ selten auftreten. Zudem ist zu beachten, dass die Kultur-Themen oft “naturgemäß” mit den geschichtsbezogenen Topics verknüpft sind, was sich beispielsweise an den Themen Denkmalpflege, Kulturelles Erbe oder Kulturelle Identität zeigt.
Die verbleibenden aktuellen Themen aus den vier Bereichen EU, Ausland, Konflikte und Sozialer Frieden erscheinen dagegen relativ häufig und regelmäßig in den geschichtsbezogenen Reden der Politiker. Auf den ersten Blick handelt es sich um alltägliche Themen, die von Politikern häufig aufgegriffen werden und für die breite Öffentlichkeit von Bedeutung sind. Weitere Einsichten könnten jedoch gewonnen werden, wenn das gesamte Korpus (einschließlich der nicht nach geschichtsbezogenen Reden gefilterten Dokumente) zu Vergleichszwecken untersucht wird. Ein Vergleich der Ergebnisse, insbesondere der Themenzusammensetzung, der allgemeinen Ausrichtung und der Gewichtung der gleichen oder ähnlichen Topics in beiden STM-Untersuchungen, würde eine tiefere Analyse ermöglichen.
Quellen
Barbaresi, Adrien (2018): A corpus of German political speeches from the 21st century. In: Proceedings of the Eleventh International Conference on Language Resources and Evaluation (LREC 2018). European Language Resources Association (ELRA). S. 792–797. Link
Roberts, Margaret/Stewart, Brandon/Tingley, Dustin (2019): stm: An R Package for Structural Topic Models. In: Journal for Statistical Software (91). S. 1-40.
Unkel, Julian: Computational Methods in der politischen Kommunikationsforschung. Methodische Vertiefung. Computational Methods mit R und RStudio. Link