Sentiment in Wahlprogrammen

Vorverarbeitung

Wie auch bei den anderen Untersuchungen werden zunächst die nötigen Bibliotheken und das Korpora geladen. Im Weiteren werden Stoppwörter entfernt und eine Document-Feature-Matrix erstellt.

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

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

# 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)

Terme mit positiven und negativem Sentiment können aus den Dateien SentiWS_v1.8c_Positive und SentiWS_v1.8c_Negative im data-Verzeichnis folgendermaßen eingelesen werden:

neg <- scan("data/SentiWS_v1.8c_Negative.txt", what = "char", sep = "\n", fileEncoding="utf-8")
pos <- scan("data/SentiWS_v1.8c_Positive.txt", what = "char", sep = "\n", fileEncoding="utf-8")

# Split up lines.
s <- str_split(neg, "\t")
t <- str_split(pos, "\t")

# Only read in token and not category (e.g. NN)
terms.neg <- sub("([A-Za-zß]+)[|][A-Za-z]+", "\\1",lapply(s, function(l) l[[1]]))
terms.pos <- sub("([A-Za-zß]+)[|][A-Za-z]+", "\\1",lapply(t, function(l) l[[1]]))

# Convert sentiment values to numeric types.
value.neg <- unlist(lapply(s, function(l) as.double(l[[2]])))
value.pos <- unlist(lapply(t, function(l) as.double(l[[2]])))

# Save results in data frame.
positive <- data.frame(term=terms.pos, value=value.pos)
negative <- data.frame(term=terms.neg, value=value.neg)

# show result
head(positive)

##             term value
## 1      Abmachung 0.004
## 2       Abschluß 0.004
## 3     Abstimmung 0.004
## 4       Agilität 0.004
## 5      Aktivität 0.004
## 6 Aktualisierung 0.004

Entwicklung des Sentiments über die Jahre

Zunächst wird die relative Häufigkeit von positiven und negativen Sentimentttermen über die Jahre hinweg verglichen. Dafür wird zunächst eine Document-Feature-Matrix nach Jahren gruppiert und alle Terme, die keinen Sentimentwert haben herausgefiltert. Sowohl für die negativen als auch für die positiven Terme wird dann die relative Häufigkeit pro Jahr in einem Data Frame gesammelt.

years <- dfm(program_dfm, groups = "year") %>% 
  textstat_frequency(groups = "year") %>% 
  as.data.frame()

# FIlte
tmp.pos <- filter(years, feature %in% positive$term)
tmp.neg <- filter(years, feature %in% negative$term)

lvl.year <- levels(factor(years$group))
# Intialize data frame
sent.years <- data.frame(matrix(ncol = 3, nrow=0))
colnames(sent.years) <- c("year", "rel_freq", "sent")

# Collect sentiment for positive terms
for (i in 1:length(lvl.year)){
  curr.year <- filter(tmp.pos, group == lvl.year[i])
  # Get sum of all terms in that year for normalization.
  sum.all <- sum(filter(years, group == lvl.year[i])$frequency)
  # Get sum of all positive terms in that year
  sum.freq <- sum(curr.year$frequency)
  curr.row <- data.frame(year = lvl.year[i], rel_freq=sum.freq/sum.all, sent = "positive")
  sent.years <- rbind(sent.years, curr.row)
}

# Collect sentiment for negative terms
for (i in 1:length(lvl.year)){
  curr.year <- filter(tmp.neg, group == lvl.year[i])
  # Get sum of all terms in that year for normalization.
  sum.all <- sum(filter(years, group == lvl.year[i])$frequency)
  # Get sum of all negative terms in that year
  sum.freq <- sum(curr.year$frequency)
  curr.row <- data.frame(year = lvl.year[i], rel_freq=sum.freq/sum.all, sent = "negative")
  sent.years <- rbind(sent.years, curr.row)
}

# Show format
head(sent.years, 10)

##    year   rel_freq     sent
## 1  2002 0.11130151 positive
## 2  2005 0.10651717 positive
## 3  2009 0.11263525 positive
## 4  2013 0.11830076 positive
## 5  2017 0.11301537 positive
## 6  2002 0.02001326 negative
## 7  2005 0.02432989 negative
## 8  2009 0.02199058 negative
## 9  2013 0.02262304 negative
## 10 2017 0.02528837 negative

Im nächsten Schritt kann das erstellte Data Frame dann visualisiert werden:

# Plot sentiment over years.
ggplot(sent.years, aes(fill = sent, x=year, y=rel_freq)) +
  geom_bar(position = "dodge", stat="identity")+
  labs(y = "Relative Häufigkeit", x = "Jahre",
       fill="Sentiment",
       title = "Relative Häufigkeit von Sentimenttermen")+
  scale_fill_manual(values = c("darkred", "darkgreen"))+
  theme_minimal()

Sentiment der Parteien

Ähnlich wie bei der Entwicklung des Sentiments über die Jahre kann auch bei der Betrachtung des Sentiments der Parteien vorgegangen werden. Die Document-Feature-Matrix wird nach Parteien gruppiert und nach Sentimenttermen gefiltert. Dann wird die relative Frequenz von positiven und negativen Termen pro Partei ermittelt.

parties <- dfm(program_dfm) %>% 
  textstat_frequency(groups = "party") %>% 
  as.data.frame()

# Filter for sentiment terms.
tmp.pos <- filter(parties, feature %in% positive$term)
tmp.neg <- filter(parties, feature %in% negative$term)

party.vec <- levels(factor(parties$group))

# Initialize data frame.
sent.party <- data.frame(matrix(ncol=3, nrow=0))
colnames(sent.party) <- c("party", "frequency", "sent")

# Collect negative and positive terms.
for (i in 1:length(party.vec)){
  curr.party <- party.vec[i]
  # Sum of all terms.
  sum.all <- sum(filter(parties, group == curr.party)$frequency)
  # Determine frequency of positive and negative terms
  curr.pos <- sum(filter(tmp.pos, group == curr.party)$frequency)
  curr.neg <- sum(filter(tmp.neg, group == curr.party)$frequency)
  row.pos <- data.frame(party = curr.party, sent="positiv", frequency=curr.pos/sum.all)
  row.neg <- data.frame(party = curr.party, sent="negativ", frequency=curr.neg/sum.all)
  sent.party <- rbind(sent.party, row.pos, row.neg)
}
# show result
head(sent.party, 10)

##           party    sent  frequency
## 1           AfD positiv 0.07867676
## 2           AfD negativ 0.02832751
## 3  B90dieGruene positiv 0.11307046
## 4  B90dieGruene negativ 0.02627476
## 5           CDU positiv 0.13069283
## 6           CDU negativ 0.01766779
## 7      DIELINKE positiv 0.09384105
## 8      DIELINKE negativ 0.03037077
## 9           FDP positiv 0.11082578
## 10          FDP negativ 0.02025367

Das Resultat kann dann folgendermaßen visualisiert werden.

# Plot sentiment for parties.
ggplot(sent.party, aes(fill = sent, x=party, y=frequency)) +
  geom_bar(position = "dodge", stat="identity")+
  labs(y = "Relative Häufigkeit",
       x = "Jahre",
       fill="Sentiment",
       title = "Relative Häufigkeit von Sentimenttermen nach Parteien")+
  scale_fill_manual(values = c("darkred", "darkgreen"))+
  theme_minimal()

Sentiment nach Parteien und Jahren

Die vorangegangenen Analysen können zusammengeführt werden, indem die relative Häufigkeit von Sentimenttermen über Jahre und Parteien hinweg dargestellt wird. Dafür muss ein Data Frame nach beiden Parametern gruppiert werden.

part.year <- dfm(program_dfm) %>% 
  textstat_frequency(groups = c("party", "year")) %>% 
  as.data.frame()

# Add columns for party and year.
part.year$party <- unlist(lapply(strsplit(part.year$group, "[.]"), function(l) l[[1]]))
part.year$year <- unlist(lapply(strsplit(part.year$group, "[.]"), function(l) l[[2]]))

Zunächst wird die relative Häufigkeit von positiven Sentimenttermen für jede Partei und jedes Jahr bestimmt und visualisiert.

# Initialze data frame for positive terms.
pos.year.party <- data.frame(matrix(ncol=3, nrow=0))
colnames(pos.year.party ) <- c("year", "party", "rel")

lvl <- levels(factor(part.year$group))
for (i in 1:length(lvl)){
  curr.lvl <- lvl[i]
  sum.lvl <- sum(filter(part.year, group == curr.lvl)$frequency)
  pos.lvl <- filter(part.year, feature %in% positive$term & group== curr.lvl)
  tmp.row <- data.frame(year = levels(factor(pos.lvl$year)),
                        party = levels(factor(pos.lvl$party)),
                        rel=sum(pos.lvl$frequency)/sum.lvl)
  pos.year.party  <- rbind(pos.year.party , tmp.row)
  
}

pos.year.party

##    year        party        rel
## 1  2013          AfD 0.10107527
## 2  2017          AfD 0.07761861
## 3  2002 B90dieGruene 0.11139397
## 4  2005 B90dieGruene 0.10905612
## 5  2009 B90dieGruene 0.11119770
## 6  2013 B90dieGruene 0.11171442
## 7  2017 B90dieGruene 0.11907626
## 8  2002          CDU 0.11958452
## 9  2005          CDU 0.10264386
## 10 2009          CDU 0.12702611
## 11 2013          CDU 0.14257162
## 12 2017          CDU 0.13938993
## 13 2009     DIELINKE 0.09647099
## 14 2013     DIELINKE 0.09514463
## 15 2017     DIELINKE 0.09199383
## 16 2002          FDP 0.10425051
## 17 2005          FDP 0.09908845
## 18 2009          FDP 0.10386005
## 19 2013          FDP 0.12213778
## 20 2017          FDP 0.11882125
## 21 2002          PDS 0.09123389
## 22 2005          PDS 0.09261825
## 23 2002          SPD 0.12765957
## 24 2005          SPD 0.12806253
## 25 2009          SPD 0.12532565
## 26 2013          SPD 0.12622721
## 27 2017          SPD 0.13422853

# Plot positive terms for parties over years.
ggplot(pos.year.party, aes(fill = party, x=year, y=rel)) +
  geom_bar(position = "dodge", stat="identity")+
  labs(y = "Relative Häufigkeit", 
       x = "Jahre",
       fill="Partei",
       title = "Relative Häufigkeit von Termen mit positivem Sentiment")+
  theme_minimal()+
  scale_fill_manual(values = c("blue", "#009933", "black", "#CC0066", "#FFFF00", "brown", "red"))

Das Gleiche kann für Terme mit negativem Sentiment wiederholt werden.

# Initialze data frame for negative terms.
neg.year.party <- data.frame(matrix(ncol=3, nrow=0))
colnames(neg.year.party) <- c("year", "party", "rel")

lvl <- levels(factor(part.year$group))

for (i in 1:length(lvl)){
  curr.lvl <- lvl[i]
  sum.lvl <- sum(filter(part.year, group == curr.lvl)$frequency)
  neg.lvl <- filter(part.year, feature %in% negative$term&group== curr.lvl)
  tmp.row <- data.frame(year = levels(factor(neg.lvl$year)),
                        party = levels(factor(neg.lvl$party)),
                        rel=sum(neg.lvl$frequency)/sum.lvl)
  neg.year.party <- rbind(neg.year.party, tmp.row)
}

neg.year.party

##    year        party        rel
## 1  2013          AfD 0.02795699
## 2  2017          AfD 0.02834502
## 3  2002 B90dieGruene 0.01866852
## 4  2005 B90dieGruene 0.02659439
## 5  2009 B90dieGruene 0.02639130
## 6  2013 B90dieGruene 0.02677832
## 7  2017 B90dieGruene 0.02829565
## 8  2002          CDU 0.02397017
## 9  2005          CDU 0.02550544
## 10 2009          CDU 0.01295354
## 11 2013          CDU 0.01518987
## 12 2017          CDU 0.01803759
## 13 2009     DIELINKE 0.03084679
## 14 2013     DIELINKE 0.03009486
## 15 2017     DIELINKE 0.03038126
## 16 2002          FDP 0.02045317
## 17 2005          FDP 0.02236664
## 18 2009          FDP 0.02026921
## 19 2013          FDP 0.01770042
## 20 2017          FDP 0.02140475
## 21 2002          PDS 0.02386117
## 22 2005          PDS 0.02711261
## 23 2002          SPD 0.01441318
## 24 2005          SPD 0.01923944
## 25 2009          SPD 0.01775675
## 26 2013          SPD 0.01889025
## 27 2017          SPD 0.01834305

# Plot negative sentiment over years for parties.
ggplot(neg.year.party, aes(fill = party, x=year, y=rel)) +
  geom_bar(position = "dodge", stat="identity")+
  labs(y = "Relative Häufigkeit",
       x = "Jahre",
       fill="Partei",
       title = "Relative Häufigkeit von Termen mit negativem Sentiment")+
  theme_minimal()+
  scale_fill_manual(values = c("blue", "#009933", "black", "#CC0066", "#FFFF00", "brown", "red"))

Sentimentwerte der Parteien

In den Sentimentwörterbüchern ist nicht nur vermerkt, welche Terme positiv und negativ belegt sind, sondern auch wie groß das Sentiment ist. Je positiver ein Term ist, desto näher liegt sein Wert an 1. Je negativer ein Term ist, desto näher liegt sein Wert an -1. Zusammen mit der relativen Häufigkeit kann so ein Sentimentscore für jede Partei berechnet werden. Dabei wird jeweils für die positiven und negativen Terme der Sentimentwert mit der relativen Häufigkeit multipliziert und dieser Wert dann für die positive bzw. negativen Terme aufsummiert. An einem Beispiel lässt sich dies gut verdeutlichen: Wenn Partei x den Begriff wunderbar mit einem Sentimentwert 0.7 und einer relativen Häufigkeit von 0.5 und den Begriff gut mit einem Sentimentwert 0.3 und einer relativen Häufigkeit von 0.2 verwendet, so ist der Sentimentscore von x 0.7*0.5 + 0.3*0.2 = 0.41. Die relative Häufigkeit wird hier verwendet, weil die Länge der Wahlprogramme der einzelnen Parteien sehr variiert.

part.sent <- textstat_frequency(program_dfm, groups = "party") %>% as.data.frame()

tmp.pos <- filter(part.sent, feature %in% positive$term)
tmp.neg <- filter(part.sent, feature %in% negative$term)

# Intialize data frame for positiv terms
freq.pos <- as.data.frame(matrix(ncol = 4, nrow = 0))
colnames(freq.pos) <- c("term", "sentiment", "frequency", "party")

# Collect sentiment values for positive terms.
for (i in 1:nrow(tmp.pos)){
  curr.term <- tmp.pos$feature[i]
  curr.value <- filter(positive, term == curr.term)$value
  curr.freq <- tmp.pos$frequency[i]
  curr.row <- data.frame(term = curr.term,
                         sentiment = curr.value,
                         frequency = curr.freq,
                         party = tmp.pos$group[i])
  freq.pos <- rbind(freq.pos, curr.row)
}

# Intialize data frame for negative terms
freq.neg <- as.data.frame(matrix(ncol = 4, nrow = 0))
colnames(freq.neg) <- c("term", "sentiment", "frequency", "year")

# Collect sentiment values for negative terms.
for (i in 1:nrow(tmp.neg)){
  curr.term <- tmp.neg$feature[i]
  curr.value <- filter(negative, term == curr.term)$value
  curr.freq <- tmp.neg$frequency[i]
  curr.row <- data.frame(term = curr.term,
                         sentiment = curr.value,
                         frequency = curr.freq,
                         party = tmp.neg$group[i])
  freq.neg<- rbind(freq.neg, curr.row)
}

part.lvl <- levels(factor(freq.neg$party))
sent.values <- data.frame(matrix(ncol=3, nrow=0))
colnames(sent.values) <- c("party", "pos", "neg")

# Compute sum for positive and negative terms
for (i in 1:length(part.lvl)){
  tmp.party <- part.lvl[i]
  curr.pos <- filter(freq.pos, party == tmp.party)
  curr.neg <- filter(freq.neg, party == tmp.party)
  sum.all <- sum(filter(textstat_frequency(program_dfm, group = "party"),
                        group == tmp.party)$frequency)
  # compute sum of sentiment value multiplied by relative frequency.
  p <- sum(curr.pos$sentiment * curr.pos$frequency/sum.all)
  n <- sum(curr.neg$sentiment * curr.neg$frequency/sum.all)
  tmp <- data.frame(party=tmp.party, pos=p, neg=n)
  sent.values <- rbind(sent.values, tmp)
}
# Show result
head(sent.values, 10)

##          party         pos          neg
## 1          AfD 0.004706257 -0.007498652
## 2 B90dieGruene 0.009724001 -0.006453524
## 3          CDU 0.012830653 -0.003988955
## 4     DIELINKE 0.006455184 -0.008195195
## 5          FDP 0.008171769 -0.005105520
## 6          PDS 0.006226268 -0.006290287
## 7          SPD 0.011697984 -0.004343857

Das Resultat kann dann als eine Gegenüberstellung des negativen und positiven Sentimentscores nach Partei dargestellt werden: