Blog_Forschungsseminar
Tim Naef, 09732082
20. Juni 2021
Kommentierter Code
In einem ersten Schritt werden sämtliche R-Packages und Daten geladen. Der Corona-Twitter-Datensatz wird direkt geladen. Code ist auskommentiert.
library(tidyverse)
library(lubridate)
library(quanteda)
library(quanteda.textmodels)
library(quanteda.textstats)
library(tidytext)
library(readxl)
library(forcats)
library(wordcloud)
library(quanteda.textplots)Laden der Datensätze
#set workingspace
setwd("/Users/Jackie/Desktop/Studium/FS2021/Forschungsseminar/Blog")
#load the data
data_facebook <- readRDS("parties_on_facebook.rds")
### Twitter Daten laden -> auskommentiert, am Ende bearbeitetes df laden
#data_twitter_big <- readRDS("corona_data_twitter.RDS")
#parteiaccounts <- c("Schweizerische Volkspartei", "Grüne Partei Schweiz", "Christlichdemokratische Partei",
# "Grünliberale Partei Schweiz", "Bürgerlich Demokratische Partei Schweiz",
# "Sozialdemokratische Partei Schweiz", "Evangelische Volkspartei Schweiz",
# "FDP-Die Liberalen")
#
#corona_twitter_big <- corona_data_twitter %>%
# select(Akteur, Akteur_Typ, Party_Short, Text, Datum, Language) %>%
# filter(Akteur %in% parteiaccounts)%>%
# group_by(Party_Short)%>%
# mutate(number = str_pad(row_number(), width = 4, pad = "0"),
# doc_id = paste0(Party_Short, number)) %>%
# mutate(Datum = ymd(Datum)) %>%
# filter(Datum > "2020-01-01")
# save the file
#save(corona_twitter_big,file="corona_twitter_big")
#load the file
load("corona_twitter_big.RDS")Erste Datenbereinigung
Anschliessend werden die Datensätze aufgeräumt. Es werden die nötigen Variablen ausgewählt, den Texten spezifische Namen gegeben und das Datum entsprechend formatiert.
data_facebook_clean <- data_facebook %>%
select(Datum, Titel, Account_subscribercount, Text, Language, Party_Short) %>%
filter(grepl("de", Language)) %>%
filter(Text != "") %>% #remove empty texts (pictures etc.)
group_by(Party_Short) %>%
mutate(number=str_pad(row_number(),width=4,pad="0"), #document names
doc_id=paste0(Party_Short,number))%>%
mutate(Datum = ymd(Datum)) #%>% # convert date into date-format
#filter(Datum > "2020-01-01") ##Corpus, dfm, tokens erstellen, Negationen herausarbeiten In einem nächsten Schritt wird ein corpus, ein dfm und ein tokenobjekt erstellt. Zudem werden die Negationen (nicht und kein*) zusammengeführt, welche in einem späteren Zeitpunkt dem dictonary hinzugefügt werden.
#create corpus
facebook_corpus <- corpus(data_facebook_clean,
text_field = "Text")
#### create the document feature matrix
facebook_dfm <- dfm(facebook_corpus,
what = c("word"),
include_docvars = T)
#### tokenize the whole story
toks_facebook <- tokens(facebook_corpus,
what = c("word"),
remove_punct = T,
remove_numbers = T,
include_docvars = T,
split_hyphens = T,
remove_symbols = T) # after first analysis (remove_hypens is deprecated)
### nicht, kein* wörter zusammenführen mit compound -> um später negationen und
### umgekehrt dem dictonair hinzufügen zu können
# nicht
toks_facebook <- tokens_compound(toks_facebook, pattern = phrase("nicht *"))
#kein*
toks_facebook <- tokens_compound(toks_facebook, pattern = phrase("kein* *"))##Collocations ermitteln, stopwords entfernen In diesem Schritt werden Collocations basierend auf Statistik gesucht und verbunden, welche die spätere Sentiment-Analyse stören könnten. Zudem werden die stopwords entfernt, welche nach und nach noch ergänzt werden, um anschliessend eine zweite Collocations-Runde zu machen. Es werden die leeren tokens gelöscht und sämtliche Grossbuchstaben zu Kleinbuchstaben umformatiert.
### look for possible collocations (based on stats)
colllocations <- toks_facebook %>%
tokens_select(pattern = "^[A-Z]",
valuetype = "regex",
case_insensitive = FALSE,
padding = TRUE) %>%
textstat_collocations(min_count = 5,
size = 2,
tolower = FALSE)
#colllocations[1:50,]
### create multiword by selecting manually from collocations
multiword <- c(
"No Billag",
"Liberale Fraktion",
"Beznau I",
"Europäische Menschenrechtskonvention",
"Schweizerische Nationalbank",
"Europäischen Menschenrechtskonvention",
"Pariser Klimaabkommen",
"Europäischen Union",
"ETH Zürich",
"Wirtschaftsstandort Schweiz",
"Schweizer Landwirtschaft",
"Billag Initiative",
"Operation Libero",
"PINK CROSS",
"Staatspolitische Kommission",
"Christian Wasserfallen",
"Christoph Blocher",
"Christian Levrat",
"Karin Keller",
"Albert Rösti",
"Andreas Glarner",
"Ueli Maurer",
"Bundesrätin Sommaruga",
"Fabian Molina",
"Kathrin Bertschy",
"Regula Rytz",
"Alfred Heer",
"Doris Leuthard",
"Franziska Ryser",
"Cédric Wermuth",
"Balthasar Glättli",
"Diana Gutjahr",
"Julian Assange",
"Edward Snowden" ,
"Simonetta Sommaruga",
"Kanton Zürich",
"Kanton Thurgau",
"Kanton Aargau",
"Kanton St.Gallen",
"Kanton Waadt"
)
toks_facebook <- tokens_compound(toks_facebook, pattern = phrase(multiword))
#colllocations$collocation
#remove stopwords
toks_facebook <- toks_facebook %>%
tokens_remove(c(stopwords("german")),
padding = T)
### after first glimpse (most freq words) we add some words, which we want to remove
toks_facebook <- tokens_remove(toks_facebook, c("dass",
"-"))
# compounding second round without stopwords
colllocations2 <-
toks_facebook %>%
tokens_select(pattern = "^[A-Z]",
valuetype = "regex",
case_insensitive = FALSE,
padding = TRUE) %>%
textstat_collocations(min_count = 5,
size = 2,
tolower = FALSE)
#colllocations2$collocation
multiword2 <- c(
"CO2 Gesetz",
"Corona Krise",
"Bundesrätin Karin_Keller",
"Stadt Zürich",
"Stadt Bern",
"Vollgeld Initiative",
"Kanton Luzern",
"Corona Pandemie",
"Martullo Blocher",
"Schengen Dublin",
"CO2 Emissionen",
"Gletscher Initiative",
"Bundesrätin Simonetta_Sommaruga",
"Plan B",
"Alt Bundesrat",
"Karin_Keller Sutter",
"BR Karin_Keller",
"AHV Reform",
"Covid Gesetz",
"Konzern Initiative",
"Social Media",
"Kriegsgeschäfte Initiative",
"Rassismus Strafnorm",
"Korrektur Initiative",
"Menschenrechts Initiative",
"Fake News",
"CO Gesetz",
"Ignazio Cassis",
"Zersiedelungs Initiative",
"Begrenzungs Initiative",
"Hornkuh Initiative",
"Selbstbestimmungs Initiative"
)
toks_facebook <- tokens_compound(toks_facebook, pattern = phrase(multiword2))
# remove empty tokes and lower all tokens
toks_facebook <- toks_facebook %>%
tokens_remove("")
toks_facebook <- tokens_tolower(toks_facebook)Daten ins Verhältnis setzen
In diesem Arbeitsschritt wird die Gesamtzahl der Posts pro Partei und die Tokens pro Partei berechnet, um die späteren Analyseergebnisse vergleichbar zu machen.
# calculate tokens per party and posts per party
postcount <- textstat_summary(dfm(toks_facebook))%>%
select(document, tokens)
postcount$document <- gsub("[0-9]", "", postcount$document)
posts_per_party <- postcount %>%
group_by(document)%>%
tally()
tokens_per_party <- postcount %>%
group_by(document) %>%
dplyr::summarise(sum(tokens))Wörterbuch laden und manuell ergänzen
Für die Analyse laden wir das Lexikon “NCR” und legen es über unseren Datensatz. Zudem werden dem Wörterbuch die Negationen hinzugefügt (kein*, nicht). Positive = minus_minus; Negativ minus_ _plus. Für den Texteinstieg des Blogbeitrag wird zudem der “negativste” Tweet ermittelt.
nrc <- read_excel("NRC-Emotion-Lexicon-v0.92-In105Languages-Nov2017Translations.xlsx")## New names:
## * `English (en)` -> `English (en)...1`
## * `English (en)` -> `English (en)...22`nrc <- nrc %>%
select(word=`German (de)`,Positive:Trust)
nrc_long <- nrc %>%
pivot_longer(-word,names_to="sentiment",values_to="val")
nrc_long <- nrc_long %>% filter(val==1)
dict_sent_nrc <- as.dictionary(nrc_long)
########
minus_minus <- c(paste0("nicht", "_" , dict_sent_nrc[["Negative"]]),
paste0("kein", "_" , dict_sent_nrc[["Negative"]]),
paste0("keine", "_" , dict_sent_nrc[["Negative"]]),
paste0("keiner", "_" , dict_sent_nrc[["Negative"]]),
paste0("keines", "_" , dict_sent_nrc[["Negative"]]),
paste0("keinem", "_" , dict_sent_nrc[["Negative"]]),
paste0("keinen", "_" , dict_sent_nrc[["Negative"]])
)
minus_plus <- c(paste0("nicht", "_" , dict_sent_nrc[["Positive"]]),
paste0("kein", "_" , dict_sent_nrc[["Positive"]]),
paste0("keine", "_" , dict_sent_nrc[["Positive"]]),
paste0("keiner", "_" , dict_sent_nrc[["Positive"]]),
paste0("keines", "_" , dict_sent_nrc[["Positive"]]),
paste0("keinem", "_" , dict_sent_nrc[["Positive"]]),
paste0("keinen", "_" , dict_sent_nrc[["Positive"]])
)
### add to dict
dict_sent_nrc$Negative <- c(dict_sent_nrc$Negative, minus_plus)
dict_sent_nrc$Positive <- c(dict_sent_nrc$Positive, minus_minus)
# combine toks with dic and create dfm
facebook_sent_nrc <- tokens_lookup(toks_facebook, dict_sent_nrc , valuetype = "glob") %>%
dfm()
# check for most negativ post -> Einstieg in Artikel
Most_negativ_Post <- tokens_lookup(toks_facebook, dict_sent_nrc , valuetype = "glob") %>%
dfm() %>%
convert(to = "data.frame") %>%
select(doc_id, negative) %>%
arrange(desc(negative)) %>%
head()
Einstiegs_post <- data_facebook_clean %>%
filter(doc_id == "SVP1410")
#Einstiegs_post$TextVerhältnis zwischen negativen und positiven Wörtern berechnen
Anschliessend groupen wir es nach Parteien, erstellen eine neue Spalte (neg/pos), um den Anteil an Negativ-Wörtern zu berechnen, um das Ganze vergleichbar zu machen. Dann wird es erstmals geplotet.
Für den Plot werden die Parteien auf einer Links-Rechts-Skala dargestellt, um den Unterschied zwischen Pol- und Mitteparteien den Lesern direkt im Plot aufzuzeigen.
facebook_sent_nrc <- facebook_sent_nrc %>%
dfm_group(Party_Short)
Parties_sentiment <- facebook_sent_nrc %>%
convert(to = "data.frame") %>%
bind_cols(docvars(facebook_sent_nrc)) %>%
group_by(Party_Short)%>%
mutate(neg_to_pos = (negative / (positive + negative))*100) %>%
arrange(desc(neg_to_pos))
### remove small parties
Parties_sentiment <- Parties_sentiment[-c(1,2),]
# parteifarben: https://medium.com/srf-schweizer-radio-und-fernsehen/wie-wir-bei-srf-parteien-einf%C3%A4rben-9f010f80cf62
Neg_pos_Parties <- Parties_sentiment %>%
ggplot(aes(x=reorder(Party_Short, -neg_to_pos/100), y=neg_to_pos/100 , fill= doc_id))+
geom_col()+
theme_minimal()+
scale_y_continuous(labels = scales::percent)+
scale_fill_manual(values = c("#e7c820", "#d6872b", "#dfaa28", "#3871b4", "#999a01", "#85b547", "#f0564e", "#4c8a3f"))+
theme(legend.position = "none") +
ggtitle("Wie negativ kommuniziert eine Partei") +
xlab("") +
ylab("Negativanteil in Prozent")
### Parteien mit neg/pos-Verhältnis auf links-rechts-skala darstellen, um im Plot
### Unterschied zwischen Pol- und Mitteparteien darzustellen. Als Grundlage werden
### die Daten und Einteilungen von Michael Hermann von 2019
### (https://www.nzz.ch/schweiz/parlamentarierrating-2017-der-nationalrat-hat-sich-entlang-der-parteilinien-sortiert-ld.1333867) verwendet.
partei_position <- data.frame(doc_id = Parties_sentiment$doc_id,
position = c(9,-9, -2.5, -2, -8.5, 1.5, -1, -0.8))
Neg_pos_Parties_mit_Position <- left_join(Parties_sentiment, partei_position, by = "doc_id")
Neg_pos_Parties_mit_Position_plot <- Neg_pos_Parties_mit_Position %>%
select(Party_Short, neg_to_pos, position) %>%
ggplot(aes(x=position, y=neg_to_pos/100 , fill= Party_Short))+
geom_col(width = .5)+
theme_minimal()+
scale_x_discrete(limit=c(-9.5, -7.5, -5, 0, 5, 7.5, 9.5),
labels=c("-10", "links", "-5", "Mitte", "5", "rechts", "10"))+
scale_y_continuous(labels = scales::percent)+
scale_fill_manual(values = c("#e7c820", "#d6872b", "#add8e6", "#3871b4", "#999a01", "#85b547", "#f0564e", "#4c8a3f"))+
guides(fill=guide_legend(title="Partei:"))+
theme(legend.position = "bottom", legend.box = "horizontal") +
ggtitle("Wie negativ kommuniziert eine Partei") +
xlab("Parteiposition auf der Links-Rechts-Skala") +
ylab("Negativanteil in Prozent")
Neg_pos_Parties_mit_Position_plot
Wir sehen, dass die Polparteien (SP, SVP) einen deutlich höherer Negativanteil an an Wörtern in ihren Posts haben als die Mitteparteien.
Einige Vergleichsbeispiele für einzelne Sentiments, wie “anger”, “disgust”, “fear”. Um einen Vergleich anstellen zu können, fügen wir die Anzahl Posts pro Party plus die Anzahl Tokes pro Party ein, welche wir auf Zeilen 241-247 berechnet haben.
#rename for merge and better understanding
posts_per_party <- posts_per_party %>%
rename(doc_id = document,
Anzahl_Posts = n)
tokens_per_party <- tokens_per_party %>%
rename(doc_id = document,
Anzahl_Tokens = `sum(tokens)`)
Party_Vergleich <- left_join(Parties_sentiment, posts_per_party, by = "doc_id")
Party_Vergleich <- left_join(Party_Vergleich, tokens_per_party, by = "doc_id")Nun können wir die Werte für die einzelnen Emotionen berechnen, um einen Vergleich anzustellen. Emotionen pro 100 Posts. -> SVP bei negativ-Emotionen weit vorne, Mitteparteien tiefere Werte = weniger Emotionen in der Sprache.
Emotionen für die Parteien ploten
Emotionen wurden Posts zugeordnet. Annahme = kommt eine emotionen in einem Post vor, können wir diesen dementsprechend der Emotion zuordnen und Prozente berechnen (Anzahl mit der Emtotion / gesamt_Anzahl der Posts)
Für den Artikel werden wegen der Verständlichkeit und den intuitiven Lesbarkeit der Grafik nicht sämtliche Emotionen in einem Plot angezeigt.
Die Emotionen werden einzelen geplotet, um sie anschliessend via iframe einzubinden, sodass der Leser mit einem drop-down Menu selber wählen kann, welche Emotion er sehen will. Für das Iframe wird ein separates HTML-Dokument erstellt und mit Java-Script geschrieben und anschliessend auf einen Server geladen. -> siehe Codezeilen 688 bis 734.
Emo_pro_Post <- Party_Vergleich %>%
mutate(anger = (anger/Anzahl_Posts)) %>% #*abweichung nennung
mutate(anticipation = (anticipation/Anzahl_Posts)) %>%
mutate(disgust = (disgust/Anzahl_Posts)) %>%
mutate(fear = (fear/Anzahl_Posts)) %>%
mutate(joy = (joy/Anzahl_Posts)) %>%
mutate(negative = (negative/Anzahl_Posts)) %>%
mutate(positive = (positive/Anzahl_Posts)) %>%
mutate(sadness = (sadness/Anzahl_Posts)) %>%
mutate(trust = (trust/Anzahl_Posts)) %>%
mutate(surprise = (surprise/Anzahl_Posts))
#### emotionen posts zuordnen
Emo_in_Post <- tokens_lookup(toks_facebook, dict_sent_nrc , valuetype = "glob")
emotionen <- c("Anger", "Anticipation", "Disgust", "Fear", "Joy", "Sadness",
"Surprise", "Trust")
df <- docvars(Emo_in_Post)
for (key in emotionen) {
df[[key]] <- unlist(lapply(Emo_in_Post, function(x){
key %in% x #length(x[x == key])
}))
}
All_Emos_in_One <- df %>%
group_by(Party_Short) %>%
summarise_at(vars(Anger:Trust), function(x){
sum(x)/length(x)
}) %>%
filter(!(Party_Short %in% c("Piraten", "up!", "EVP")))%>%
pivot_longer(Anger:Trust, values_to= "values", names_to = "emotions") %>%
mutate(emotions = case_when(emotions == "Anger" ~ "Zorn",
emotions == "Anticipation" ~ "Vorfreude",
emotions == "Disgust" ~ "Ekel",
emotions == "Fear" ~ "Angst",
emotions == "Joy" ~ "Freude",
emotions == "Sadness" ~ "Traurigkeit",
emotions == "Surprise" ~ "Überraschung",
emotions == "Trust" ~ "Vertrauen",
)) %>%
ggplot(aes(x = Party_Short, y = values, fill = Party_Short)) +
geom_bar(stat='identity', position='dodge')+
scale_fill_manual(values = c("#e7c820", "#d6872b", "#3871b4", "#999a01", "#85b547", "#f0564e", "#4c8a3f"))+
facet_wrap(~emotions, nrow = 4, ncol = 2)+
theme_minimal()+
theme(legend.position = "none")+
xlab("")+
ylab("") +
scale_y_continuous(labels = scales::percent)
#### Plots für den Artikel: Emotionen werden einzeln dargestellt und spezifisch ausgewählt, um dem Leser das Prinzip aufzuzeigen.
Alle_Emos_wideformat <- df %>%
group_by(Party_Short) %>%
summarise_at(vars(Anger:Trust), function(x){
sum(x)/length(x)
}) %>%
filter(!(Party_Short %in% c("Piraten", "up!")))%>%
rename(Zorn = Anger, Vorfreude = Anticipation, Ekel = Disgust,
Angst = Fear, Freude = Joy, Traurigkeit = Sadness,
Überraschung = Surprise, Vertrauen = Trust) %>%
left_join(partei_position, by = c("Party_Short" = "doc_id")) #add Partei_Position auf likns/rechts Skala
#Für Angst
Angst <- Alle_Emos_wideformat %>%
select(Party_Short, Angst, position) %>%
ggplot(aes(x=position, y=Angst, fill= Party_Short))+
geom_col(width = .5)+
theme_minimal()+
scale_x_discrete(limit=c(-9.5, -7.5, -5, 0, 5, 7.5, 9.5),
labels=c("-10", "links", "-5", "Mitte", "5", "rechts", "10"))+
scale_y_continuous(labels = scales::percent, limits = c(0,0.7))+
scale_fill_manual(values = c("#e7c820", "#d6872b", "#add8e6", "#3871b4", "#999a01", "#85b547", "#f0564e", "#4c8a3f"))+
guides(fill=guide_legend(title="Partei:"))+
theme(legend.position = "bottom", legend.box = "horizontal") +
xlab("Parteiposition auf der Links-Rechts-Skala") +
ylab("'Angst-Posts' in Prozent")
Zorn <- Alle_Emos_wideformat %>%
select(Party_Short, Zorn, position) %>%
ggplot(aes(x=position, y=Zorn, fill= Party_Short))+
geom_col(width = .5)+
theme_minimal()+
scale_x_discrete(limit=c(-9.5, -7.5, -5, 0, 5, 7.5, 9.5),
labels=c("-10", "links", "-5", "Mitte", "5", "rechts", "10"))+
scale_y_continuous(labels = scales::percent, limits = c(0,0.7))+
scale_fill_manual(values = c("#e7c820", "#d6872b", "#add8e6", "#3871b4", "#999a01", "#85b547", "#f0564e", "#4c8a3f"))+
guides(fill=guide_legend(title="Partei:"))+
theme(legend.position = "bottom", legend.box = "horizontal") +
xlab("Parteiposition auf der Links-Rechts-Skala") +
ylab("'Zorn-Posts' in Prozent")
Vorfreude <- Alle_Emos_wideformat %>%
select(Party_Short, Vorfreude, position) %>%
ggplot(aes(x=position, y=Vorfreude, fill= Party_Short))+
geom_col(width = .5)+
theme_minimal()+
scale_x_discrete(limit=c(-9.5, -7.5, -5, 0, 5, 7.5, 9.5),
labels=c("-10", "links", "-5", "Mitte", "5", "rechts", "10"))+
scale_y_continuous(labels = scales::percent, limits = c(0,0.7))+
scale_fill_manual(values = c("#e7c820", "#d6872b", "#add8e6", "#3871b4", "#999a01", "#85b547", "#f0564e", "#4c8a3f"))+
guides(fill=guide_legend(title="Partei:"))+
theme(legend.position = "bottom", legend.box = "horizontal") +
xlab("Parteiposition auf der Links-Rechts-Skala") +
ylab("'Vorfreude-Posts' in Prozent")
Ekel <- Alle_Emos_wideformat %>%
select(Party_Short, Ekel, position) %>%
ggplot(aes(x=position, y=Ekel, fill= Party_Short))+
geom_col(width = .5)+
theme_minimal()+
scale_x_discrete(limit=c(-9.5, -7.5, -5, 0, 5, 7.5, 9.5),
labels=c("-10", "links", "-5", "Mitte", "5", "rechts", "10"))+
scale_y_continuous(labels = scales::percent, limits = c(0,0.7))+
scale_fill_manual(values = c("#e7c820", "#d6872b", "#add8e6", "#3871b4", "#999a01", "#85b547", "#f0564e", "#4c8a3f"))+
guides(fill=guide_legend(title="Partei:"))+
theme(legend.position = "bottom", legend.box = "horizontal") +
xlab("Parteiposition auf der Links-Rechts-Skala") +
ylab("'Ekel-Posts' in Prozent")
Freude <- Alle_Emos_wideformat %>%
select(Party_Short, Freude, position) %>%
ggplot(aes(x=position, y=Freude, fill= Party_Short))+
geom_col(width = .5)+
theme_minimal()+
scale_x_discrete(limit=c(-9.5, -7.5, -5, 0, 5, 7.5, 9.5),
labels=c("-10", "links", "-5", "Mitte", "5", "rechts", "10"))+
scale_y_continuous(labels = scales::percent, limits = c(0,0.7))+
scale_fill_manual(values = c("#e7c820", "#d6872b", "#add8e6", "#3871b4", "#999a01", "#85b547", "#f0564e", "#4c8a3f"))+
guides(fill=guide_legend(title="Partei:"))+
theme(legend.position = "bottom", legend.box = "horizontal") +
xlab("Parteiposition auf der Links-Rechts-Skala") +
ylab("'Freude-Posts' in Prozent")
Traurigkeit <- Alle_Emos_wideformat %>%
select(Party_Short, Traurigkeit, position) %>%
ggplot(aes(x=position, y=Traurigkeit, fill= Party_Short))+
geom_col(width = .5)+
theme_minimal()+
scale_x_discrete(limit=c(-9.5, -7.5, -5, 0, 5, 7.5, 9.5),
labels=c("-10", "links", "-5", "Mitte", "5", "rechts", "10"))+
scale_y_continuous(labels = scales::percent, limits = c(0,0.7))+
scale_fill_manual(values = c("#e7c820", "#d6872b", "#add8e6", "#3871b4", "#999a01", "#85b547", "#f0564e", "#4c8a3f"))+
guides(fill=guide_legend(title="Partei:"))+
theme(legend.position = "bottom", legend.box = "horizontal") +
xlab("Parteiposition auf der Links-Rechts-Skala") +
ylab("'Traurigkeit-Posts' in Prozent")
Überraschung <- Alle_Emos_wideformat %>%
select(Party_Short, Überraschung, position) %>%
ggplot(aes(x=position, y=Überraschung, fill= Party_Short))+
geom_col(width = .5)+
theme_minimal()+
scale_x_discrete(limit=c(-9.5, -7.5, -5, 0, 5, 7.5, 9.5),
labels=c("-10", "links", "-5", "Mitte", "5", "rechts", "10"))+
scale_y_continuous(labels = scales::percent, limits = c(0,0.7))+
scale_fill_manual(values = c("#e7c820", "#d6872b", "#add8e6", "#3871b4", "#999a01", "#85b547", "#f0564e", "#4c8a3f"))+
guides(fill=guide_legend(title="Partei:"))+
theme(legend.position = "bottom", legend.box = "horizontal") +
xlab("Parteiposition auf der Links-Rechts-Skala") +
ylab("'Überraschung-Posts' in Prozent")
Vertrauen <- Alle_Emos_wideformat %>%
select(Party_Short, Vertrauen, position) %>%
ggplot(aes(x=position, y=Vertrauen, fill= Party_Short))+
geom_col(width = .5)+
theme_minimal()+
scale_x_discrete(limit=c(-9.5, -7.5, -5, 0, 5, 7.5, 9.5),
labels=c("-10", "links", "-5", "Mitte", "5", "rechts", "10"))+
scale_y_continuous(labels = scales::percent, limits = c(0,0.7))+
scale_fill_manual(values = c("#e7c820", "#d6872b", "#add8e6", "#3871b4", "#999a01", "#85b547", "#f0564e", "#4c8a3f"))+
guides(fill=guide_legend(title="Partei:"))+
theme(legend.position = "bottom", legend.box = "horizontal") +
xlab("Parteiposition auf der Links-Rechts-Skala") +
ylab("'Vertrauen-Posts' in Prozent")
ggsave(Zorn, file = "zorn.PNG", width = 9, height = 7)
ggsave(Vorfreude, file = "vorfreude.PNG", width = 9, height = 7)
ggsave(Ekel, file = "ekel.PNG", width = 9, height = 7)
ggsave(Angst, file = "angst.PNG", width = 9, height = 7)
ggsave(Freude, file = "freude.PNG", width = 9, height = 7)
ggsave(Traurigkeit, file = "traurigkeit.PNG", width = 9, height = 7)
ggsave(Überraschung, file = "überraschung.PNG", width = 9, height = 7)
ggsave(Vertrauen, file = "vertrauen.PNG", width = 9, height = 7)
########################
### sämtliche Emotions per Party mit insgesamt posts verrechen
#### Ziel: Beispiel Anger: Durchschnittscount für Anger pro Post, wenn MINDESTENS ein Wort
#### dem Sentiment Anger zugeordnet werden konnte.
Emo_pro_Post_gezählt <-Emo_in_Post%>%
dfm() %>%
convert(to = "data.frame")
Emo_pro_Post_gezählt$doc_id <- gsub("[0-9]", "", Emo_pro_Post_gezählt$doc_id)
#groupen und gewünschte Variablen auswählen
durchschnitt_pro_emo_pro_partei <- Emo_pro_Post_gezählt %>%
select(-c(negative,positive))%>%
group_by(doc_id)
#Falls emotion bei Post nicht vorhanden = NA
durchschnitt_pro_emo_pro_partei[durchschnitt_pro_emo_pro_partei == 0] <- NA
#durchschnitt berechnen
durchschnitt_pro_emo_pro_partei <- durchschnitt_pro_emo_pro_partei %>%
group_by(doc_id) %>%
summarise(anger = mean(anger, na.rm = T),
anticipation = mean(anticipation, na.rm = T),
disgust = mean(disgust, na.rm = T),
fear = mean(fear, na.rm = T),
joy = mean(joy, na.rm = T),
sadness = mean(sadness, na.rm = T),
surprise = mean(surprise, na.rm = T),
trust = mean(trust, na.rm = T)
) %>%
filter(!doc_id %in% c("EVP", "Piraten", "up!"))
# summarise_at(vars(anger:trust), function(x){
# sum(x)/length(x)
#}) %>%
#filter(!(doc_id %in% c("Piraten", "up!", "EVP")))%>%
#pivot_longer(anger:trust, values_to= "values", names_to = "emotions") %>%
#ggplot(aes(x = doc_id, y = values, fill = doc_id)) +
#geom_bar(stat='identity', position='dodge')+
#scale_fill_manual(values = c("#e7c820", "#d6872b", "#3871b4", "#999a01", "#85b547", "#f0564e", #"#4c8a3f"))+
#facet_wrap(~emotions, nrow = 4, ncol = 2)+
#theme_minimal()+
#theme(legend.position = "none")+
#xlab("")+
#ylab("") +
#scale_y_continuous(labels = scales::percent)Javacode für interaktive Grafik
Der folgende Chunk enthält das html-script für die interaktive Grafik.
<!DOCTYPE html>
<html>
<head>
<title>Welche Emotionen bespielen die Parteien?</title>
<meta charset="UTF-8">
<meta name="viewport" content="width=device-width, initial-scale=1.0">
<link href="https://cdn.jsdelivr.net/npm/bootstrap@5.0.1/dist/css/bootstrap.min.css" rel="stylesheet" integrity="sha384-+0n0xVW2eSR5OomGNYDnhzAbDsOXxcvSN1TPprVMTNDbiYZCxYbOOl7+AMvyTG2x" crossorigin="anonymous">
<style>
.form-control {
margin: auto;
width: auto;
height: auto;
}
#grafik {
positon: absolute;
width: 100%;
height: auto;
max-height: 100%;
}
</style>
</head>
<body>
<select name="bildauswahl" id="bildauswahl" onchange="changeImage(this.value)" class="form-control">
<option value="angst.PNG">Wie viele "Angst-Posts" verbreiten die Parteien?</option>
<option value="zorn.PNG">Wie viele "Zorn-Posts" verbreiten die Parteien?</option>
<option value="traurigkeit.PNG">Wie viele "Traurigkeits-Posts" verbreiten die Parteien?</option>
<option value="ekel.PNG">Wie viele "Ekel-Posts" verbreiten die Parteien?</option>
<option value="freude.PNG">Wie viele "Freuden-Posts" verbreiten die Parteien?</option>
<option value="vorfreude.PNG">Wie viele "Vorfreuden-Posts" verbreiten die Parteien?</option>
<option value="vertrauen.PNG">Wie viele "Vertrauens-Posts" verbreiten die Parteien?</option>
<option value="überraschung.PNG">Wie viele "Überraschungs-Posts" verbreiten die Parteien?</option>
</select>
<img src="angst.PNG" id="grafik">
<script>
function changeImage(bild){
document.getElementById("grafik").src = bild;
}
</script>
</body>
</html>Wir können das ganze noch auf spezifische Themengebiete anschauen. Mit: tokens_keep(). Dazu erstellen wir für einzelne Themengebiete kleine Wörterbücher, welche wir als pattern einsetzen.
—> Wird im Artikel bewusst weggelassen, um im Artikel konkret zu bleiben und den Lesefluss nicht zu stören.
##### Auf Themen filtern
############# grosse buchstaben noch verkleinern ####################
Corona_Wörter <- c("covid*",
"corona*",
"virus*",
"lockdown*",
"impf*",
"mundschutz",
"maske",
"pandemie",
"pcr-test",
"reproduktionszahl",
"sars-cov-2",
"superspreader",
"inzidenz",
"ffp2",
"symptome",
"inkubationszeit",
"positivitätsrate",
"übersterblichkeit",
"hygiene*",
"contact*",
"herdenimmunität",
"infektion*"
)
toks_corona <- tokens_keep(toks_facebook,
pattern = Corona_Wörter,
window = 100,
valuetype="regex")
# Analyse um Fenster
toks_corona_dict <- tokens_lookup(toks_corona, dictionary = dict_sent_nrc)%>%
dfm()
toks_corona_dict %>%
dfm_group(Party_Short) %>%
dfm_weight(scheme = "prop") %>%
textstat_frequency(groups=Party_Short) %>%
filter(!(group %in% c("Piraten", "up!", "EVP")))%>%
mutate(feature = case_when(feature == "anger" ~ "Zorn",
feature == "anticipation" ~ "Vorfreude",
feature == "disgust" ~ "Ekel",
feature == "fear" ~ "Angst",
feature == "joy" ~ "Freude",
feature == "sadness" ~ "Traurigkeit",
feature == "surprise" ~ "Überraschung",
feature == "trust" ~ "Vertrauen",
feature == "positive" ~ "Positiv",
feature == "negative" ~ "Negativ",
)) %>%
ggplot(aes(y=feature,x=frequency,fill=feature))+
facet_wrap(~group,nrow=2)+
geom_col()+
theme_minimal()+
theme(legend.position="none")+
ggtitle("Wie kommunizieren die Parteien rund um Covid-19")+
ylab("")+
xlab("gewichtete Häufigkeit")
##### Auf Themen filtern (Begriffe stammen vom Deutschen Bundesministerium für Umwelt)
Klima_Wörter <- c("klima*",
"treibhaus*",
"c0*",
"erderwärmung",
"fossile *",
"erneuerbare energie*",
"permafrost",
"energiewende",
"atomausstieg",
"fridays for future",
"waldsterben",
"strom*",
"nachhaltig*",
"abgase",
"agenda 2030",
"atmosphäre",
"aussterben",
"flugscham",
"beifang",
"bevölkerungswachstum",
"bienensterben",
"biodiversität",
"boden*",
"boden",
"dschungel",
"dürre",
"energie*",
"erdöl",
"feinstaub",
"fleischkonsum",
"fossile *",
"geo*",
"hitze*",
"hochwasser*",
"individualverkehr",
"kernkraft*",
"kohle*",
"kyoto*",
"öko*",
"meeresspiegel",
"monokultur",
"nachhaltig*",
"ozon *",
"palmöl",
"permafrost",
"photovoltaik",
"radioaktiv*",
"ressourcen*",
"solar*",
"umwelt*",
"wasserkraft*",
"wetter*",
"zukunft"
)
#noch ergänzen (Klima-wörter) # synonyme im duden nachschauen
toks_klima <- tokens_keep(toks_facebook,
pattern = Klima_Wörter,
window = 100,
valuetype="regex")
# Analyse um Fenster
toks_klima_dict <- tokens_lookup(toks_klima, dictionary = dict_sent_nrc)%>%
dfm()
toks_klima_dict %>%
dfm_group(Party_Short) %>%
dfm_weight(scheme = "prop") %>%
textstat_frequency(groups=Party_Short) %>%
filter(!(group %in% c("Piraten", "up!", "EVP")))%>%
mutate(feature = case_when(feature == "anger" ~ "Zorn",
feature == "anticipation" ~ "Vorfreude",
feature == "disgust" ~ "Ekel",
feature == "fear" ~ "Angst",
feature == "joy" ~ "Freude",
feature == "sadness" ~ "Traurigkeit",
feature == "surprise" ~ "Überraschung",
feature == "trust" ~ "Vertrauen",
feature == "positive" ~ "Positiv",
feature == "negative" ~ "Negativ",
)) %>%
ggplot(aes(y=feature,x=frequency,fill=feature))+
facet_wrap(~group,nrow=2)+
geom_col()+
theme_minimal()+
theme(legend.position="none")+
ggtitle("Wie kommunizieren die Parteien rund um das Thema Klimawandel")+
ylab("") +
xlab("gewichtete Häufigkeit")
Politiker-Analyse
In einem nächsten Schritt schauen wir die Kommunikation der einzelnen Parlamentarier auf Twitter an. Ziel ist es herauszufinden, wer am “negativsten” und wer am “positivsten” kommuniziert. (neg/pos und einzelne Emotionen anzeigen) Weiter will ich aufzeigen, über welche Themen diese Politiker sprechen (textstat_keyness()). Diese werden mithilfe einer Wordcloud aufgezeigt.
data_twitter <- readRDS("twitter_parlamentarians.RDS")
# combine Names for analysis
data_twitter$Name <- gsub(" ", "_", data_twitter$Name)
data_twitter$Name <- gsub("-", "_", data_twitter$Name)
#clean the data, add missings
data_twitter_clean <- data_twitter %>%
select(Gender, Text, Name, Datum, Party, Party_Short, Akteur, Last_Name) %>%
filter(Akteur == "Parliamentarian") %>%
group_by(Name) %>%
#not all Party_short are in the df, add with Party_name
mutate(Party_Short = case_when(Party == "sozialdemokratische partei der schweiz" ~ "SP",
Party == "fdp.die liberalen" ~ "FDP",
Party == "grüne partei der schweiz" ~ "GPS",
Party == "schweizerische volkspartei" ~ "SVP",
Party == "christlichdemokratische volkspartei der schweiz" ~ "CVP",
Party == "grünliberale partei" ~ "GLP",
Party == "bürgerlich-demokratische partei schweiz" ~ "BDP",
Party == "evangelische volkspartei der schweiz" ~ "EVP")) %>%
mutate(number=str_pad(row_number(),width=4,pad="0"), #document names
doc_id=paste0(Name,number))%>%
mutate(Datum = ymd(Datum))## Adding missing grouping variables: `Status_id`#create a corpus
twitter_corpus <- corpus(data_twitter_clean,
text_field = "Text")
#### create the document feature matrix
twitter_dfm <- dfm(twitter_corpus,
what = c("word"),
include_docvars = T)
#### tokenize the whole story
toks_twitter <- tokens(twitter_corpus,
what = c("word"),
remove_punct = T,
remove_numbers = T,
include_docvars = T,
split_hyphens = T,
remove_symbols = T) # after first analysis (remove_hypens is deprecated)
### collocation (same as facebook-data)
toks_twitter <- tokens_compound(toks_twitter, pattern = phrase(multiword))
#remove stopwords
toks_twitter <- toks_twitter %>%
tokens_remove(c(stopwords("german")),
padding = T)
#collocation second round
toks_twitter <- tokens_compound(toks_twitter, pattern = phrase(multiword2))
# remove empty tokes and lower all tokens
toks_twitter <- toks_twitter %>%
tokens_remove("")
toks_twitter <- tokens_tolower(toks_twitter)
#first sentiment analysis
twitter_sent_nrc <- tokens_lookup(toks_twitter, dict_sent_nrc , valuetype = "glob") %>%
dfm()
######## aggregate to parties
twitter_sent_nrc <- twitter_sent_nrc %>%
dfm_group(Name)
Name_sentiment <- twitter_sent_nrc %>%
convert(to = "data.frame") %>%
bind_cols(docvars(twitter_sent_nrc)) %>%
group_by(Name)%>%
mutate(neg_to_pos = (negative / (positive + negative))*100) %>%
filter(Party_Short != "") %>%
filter(positive > 200) %>%
arrange(desc(neg_to_pos))
first_glimpse <- rbind(head(Name_sentiment), tail(Name_sentiment))
first_glimpse <- first_glimpse %>%
arrange(desc(neg_to_pos))
#first plot
first_glimpse %>%
ggplot(aes(y=reorder(Name,neg_to_pos),x=neg_to_pos/100, fill = Party_Short))+
geom_col()+
theme_minimal()+
ylab("")+
xlab("Prozentanteil von negativen Wörtern\n in Politiker-Tweets")+
ggtitle("De Roger isch de hässigst")+
scale_x_continuous(labels = scales::percent) +
labs(fill = "Partei-\nzugehörigkeit")+
scale_fill_manual(values = c("#d6872b", "#3871b4", "#999a01", "#85b547", "#f0564e", "#4c8a3f"))
#scatterplot, um die Verhältnisse wiederum auf einer links-rechts-Achse darzustellen.
### tf-idf ###
# get rid of all @-words
data_twitter_clean$Text <- gsub("@\\w+ *", "", data_twitter_clean$Text)
twitter_words <- data_twitter_clean %>%
unnest_tokens(word, Text) %>%
count(Name, word, sort = T)
total_words <- twitter_words %>%
group_by(Name) %>%
summarize(total = sum(n))
twitter_words <- left_join(twitter_words, total_words, by = "Name")
###remove some meaningless stopwords -> from "snowball"
stopwords_politiker <- as.data.frame(stopwords::stopwords("de", source = "snowball"))
colnames(stopwords_politiker) <- c("word")
### remove with a anti-join
twitter_words <- anti_join(twitter_words, stopwords_politiker,
by = "word")
###remove some meaningless stopwords (en) -> from "snowball"
stopwords_politiker2 <- as.data.frame(stopwords::stopwords("en", source = "snowball"))
colnames(stopwords_politiker2) <- c("word")
### remove with a anti-join
twitter_words <- anti_join(twitter_words, stopwords_politiker2,
by = "word")
###tf_idf
twitter_words_tf_idf <- twitter_words %>%
bind_tf_idf(word, Name, n)
twitter_words_tf_idf <- twitter_words_tf_idf %>%
select(-total) %>%
arrange(desc(tf_idf))
# plot
themen_twitter_politiker <- twitter_words_tf_idf %>%
group_by(Name) %>%
filter(Name %in% c("Roger_Köppel", "Claudio_Zanetti", "Thomas_Aeschi",
"Doris_Fiala", "Adrian_Wüthrich", "Martin_Candinas"))%>%
slice_max(tf_idf, n = 10) %>%
ungroup() %>%
ggplot(aes(tf_idf, fct_reorder(word, tf_idf), fill = Name)) +
geom_col(show.legend = FALSE) +
facet_wrap(~Name, ncol = 2, scales = "free") +
labs(x = "tf-idf", y = NULL) +
theme_minimal() +
ggtitle("Welche einzigartigen Wörter benutzen die Parlamentarier auf Twitter")+
xlab("")
#Für den Artikel werden die Wordclouds von Herrn Köppel und Herrn Candinas verwendet.
Roger <- twitter_words_tf_idf %>%
filter(Name == "Roger_Köppel")
Martin <- twitter_words_tf_idf %>%
filter(Name == "Martin_Candinas")
Roger_Wordcloud <- wordcloud(words = Roger$word, freq = round(Roger$tf_idf*10000),
max.words = 100,random.order=FALSE, rot.per=0.35,
colors=brewer.pal(8, "Dark2"))
Martin_Wordcloud <- wordcloud(words = Martin$word, freq = round(Martin$tf_idf*10000),
max.words = 100,random.order=FALSE, rot.per=0.35,
colors=brewer.pal(8, "Dark2"))
Haben negative Tweets mehr likes als positive? inkl. t.Test
Im folgenden werden die durchschnittlichen Likes & Retweets der oben genannten Politiker für positive bzw. negative Tweets herausgearbeitet. Annahme: Wenn mehr Wörter dem positiven Senitment zugeordnet werden können, gilt der Tweet als positiv und umgekehrt.
#names(data_twitter)
Retweets <- data_twitter %>%
select(Text, Name, Datum, Party, Party_Short, Akteur, Last_Name, Retweet_count,
Retweet_status_id, Retweet_favorite_count) %>%
filter(Akteur == "Parliamentarian") %>%
group_by(Name) %>%
#not all Party_short are in the df, add with Party_name
mutate(Party_Short = case_when(Party == "sozialdemokratische partei der schweiz" ~ "SP",
Party == "fdp.die liberalen" ~ "FDP",
Party == "grüne partei der schweiz" ~ "GPS",
Party == "schweizerische volkspartei" ~ "SVP",
Party == "christlichdemokratische volkspartei der schweiz" ~ "CVP",
Party == "grünliberale partei" ~ "GLP",
Party == "bürgerlich-demokratische partei schweiz" ~ "BDP",
Party == "evangelische volkspartei der schweiz" ~ "EVP")) %>%
mutate(number=str_pad(row_number(),width=4,pad="0"), #document names
doc_id=paste0(Name,number))%>%
mutate(Datum = ymd(Datum))## Adding missing grouping variables: `Status_id`#same procedure as above
retweet_corpus <- corpus(Retweets,
text_field = "Text")
#### create the document feature matrix
retweet_dfm <- dfm(retweet_corpus,
what = c("word"),
include_docvars = T)
#### tokenize the whole story
toks_retweet <- tokens(retweet_corpus,
what = c("word"),
remove_punct = T,
remove_numbers = T,
include_docvars = T,
split_hyphens = T,
remove_symbols = T) # after first analysis (remove_hypens is deprecated)
### collocation (same as facebook-data)
toks_retweet <- tokens_compound(toks_retweet, pattern = phrase(multiword))
#remove stopwords
toks_retweet <- toks_retweet %>%
tokens_remove(c(stopwords("german")),
padding = T)
toks_retweet <- tokens_compound(toks_retweet, pattern = phrase(multiword2))
toks_retweet <- toks_retweet %>%
tokens_remove("")
toks_retweet <- tokens_tolower(toks_retweet)
count_retweets_likes <- tokens_lookup(toks_retweet, dict_sent_nrc , valuetype = "glob") %>% dfm() %>%
convert(to = "data.frame") %>%
left_join(Retweets, by = "doc_id") %>%
filter(Name %in% c("Roger_Köppel", "Claudio_Zanetti", "Thomas_Aeschi",
"Doris_Fiala", "Adrian_Wüthrich", "Martin_Candinas")) %>%
filter(Retweet_status_id == "") %>% #Post eliminieren, wenn es ein Retweet ist
select(-c(number, Akteur, Text, Status_id, Party, anger, anticipation,
disgust, fear, joy, sadness, surprise, trust)) %>%
mutate(Retweet_count = as.numeric(Retweet_count))
#Einteilen in pos, neg
count_retweets_likes_POS <- count_retweets_likes %>%
filter(positive > negative) %>%
group_by(Name) %>%
mutate(durchschnitt_retweets = round(mean(Retweet_count))) %>%
summarise()
count_retweets_likes_NEG <- count_retweets_likes %>%
filter(positive < negative) %>%
group_by(Name) %>%
mutate(durchschnitt_retweets = round(mean(Retweet_count)))
#Ermitteln, ob Unterschied von Retweets Pos/Neg statistisch signifikant ist
count_retweets_likes_POS_Ttest <- count_retweets_likes %>%
filter(positive > negative)
count_retweets_likes_NEG_Test <- count_retweets_likes %>%
filter(positive < negative)
TTEST <- t.test(count_retweets_likes_POS_Ttest$Retweet_count, count_retweets_likes_NEG_Test$Retweet_count)
# diff is significant on the 0.05-alpha-level