maschinelles_lernen.Rmd

---
title: "Automatisierte Inhaltsanalyse mit R"
author: "Cornelius Puschmann"
subtitle: Überwachtes Maschinelles Lernen
output: html_notebook
---

<!---
Todos
* Zeit-SML: Titel durch Volltexte ersetzen?
* MdB-SML: Split in Traings- und Testset?
* Scaling Models: textmodel_affinity mit Twitterdaten und Unterscheidung Trumo v. Clinton
-->

Das [überwachte maschinelles Lernen](https://de.wikipedia.org/wiki/%C3%9Cberwachtes_Lernen) beinhaltet solche Verfahren, mit denen sich verlässliche Regeln aus manuell kategorisierten Inhaltsdaten ableiten lassen, mit deren Hilfe anschließend auch unannotierte Daten ausgewertet können. Konkret wird zunächst eine konventionelle händische Inhaltsanalyse durchgeführt, innerhalb derer menschliche Kodierer auf Grundlage eines Codebuchs ein Sample von Texten einer oder mehreren Kategorien zuordnen (kodieren). Anschließend werden die Features dieses Texte ausgewertet -- häufig sind das alle verwendeten Wörter, es können aber auch nur bestimmte Begriffe, N-Gramme, oder komplexere Muster, wie bspw. unterschiedliche Satztypen zugrunde gelegt werden.

Man spricht deshalb von *überwachtem* oder *geleitetem* Lernen, weil sich anhand der bereits annotierten Daten überprüfen lässt, inwiefern die Qualität der automatisierten Analyse mit der einer manuellen Annotation mithalten kann.

Aus diesem Umstand lässt sich bereits ein zentraler Vorteil des überwachten Lernens ableiten: gegenüber meschlichen Kodierern ist der Computer einerseits schneller und andererseits auch reliabler, aber nur dann, wenn sich aus den für das Lernen eingesetzen Informationen (den sog. Trainingsdaten) auch zuverlässige Regeln ableiten lassen. Ist dies nicht der Fall, sind die Ergebnisse alles andere als beeindruckend. 

Wofür lässt sich geleitetes maschinelles Lernen mit Bezug auf Textdaten einsetzen? Grundsätzlich sind die im folgenden beschriebenen Verfahren für mindestens vier unterschiedliche Anwendungsfälle relevant:

* automatisierte Klassifikation von un-annotiertem Material in Kombination mit einer bereits durchgeführten manuellen Inhaltsanalyse;
* Validierung einer manuellen Inhaltsanalyse;
* Klassifikation anhand von Kategorien, die eigentlich keine klassischen Inhaltsanalysekategorien sind, aber als solche verwendet werden können (etwa das Ressort eines Zeitungsartikels);
* um ein Verständnis darüber gewinnen, welche Faktoren auf welche Art und Weise zu einem Klassifikationsergebnis beitragen.

Eine Reihe von Algorithmen stehen zur Verfügung, um solche Analysen durchzuführen. Grundsätzlich benötigen wir immer einen bereits annotierten Datensatz, um ein Modell zu entwicklen, wobei sowohl die Qualität der Annotation als auch die Größe des Datensatzes ausreichend sein müssen, um eine zuverlässige Automatisierung zu ermöglichen.

Wieder beginnen wir damit, die notwendigen Bibliotheken zu laden. Dieser Schritt enthält hier das Paket [RTextTools](https://cran.r-project.org/package=RTextTools), welches eine Reihe von Algorithmen sowie Funktionen für die Bewertung der Klassifikationsgenauigkeit bereithält. 

```{r Installation und Laden der benötigten R-Bibliotheken, message = FALSE}
if(!require("quanteda")) {install.packages("quanteda"); library("quanteda")}
if(!require("tidyverse")) {install.packages("tidyverse"); library("tidyverse")}
if(!require("e1071")) {install.packages("e1071"); library("e1071")}
if(!require("gridExtra")) {install.packages("gridExtra"); library("gridExtra")}
if(!require("urltools")) {install.packages("urltools"); library("urltools")}
theme_set(theme_minimal())
```

### Ein erster Gehversuch mit dem Bayes-Klassifikator

```{r Ein künstliches Beispiel}
txt <- c(d1 = "Peter Paul Peter",
         d2 = "Peter Peter Andreas",
         d3 = "Peter Michael",
         d4 = "Stefanie Julia",
         d5 = "Julia Johanna Peter",
         d6 = "Peter Peter Julia Johanna Johanna")
trainingset <- dfm(txt, tolower = FALSE)
trainingclass <- factor(c("M", "M", "M", "F", "F", NA), ordered = TRUE)
```

```{r Modellzusammenfassung}
tmod1 <- textmodel_nb(trainingset, y = trainingclass, prior = "docfreq")
summary(tmod1)
```

```{r Koeffizienten}
coef(tmod1)
```

```{r Vergleich von Daten und Vorhersage}
as.character(trainingclass)
as.character(predict(tmod1))
```


### Bayes-Klassifikation von Artikeln aus dem New York Times-Korpus

Wir laden zunächst das [New York Times Headline Corpus](http://www.amber-boydstun.com/supplementary-information-for-making-the-news.html) (Boydstun, 2013), welches eine gute Grundlage für eine erste Demonstration des überwachten Lernens darstellt, weil es sehr zuverlässig annotiert ist und zugleich eine große Datengrundlage liefert. Basis der Analyse ist die Kurzzusammenfassung des Artikels (nicht der Volltext), die je nach Beitrag unterschiedlich informativ ausfallen kann. Zusätzlich enthält jede Zeile eine Zahl, welche die Kategorie bezeichnet, welcher der Beitrag zugeordnet wurde.

```{r Laden des New York Times-Korpus}
load("daten/nytimes/nyt.korpus.RData")
as.data.frame(korpus.nyt.stats)
```

Für die bessere Interpretierbarkeit der Ergebnisse lesen wir zudem einen einfachen Datensatz ein, welcher die schriftlichen Bezeichnungen der numerischen Themen-Codes enthält.

```{r Laden der Inhaltsanalyse-Kategorie-Labels}
labels.kategorien <- scan("daten/nytimes/majortopics2digits.txt", what = "char", sep = "\n", quiet = T)
labels.kategorien <- data.frame(Kategorie = as.character(1:length(labels.kategorien)), Label = labels.kategorien, stringsAsFactors = F)
labels.kategorien
```

Wieder einmal erstellen wir eine Dokument-Feature-Matrix (DFM). Da es sich bei den Texten um Kurzzusammenfassungen handelt, müssen kaum Features entfernt werden. 

```{r DFM für New York Times-Daten vorbereiten}
dfm.nyt <- dfm(korpus.nyt, remove_numbers = TRUE, remove_punct = TRUE, remove = stopwords("english"))
dfm.nyt
```

Auch diese DFM wird reduziert. Die Reduktion ist hier relativ stark angesetzt, um den Trainingsprozess bei einem zufriedenstellenden Ergebnis schnell durchführen zu können. Bei einem Forschungsprojekt oder einer Abschlussarbeit ist es hingegen kein Problem, wenn die Berechnung des Modells mehrere Stunden in Anspruch nimmt. Auch bei einer richtigen Analyse sollte getestet werden, mit welcher Feature-Dichte sich ein optimales Ergebnis erzielen lässt. 

```{r DFM für New York Times-Daten trimmen}
dfm.nyt.trim <- dfm_trim(dfm.nyt, min_docfreq = 0.0005, docfreq_type = "prop")
dfm.nyt.trim
```

Zunächst wenden wie ein vergleichsweise einfaches Verfahren an, nämlich eine sog. [Bayes-Klassifikation](https://de.wikipedia.org/wiki/Bayes-Klassifikator). Diese ist einfach in dem Sinne, dass ihre Berechnung kaum Zeit bzw. Rechenleistung in Anspruch nimmt, sich das Ergebnis aber durchaus sehen lassen kann. Das Verfahren kann mit der quenteda-Funktion [textmodel_nb](https://docs.quanteda.io/reference/textmodel_nb.html) direkt angewandt werden, während wir für die anderen hier vorgestellten Verfahren auf RTextTools zurückgreifen müssen.

Die Anwendung der Klassifikation erfolgt mit Hilfe des Befehls textmodel_nb. Dieser erwartet als seine Argumente eine DFM, eine Liste mit Labels (in unserem Fall das Feld "Topic_2digit", welches den Zahlencode der manuellen Kodierung enthält), sowie eine A-priori-Verteilung. Letzteres meint die Häufigkeit des Auftretens der einzelnen Kategorien im Datensatz. Die mit dem Befehl head angezeigten Codes sind hier dementsprechend die Vorhersage, die der Algorithmus auf Grundlage seines Trainings für die Testdaten trifft.

```{r Naive-Bayes-Klassifikation durchführen und Vorhersage mit manueller Kodierung vergleichen}
modell.NB <- textmodel_nb(dfm.nyt.trim, korpus.nyt.stats$Topic_2digit, prior = "docfreq")
head(as.character(predict(modell.NB)), 50)
head(as.character(korpus.nyt.stats$Topic_2digit), 50)
```

Wie viele der Texte wurden korrekt klassifiziert, d.h. stimmen mit der manuellen Kodierung überein? Wir gehen später noch genauer darauf ein, wie sich die Qualität der Kodierung noch etwas genauer messen lässt, aber für einen erste Eindruck genügt uns die einfache Übereinstimmung der Vorhersage mit der manuellen Kodierung in Prozent.

```{r Prozentanteil der korrekt klassifizierten Schlagzeilen bestimmen}
prop.table(table(predict(modell.NB) == korpus.nyt.stats$Topic_2digit))*100
```

Handelt es sich hierbei um ein gutes Ergebnis? Um diese Frage beantworten zu könnnen vergleichen wir das Resultat mit einem Zufallsergebnis. Dafür randomisieren wir einfach die Labels der Annotation, wobei wir die Häufigkeitsverteilung der Kategorien beibehalten, um unserem Zufallsalgorithmus zumindest eine gewisse Chance einzuräumen. 

```{r Vergleich mit einem Zufallsklassifikator}
prop.table(table(sample(predict(modell.NB)) == korpus.nyt.stats$Topic_2digit))*100
```

Wie wir sehen, ist der Bayes-Klassifizierer zwar nicht perfekt, aber sehr deutlich besser als ein Zufallsalgorithmus. Auch kann er durchaus als zusätzlicher Kodierer durchgehen, vor allem dann wenn man einmal genauer anschaut, bei welchen Codes er besonders gut bzw. schlecht abschneidet.

Dafür können wir uns die Übereinstimmung der Vorhersage mit der menschlichen Annotation nach Kategorie anzeigen lassen. Wie wir sehen, liegen die Werte dafür zwischen 28% und 88%, der Mittelwert (angezeigt durch die blaue Linie) bei circa 65%.

```{r Anteil korrekt klassifizierter Texte nach Kategorie}
modell.NB.klassifikation <- bind_cols(korpus.nyt.stats, Klassifikation = as.character(predict(modell.NB))) %>%
  mutate(Kategorie = as.character(Topic_2digit)) %>% 
  mutate(RichtigKodiert = Klassifikation == Kategorie) %>% 
  group_by(Kategorie, RichtigKodiert) %>% 
  summarise(n = n()) %>% 
  mutate(Anteil = n/sum(n)) %>% 
  filter(RichtigKodiert == TRUE) %>% 
  left_join(labels.kategorien, by = "Kategorie") %>% 
  select(Kategorie, Label, n, Anteil)
ggplot(modell.NB.klassifikation, aes(Label, Anteil)) + geom_bar(stat = "identity") + geom_hline(yintercept = mean(modell.NB.klassifikation$Anteil), color = "blue") + ylim(0, 1) + ggtitle("Anteil korrekt klassifizierter Texte aus 26\nInhaltskategorien mit Bayes-Klassifikator") + xlab("") + ylab("") + coord_flip()
```

Warum variiert die Genauigkeit der Klassifikation nach Kategorie so stark? Dies hat einerseits mit der Eindeutigkeit des Vokabulars in bestimmten Themenbereichen zu tun (vgl. Sport und Bildung mit Landwirtschaft), hängt aber vor allem mit der Samplegröße zusammen. Die Kategorien Feuer, Landwirtschaft und öffentlicher Grundbesitz sind schlicht zu klein, als dass sich aus ihnen ein zuverlässiges Vokabular für die Klassifikation extrahieren ließe. 

Welche Begriffe sind auf Grundlage der Kodierung besonders stark mit einer bestimmten Inhaltsanalyse-Kategorie assoziiert? Indem wir ähnlich wie bereits beim LDA-Modell bestimmte Kennzahlen aus der Modell-Datenstruktur extrahieren, können wir diese Frage leicht beantworten. Folgend plotten wie die fünf relevantesten Begriffe für sechs der 26 Inhaltsanalyse-Kategorien. Die Variable *PwGc* bezeichnet innerhalb des Modells die empirische Wahrscheinlichkeit des Begriffs für die Klasse. Der Aufruf ist deshalb ein wenig komplizierter, weil er mit dplyr und ggplot umgesetzt ist, und nicht zum Lieferumfang von quanteda gehört. 

```{r Distinktive Begriffe nach Kategorie extrahieren}
nb.terme <- as.data.frame(t(modell.NB$PwGc)) %>% 
  rownames_to_column("Wort") %>% 
  gather(Kategorie, Wahrscheinlichkeit, -Wort) %>% 
  arrange(Kategorie, desc(Wahrscheinlichkeit)) %>% 
  left_join(labels.kategorien, by = "Kategorie") %>% 
  group_by(Kategorie) %>% 
  mutate(Rang = row_number()) %>% 
  filter(Rang <= 5)
p1 <- ggplot(filter(nb.terme, Kategorie == 1), aes(reorder(Wort, Rang), Wahrscheinlichkeit)) + geom_bar(stat = "identity") + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + xlab("") + ylab("") + ggtitle(nb.terme$Label[nb.terme$Kategorie==1])
p2 <- ggplot(filter(nb.terme, Kategorie == 2), aes(reorder(Wort, Rang), Wahrscheinlichkeit)) + geom_bar(stat = "identity") + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + xlab("") + ylab("") + ggtitle(nb.terme$Label[nb.terme$Kategorie==2])
p3 <- ggplot(filter(nb.terme, Kategorie == 3), aes(reorder(Wort, Rang), Wahrscheinlichkeit)) + geom_bar(stat = "identity") + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + xlab("") + ylab("") + ggtitle(nb.terme$Label[nb.terme$Kategorie==3])
p4 <- ggplot(filter(nb.terme, Kategorie == 4), aes(reorder(Wort, Rang), Wahrscheinlichkeit)) + geom_bar(stat = "identity") + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + xlab("") + ylab("") + ggtitle(nb.terme$Label[nb.terme$Kategorie==4])
p5 <- ggplot(filter(nb.terme, Kategorie == 5), aes(reorder(Wort, Rang), Wahrscheinlichkeit)) + geom_bar(stat = "identity") + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + xlab("") + ylab("") + ggtitle(nb.terme$Label[nb.terme$Kategorie==5])
p6 <- ggplot(filter(nb.terme, Kategorie == 6), aes(reorder(Wort, Rang), Wahrscheinlichkeit)) + geom_bar(stat = "identity") + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + xlab("") + ylab("") + ggtitle(nb.terme$Label[nb.terme$Kategorie==6])
grid.arrange(p1, p2, p3, p4, p5, p6, nrow = 2)
```

Auch wenn es wahrscheinlich auf der Hand liegt: Im Kontrast zu des bislang verwendeten Methoden basiert diese Art der Assoziation auf der manuellen Kodierung, also den Entscheidungen der menschlichen Kodierer, und nicht darauf, dass die Begriffe etwa häufig gemeinsam vorkommen. Oftmals ist aber beides zugleich der Fall; Begriffe treten oft zusammen in Beiträgen auf, die von Kodierern als der gleichen Klasse zugehörig eingestuft werden.

### SVM-Klassifikation von Artikeln aus dem New York Times-Korpus

```{r Ein kleineres Subkorpus vorbereiten}
korpus.nyt.sample <- corpus_sample(korpus.nyt, size = 5000)
korpus.nyt.sample.stats <- summary(korpus.nyt.sample, n = 1000000)
fallzahl <- nrow(korpus.nyt.sample.stats)
```

```{r DFM rechnen und verkleinern}
dfm.nyt.sample <- dfm(korpus.nyt.sample, remove_numbers = TRUE, remove_punct = TRUE, remove = stopwords("english")) %>% 
  dfm_trim(min_docfreq = 0.0005, docfreq_type = "prop")
dfm.nyt.sample
```


```{r Trainings- und Testdaten festlegen}
set.seed(123)
training <- sample(1:fallzahl, floor(.80 * fallzahl))
test <- (1:fallzahl)[1:fallzahl %in% training == FALSE]
```

```{r SVM-Modell trainieren und anwenden}
fit <- svm(dfm.nyt.sample[training,], factor(korpus.nyt.sample.stats$Topic_2digit[training]), kernel="linear", cost = 10, probability = T)
preds <- predict(fit, dfm.nyt.sample[test,])

# Funktion für die Berechnung der Exaktheit (accurary)
accuracy <- function(ypred, y){
    tab <- table(ypred, y)
    return(sum(diag(tab))/sum(tab))
}
# Funktion für die Berechnung der Genauigkeit (precision)
precision <- function(ypred, y){
    tab <- table(ypred, y)
    return((tab[2,2])/(tab[2,1]+tab[2,2]))
}
# Funktion für die Berechnung der Trefferquote (recall)
recall <- function(ypred, y){
    tab <- table(ypred, y)
    return(tab[2,2]/(tab[1,2]+tab[2,2]))
}
```

```{r Konfusionsmatrix der Ergebnisse}
confusion.matrix <- as.data.frame(table(korpus.nyt.sample.stats$Topic_2digit[test], preds))
colnames(confusion.matrix) <- c("Reference", "Prediction", "Freq")
ggplot(confusion.matrix, aes(Reference, Prediction)) +
  geom_tile(aes(fill = log(Freq)), colour = "white") +
  scale_fill_gradient(low = "white", high = "steelblue") +
  geom_text(aes(x = Reference, y = Prediction, label = Freq)) +
  theme(legend.position = "none") +
  ggtitle("Konfusionsmatrix für 26 Inhaltskategorien im NYT-Korpus mittels SVM") 
```


```{r Modellperformanz}
accuracy(preds, korpus.nyt.sample.stats$Topic_2digit[test])
precision(preds, korpus.nyt.sample.stats$Topic_2digit[test])
recall(preds, korpus.nyt.sample.stats$Topic_2digit[test])
```

### Wordscores-Verfahren

```{r Bundestagskorpus laden und DFM rechnen}
load("daten/bundestag/bundestag.korpus.RData")
korpus.bundestag <- corpus_sample(korpus.bundestag, size = 1000)
RegOp <- ifelse(docvars(korpus.bundestag, "party") %in% c("CDU", "CSU", "SPD"), "Regierung", "Opposition")
trainingset <- dfm(korpus.bundestag, remove_numbers = TRUE, remove_punct = TRUE, remove = stopwords("german"))
trainingclass <- factor(RegOp, ordered = TRUE)
```

```{r Wordscores-Modell anwenden und Ergebnis ausgeben}
tmod <- textmodel_wordscores(trainingset, y = ifelse(RegOp == "Regierung", 1, 0))
summary(tmod)
```

```{r Koeffizienten nach Begriffen ausgeben}
head(coef(tmod), 50)
```

```{r Gesamtübersicht der Ergebnisse ausgeben}
wordscores <- data.frame(Text = str_sub(texts(korpus.bundestag), start = 1, end = 50), Koeffizient = predict(tmod), Begriff = RegOp)
wordscores
```


```{r Mittelwerte und Quantile der Wordscore-Verteilung für Regierung und Opposition}
mean(predict(tmod)[RegOp == "Regierung"])
mean(predict(tmod)[RegOp == "Opposition"])
quantile(predict(tmod)[RegOp == "Regierung"])
quantile(predict(tmod)[RegOp == "Opposition"])
```

### Wordfish-Verfahren

```{r Twitter-Korpus laden und DFM rechnen}
load("daten/twitter/trumpclinton.korpus.RData")
korpus.trump <- corpus_subset(korpus, Kandidat == "Trump") %>% corpus_sample(size = 4000)
korpus.clinton <- corpus_subset(korpus, Kandidat == "Clinton") %>% corpus_sample(size = 4000)
korpus.trumpclinton <- c(korpus.trump, korpus.clinton)
meine.dfm <- dfm(korpus.trumpclinton, groups = c("monat", "jahr", "Kandidat"),)
```

```{r Wordfish-Modell anwenden}
mein.modell <- textmodel_wordfish(meine.dfm)
vorhersage <- data.frame(theta = mein.modell$theta, kandidat = as_factor(str_split_fixed(mein.modell$docs, "\\.", n = 3)[,3]))
```

```{r Wordfish-Ergebnisse plotten}
ggplot(vorhersage, aes(kandidat, theta, colour = kandidat, fill = kandidat)) + 
  geom_jitter(position = position_jitter(width = 0.5, height = 0), show.legend = F) +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1)) + 
  xlab("") + ylab("") + 
  scale_colour_brewer(palette = "Set1") + 
  ggtitle("Wordfish-Ergebnisse für Donald Trump und Hillary Clinton")
```

### Verwenden von Metadaten als Klassifikation: Parteizugehörigkeit von MdBs

Um zu verdeutlichen, wie das überwachte maschinelle Lernen sich Metadaten als Inhaltslabels zunutze machen, greifen wir nun noch auf ein weiteres Beispiel zurück: die Parteizugehörigkeit von Mitgliedern des Bundestags. Hierbei handelt es sich aus Sicht eines Klassifikators auch "nur" um ein Metadatum, welches wir anhand der Wortverwendung vorherzusagen versuchen können.

Folgend laden wir zunächst die Daten und rechenen eine DFM. Hierbei sind wir sehr großzügig und entfernen lediglich Stoppwörter und solche Begriffe, die nur in einem einzigen Redebeitrag vorkommen. 

```{r DFM für das Bundestags-Korpus rechnen und trimmen}
load("daten/bundestag/bundestag.korpus.RData")
docvars(korpus.bundestag, "Tokens") <- korpus.bundestag.stats$Tokens
korpus.bundestag <- korpus.bundestag %>% 
  corpus_subset(type == "speech") %>% 
  corpus_subset(speaker_party %in% c("cducsu", "gruene",  "linke", "spd")) %>% 
  corpus_subset(Tokens >= 150)
partei <- docvars(korpus.bundestag, "party")
weitere.stoppwoerter <- scan("daten/bundestag/weitere_stoppwoerter.txt", what = "char", sep = "\n", quiet = T)
meine.dfm <- dfm(korpus.bundestag, remove_numbers = TRUE, remove_punct = TRUE, remove = c(stopwords("german"), weitere.stoppwoerter))
meine.dfm.trim <- dfm_trim(meine.dfm, min_docfreq = 2)
meine.dfm.trim
```

Wieder wenden wir den NB-Klassifikator an, den quanteda bereits mitliefert. Der Performance-Vergleich mit einem Zufallsalgorithmus verrät, dass die Zuordnung mit vergleichsweise hoher Genauigkeit funktioniert (88%). 

```{r Vorhersage des NB-Algorithmus für das Bundestags-Korpus anhand der Parteizugehörigkeit}
modell.NB <- textmodel_nb(meine.dfm.trim, partei, prior = "docfreq")
head(as.character(predict(modell.NB)), 25)  # vorhersage
head(docvars(meine.dfm.trim)$party, 25)  # manuell
prop.table(table(predict(modell.NB) == partei))*100  # genauigkeit modell
prop.table(table(sample(predict(modell.NB)) == partei))*100  # genauigkeit zufall
```

Erneut extrahieren wir im nächsten Schritt solche Begriffe, die besonders distinktiv für die jeweilige Kategorie (also Partei) sind. Das Bild ist etwas unschärfer als für die New York-Times-Schlagzeilen, was einerseits mit der Textsorte (Schlagzeilen einer Zeitung vs. Redebeiträge im Bundestag) und andererseits mit der Qualität der Annotation (systematisch kodiert vs. Parteizugehörigkeit als Label) zusammenhängt. Das Resultat kann sich trotzdem sehen lassen: eine Reihe von Begriffen sind recht eindeutig mit der politischen Richtung verbunden, auch wenn etwa die Unterschiede zwischen CDU und CSU gering ausfallen. 

```{r Distinktive Begriffe im Bundestags-Korpus nach Kategorie extrahieren}
nb.terme <- as.data.frame(t(modell.NB$PwGc)) %>% 
  rownames_to_column("Wort") %>% 
  gather(Partei, Wahrscheinlichkeit, -Wort) %>% 
  arrange(Partei, desc(Wahrscheinlichkeit)) %>% 
  group_by(Partei) %>% 
  mutate(Rang = row_number()) %>% 
  filter(Rang <= 12)
p1 <- ggplot(filter(nb.terme, Partei == "CDU"), aes(reorder(Wort, Rang), Wahrscheinlichkeit)) + geom_bar(stat = "identity") + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + xlab("") + ylab("") + ggtitle("CDU")
p2 <- ggplot(filter(nb.terme, Partei == "CSU"), aes(reorder(Wort, Rang), Wahrscheinlichkeit)) + geom_bar(stat = "identity") + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + xlab("") + ylab("") + ggtitle( "CSU")
p3 <- ggplot(filter(nb.terme, Partei == "SPD"), aes(reorder(Wort, Rang), Wahrscheinlichkeit)) + geom_bar(stat = "identity") + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + xlab("") + ylab("") + ggtitle("SPD")
p4 <- ggplot(filter(nb.terme, Partei == "DIE GRÜNEN"), aes(reorder(Wort, Rang), Wahrscheinlichkeit)) + geom_bar(stat = "identity") + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + xlab("") + ylab("") + ggtitle("DIE GRÜNEN")
p5 <- ggplot(filter(nb.terme, Partei == "DIE LINKE"), aes(reorder(Wort, Rang), Wahrscheinlichkeit)) + geom_bar(stat = "identity") + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + xlab("") + ylab("") + ggtitle("DIE LINKE")
grid.arrange(p1, p2, p3, p4, p5, nrow = 3)
```

In einem letzten Schritt nehmen wir auch hier wieder die einfache Genauigkeit nach Kategorie (Partei) in den Blick. Es zeigt sich, dass vor allem die CSU Probleme bereitet, was sowohl auf den relativ geringeren Redenateil als auch an der (vergleichsweise) geringen Abgrenzung von der Schwesterpartei liegen dürfte. 

Die auf den ersten Blick guten Ergebnisse unserer sehr primitven Analyse sind aber deshalb mit großer Vorsicht zu genießen, weil ein starkes Risiko der [Überanpassung](https://de.wikipedia.org/wiki/%C3%9Cberanpassung) (engl. *overfitting*) besteht. Das Modell verwendet rund 65.000 Features (Wörter) von denen manche nur sehr selten auftreten. Tritt ein Wort aber nur eine handvoll Male in den Redebeiträgen eines Mitglieds der Grünen-Fraktion auf, trägt dieses Feature zum Erfolg des Modells bei, auch wenn dieses Wort in einem anderen Datensatz wahscheinlich niemals vorkommt. Ein erster Schritt, um dieses Problem zu beheben, wäre es, zwischen Trainings- und Klassifikationsdaten zu unterscheiden (was wir in der Analyse der New York Times-Daten mit RTextTools auch getan haben, in diesem Fall aber nicht). So würde sich zeigen, ob auch neue Daten erfolgreich mit den im Training gelernten Features klassifiziert werden könnten. 

```{r Anteil korrekt klassifizierter Redebeiträge nach Partei mit Bayes-Klassifikator}
modell.NB.klassifikation <- bind_cols(docvars(meine.dfm.trim), Klassifikation = as.character(predict(modell.NB))) %>%
  mutate(Partei = party) %>% 
  mutate(RichtigKodiert = Klassifikation == Partei) %>% 
  group_by(Partei, RichtigKodiert) %>% 
  summarise(n = n()) %>% 
  mutate(Anteil = n/sum(n)) %>% 
  filter(RichtigKodiert == TRUE) %>% 
  mutate(Label = factor(Partei, levels = rev(c("CDU", "CSU", "SPD", "DIE GRÜNEN", "DIE LINKE")))) %>% 
  select(Partei, Label, n, Anteil)
ggplot(modell.NB.klassifikation, aes(Label, Anteil)) + geom_bar(stat = "identity") + geom_hline(yintercept = mean(modell.NB.klassifikation$Anteil), color = "blue") + ylim(0, 1) + ggtitle("Anteil korrekt klassifizierter Redebeiträge nach Partei\nmit Bayes-Klassifikator") + xlab("") + ylab("") + coord_flip()
```

Zusammenfassend lässt sich festhalten, dass das überwachte maschinelle Lernen gerade in Kombination mit anderen hier vorgestellten Techniken ein sehr nützliches Werkzeug sein kann. So lässt sich etwa ein Feature-Lexikon entwickeln, welches auf einer manuellen Inhhaltsanalyse eines kleineren Samples basiert. Zu beachten gilt auch hier, dass die automatisierte Klassifikation nur so gut sein kann, wie die händische Kategorisierung, die ihre Grundlage bildet. Entscheidend sind die hier nur angerissenen Techniken für die Validierung des Klassifikationsergebnisses. Sind sowohl die Daten besonders gut geeignet als auch die Qualität der manuellen Klassifikation sehr hoch (das NYT-Beispiel), kann sich auch das Ergebnis der automatisierten Zuordnung sehen lassen. Sind die Daten komplexer und ist die manuelle Klassifikation eher ungenau (das Zeit-Beispiel) sind auch die Resultate der automatisierten Klassifikation kaum besser als der Zufall.