Installieren und Laden von Paketen

# Benötigte Pakete laden
library(sf) # geo data handling
library(dplyr) # data crunching
library(data.table) # data crunching
library(tidyverse) # data crunching
library(ggplot2) # plots
library(scales) # scale colorscheme
library(ggrepel) # for labeling
library(stats) # for relevelling
library(sjPlot) # plot
library(stargazer) # table
library(quanteda) # text analysis
library(quanteda.textstats) # text statistics
library(quanteda.textplots) # text plots
library(stringr) # string text
library(readxl) # reading excel files 
library(graphics) # matplot
library(devtools) # dev tools


Daten laden

# Arbeitsverzeichnis definieren
setwd(paste0("~/Desktop/Uni – Backup/2. MA/FS 2021/DDJ FS 2021"))


# Dateipfad definieren
file_path1 <- "./zeitungsartikel_de_2020.RDS"


# Daten einlesen (Textdaten aus der Schweizer Mediendatenbank)
SMD_Data <- readRDS(file_path1)


Daten ordnen und säubern

# Datensatz anpassen
SMD_Data <- SMD_Data %>% 
  filter(la == "de") %>%
  select(so_txt, pubDateTime, la, ru, ht, ut, tx, selectsclass)


# Textkorpus erstellen
korpus <- corpus(SMD_Data, text_field = "tx")


# Korpus tokenisieren
toks <- tokens(korpus, remove_punct=T, remove_numbers=T, remove_symbols=T, remove_url=T, remove_separators=T)


# ALle Tokens klein schreiben
toks <- tokens_tolower(toks)


# Eigene Stoppwörter definieren und dann entfernen (inkl. Namen von Medien, Namen und Kürzel von Medienschaffenden, usw.)
mystopwords1 <- c(" ", "schweiz","schweizer","schweizerinnen","menschen","prozent", "sagt", "für", "dass", "letzte", "letzt", "letzter", "letztes", "letzten", "vorletzte", "gestern", "ausserdem", "bereits", "erster", "zweiter", "dritter", "erste", "zwei", "drei", "zweite", "dritte", "erstens", "zweitens", "drittens", "dutzend", "neue", "grundsätzlich", "soeben", "nebst", "neben", "kurz" , "immer" , "selten" , "nie" , "manchmal" , "oft" , "oftmals", "zwischendurch" , "dabei", "bisher", "seit", "seitdem", "erst", "ja", "beim", "z.B.", "der", "die", "das", "ab", "jahren", "jahr", "jahre", "jährige", "beiden", "beide", "deshalb", "dafür", "müssen", "dennoch", "heute", "ist", "sei", "rund", "mehr", "sofort", "danach", "schon", "anhin", "bald", "haben", "hat", "habt", "hatten", "wäre", "viele", "vieles", "vielen", "vielem", "einfach", "so", "davon", "vielleicht", "weil", "aufgrund", "gerade", "wurden", "gegen", "wider", "wurde", "wurdest", "deshalb", "dafür", "darum", "dagegen", "selbst", "selber", "weitere", "weiteres", "weiterer", "wegen", "ganz", "eben", "direkt", "notre", "müssen", "gut", "geht", "zeit", "sagte", "ersten", "ende", "etwa", "seien", "worden", "neuen", "zürich", "sollen", "kommt", "kanton", "mal", "personen", "steht", "leben", "laut", "zudem", "weniger", "trump", "vier", "macht", "sowie", "allerdings", "woche", "wer", "wochen", "fast", "stadt", "grossen", "gibt", "hätten", "jedoch", "kommen", "heisst", "grosse", "bern", "gab", "usa", "lassen", "uhr", "welt", "land", "gar", "fall", "hätte", "wohl", "lange", "möglich", "tag", "kam", "klar", "gehen", "später", "jüngst", "frau", "zeigt", "bild", "mann", "stehen", "fünf", "präsident", "darauf", "pro", "wenig", "kinder", "gilt", "kaum", "zurück", "frage", "bleiben", "derzeit", "konnte", "liegt", "märz", "saison", "leute", "frauen", "beispiel", "teil", "sogar", "statt", "vergangenen", "sieht", "bleibt", "sehen", "zürcher", "geben", "warnend", "stark", "lässt", "unsere", "tagen", "besonders", "könnten", "denen", "anfang", "neu", "findest", "psychische", "images", "gehtsin", "gehtsder", "pérez", "digitaltage", "triaca", "anian", "zhdas", "triebe", "archivbild", "ungeschnittener", "keystone", "imagesdarum", "symbolbild", "gehtsdas", "getty", "anabelle", "telefon-podcast", "istockphotodarum", "reutersdarum", "gehtseine", "people-push", "lesen", "authentischer", "blum", "blanc", "blick.die", "krönt", "agdie", "studer", "flammer", "orellano1", "wendler", "gehtsam", "chk", "gehtsim", "jemand", "screenshot", "erzähl", "zanni1", "gehtsein", "gehtswegen", "hast", "20-minuten-app", "wissen-kanals", "waldmeier1", "lüthy1", "iuliano", "graf1", "scherer1", "werden.vor", "riebeling1", "heimann1", "benachrichtigungen", "abonnierst", "forster1", "garzoni", "hand", "box", "keystonedie", "bildstrecke", "gux", "leser-reporter", "pöschl1", "20-minuten-leser", "8die", "unshier", "minutendarum", "keystoneder", "formular.zusammen", "derpsychiatrischen", "kämpfst", "till", "keystone-sda.chdarum", "funktionsumfang", "kannst", "messmer1", "gehtsseit", "gehtsnach", "bruggmann")

mystopwords2 <- c("gegenüber", "damals", "besser", "zweiten", "zehn", "finden", "nächsten", "tage", "tun", "eigenen", "zusammen", "gemacht", "basel", "sagen", "foto", "ebenfalls", "könne", "dürfen", "bekannt", "deutlich", "trotz", "platz", "meisten", "mai", "gleich", "zahl", "juni", "montag", "schweizund", "schreibt", "genau", "wissen", "schnell", "deutschland", "sommer", "weiss", "fc", "mehrere", "minuten", "erklärt", "spieler", "wichtig", "weit", "spielen", "sonntag", "april", "luzern", "erhalten", "freitag", "hause", "gemäss", "weiterhin", "natürlich", "zahlen", "eigentlich", "sicher", "lage", "spiel", "team", "stellen", "seite", "halten", "dürfte", "darf", "fragen", "sechs", "zeigen", "ganze", "deren", "findet", "ging", "daran", "januar", "eher", "paar", "mittwoch", "november", "samstag", "september", "stand", "gehört", "braucht", "china", "knapp", "league", "ziel", "grund", "berner", "monaten", "darüber","august", "sollten", "gute", "fr", "folgen", "st", "ramp", "gastkommentar", "hansueli", "israeli", "nehmen", "trotzdem", "zuvor", "geschichte", "sda", "nzz", "woz", "liechtenstein", "weltweitkönnen", "aktiv.in", "srf.ch", "srf", "blick", "faki", "sermîn", "kimche", "zhdie", "gnehm", "fictionin", "gibts", "zu-", "zürichich", "20m", "key", "istock", "tel", "dgr", "daw", "reu", "figo", "dk", "zanni", "bello", "red", "mth", "pu", "sch", "sip", "jaudas", "meienberg", "net", "zac", "fes", "tif", "diem", "20min.ch", "20mdie", "trx", "20minuten.ch", "juu", "pam", "3fach", "keystonezahl", "mitteilte", "mack", "fpo", "epa", "rust", "rimoczi", "2-3", "blick-interview", "blick-anfrage", "agich", "blick-leser", "genesis", "beich", "dorerchefredaktor", "gianna", "myrte", "rotzinger", "blick-recherchen", "zh", "zhich", "cc", "cerny", "blick-informationen", "donghi", "kolic", "gegenwärtigen", "wysling", "forster", "larissa", "rhyn", "ruckstuhl", "gegenwärtig", "kölling", "statistischen", "startet", "grafiken", "informieren", "unterbrechen", "abgebildet", "höheren", "schneebeli", "zet", "hew", "zander", "lop", "dsa", "5auswirkungen", "aho", "fassbind", "unternährer", "agence", "hub", "anderegg", "thw", "steiner", "gegönnt", "ballmer", "kolbe", "sgich", "sembinelli", "alfa-sauber", "frey", "hwe", "gehtsinfos", "february", "kennst", "109pro", "00dureschnufe.ch", "dureschnufe.ch", "angststörungen", "147dargebotene", "wirtschaftszweigehotline", "juventute", "keystonedarum", "gehtsdie", "ratgeber", "gaetz", "sax", "bahnbrechende", "bag-infoline", "mühe", "plattform", "panik", "betroffene", "leserbriefe", "leserfrage", "kilian", "gimes", "einblendendie", "czu", "aussergewöhnlichen", "meiler", "joss", "january", "zürich.foto", "anna-tia", "tickers", "montanari", "march", "psychedie", "keystonedas", "michel1", "siehe", "imago", "steiger1", "gehtsus-präsident", "leser-reporterin", "kuriose") 


# Eigene Stoppwörter und Stoppwörter in verschiedenen Sprachen entfernen. (Obwohl der Datensatz nur deutschsprachige Artikel enthalten soll, gehe ich trotzdem davon aus, das teilweise auch Stoppwörter in Französisch, Italienisch und Englisch vorkommen. Zur Sicherheit entferne ich darum auch diese Stoppwörter)
toks <- toks %>%
  tokens_select(pattern = stopwords("de"), selection = "remove") %>%
  tokens_select(pattern = stopwords("fr"), selection = "remove") %>%
  tokens_select(pattern = stopwords("it"), selection = "remove") %>%
  tokens_select(pattern = stopwords("en"), selection = "remove") %>%
  tokens_select(pattern = mystopwords1, selection = "remove") %>%
  tokens_select(pattern = mystopwords2, selection = "remove")


# Ausgewählte Stichworte compounden
amerikanisch <- c("amerikanisch", "amerikanische", "amerikanischen")
comp1 <- rep("amerikanisch", length(amerikanisch))

toks <- tokens_replace(toks, amerikanisch, comp1, valuetype = "fixed")

wissenschafter <- c("wissenschafter", "wissenschaftern")
comp2 <- rep("wissenschafter", length(wissenschafter))

toks <- tokens_replace(toks, wissenschafter, comp2, valuetype = "fixed")

gliedstaat <- c("gliedstaat", "gliedstaaten")
comp3 <- rep("gliedstaat", length(gliedstaat))

toks <- tokens_replace(toks, gliedstaat, comp3, valuetype = "fixed")

trump <- c("trump", "trumps", "donald")
comp4 <- rep("trump", length(trump))

toks <- tokens_replace(toks, trump, comp4, valuetype = "fixed")


# Weitere Bereinigung: Topfeatures anzeigen lassen und Stoppwörter vervollständigen
# dfm_toks <- dfm(toks)

# topfeatures(dfm_toks, n=100)


Dictionary erstellen

# Dictionary für Corona erstellen. (Zum Teil sind Ausdrücke drin, die auf den ersten Blick nicht ganz Sinn ergeben <- z.B. "coronach". Solche Ausdrücke sollen aber Hashtags in Tweets wiedergeben, die von Zeitungen beispielweise zitiert wurden.)
corona_dict <- dictionary(list(corona=c("corona", "corona*", "*corona*", "coronavirus", "coronavirus*", "*coronavirus*", "virus", "virus*", "covid", "covid*", "*covid*", "covid19", "covid19*" ,"*covid19*", "sars-cov-2", "seuche", "covid-19-seuche", "cpvid-19-task-force", "task-force", "pandemie", "pandemie*", "*pandemie*", "corona-pandemie", "coronapandemie", "epidemie", "epidemie*", "*epidemie*", "corona-epidemie", "coronaepidemie", "epidemiologisch", "coronakrise*", "coronakrise", "corona-krise", "social distancing", "contact tracing", "contacttracing", "kontakt rückverfolgung", "coronatests", "corona-infektion", "corona-infektionen", "coronainfektion", "coronainfektionen", "herdenimunität", "neuinfektion", "neuinfektionen", "antikörper", "hospitalisierungsrate", "schutzmaske", "maske", "maskenpflicht", "hygienemaske", "atemschutz", "n95-maske", "n95-masken", "ffp-maske", "ffp-masken", "ffp2-maske", "ffp2-masken", "beatmungsgerät", "beatmungsgeräte", "impfen", "impfung", "impfung*", "*impfung*", "vakzin", "vakzin*", "*vakzin*", "massnahme", "massnahme*", "*massnahme*", "corona-massnahme", "corona-massnahme*", "corona-regel", "coronaregel", "corona-hilfe", "hilfspaket", "hilfspaket*", "corona-hilfspaket", "corona-kredit", "coronakredit", "covid-hilfe", "lockdown", "corona-lockdown", "shutdown", "corona-shutdown", "einschränkungen", "restriktionen", "coronaschweiz", "coronach", "coronavirusschweiz", "covid19ch", "covidch", " bag_ofsp_ufsp", "coronainfoch", "swisscovid", "swiss-covid-app", "covidapp", "covid-app", "covid app", "coronaapp", "corona-app", "corona app", "contact-tracing-app", "covidcodes", "covid-19-krise", "covid-19-erkrankung", "covid-19-erkrankungen", "bundesamt für gesundheit", "bag", "weltgesundheitsorganisation", "weltgesundheitsorganisation*", "who"))) 


# No-match-Argument spezifizieren
dict <- tokens_lookup(toks, corona_dict, nomatch="no_match")


Visualisierung: Relative Nennungen

# Zuerst das Objekt in ein dfm umwandeln, dann in ein data frame konvertieren und docvars hinzufügen

# Relative Werte berchen, also proportional zu den Anzahl 
dfm_corona <- dict %>%
  dfm() %>%
  dfm_weight("prop") %>% 
  convert("data.frame") %>%
  bind_cols(docvars(dict))


# Plot erstellen
plot_alle_rel <- 
  dfm_corona %>%
  mutate(Date = as.Date(pubDateTime, "%Y-%m-%d")) %>%
  group_by(Date) %>%
  select(corona) %>%
  summarize_all(mean) %>% #Durchschnitt der Anteil Nennungen pro Datum
  ggplot() +
  geom_area(aes(x=Date, y=corona), color="#e65e90", fill="#e65e90", alpha = .7) +   
  theme_538() +
  theme(panel.grid.minor.x=element_blank(),panel.grid.major.x=element_blank(), plot.caption = element_text(size = 7, hjust = 1)) +
    xlab("Zeitpunkt im Jahr 2020 (tägliche Werte)") +
    ylab("Durchschnittliche Häufigkeit von Corona-Begriffen") +
    labs(title = "In der ersten und zweiten Corona-Welle haben Medien am häufigsten \nCorona-Begriffe verwendet", 
         caption = "Daten: Digital Democracy Lab / SMD 2020") +
    theme(legend.position="none",axis.text.x=element_text(angle=60)) +
    scale_x_date(date_labels="%m/%y") +
      geom_vline(xintercept = (as.Date("2020-03-16")), color = "#878484", size= 0.5, linetype = "solid") + 
        annotate("text", x=as.Date("2020-03-16"), label= "Lockdown", y = 0.0305, size=4, angle = 90, vjust = -0.4, hjust=1, 
                 color = "#878484", linetype = "solid") +
      geom_vline(xintercept = (as.Date("2020-06-08")), color = "#878484", size= 0.5, linetype = "solid") +
        annotate("text", x=as.Date("2020-06-08"), label= "Letzte Öffnungen", y = 0.0305, size=4, angle = 90, vjust = -0.4, hjust=1,
                 color = "#878484", linetype = "solid") +
      geom_vline(xintercept = (as.Date("2020-10-29")), color = "#878484", size= 0.5, linetype = "solid") + 
        annotate("text", x=as.Date("2020-10-29"), label= "Shutdown", y = 0.0305, size=4, angle = 90, vjust = -0.4, hjust=1, 
                 color = "#878484", linetype = "solid")

plot_alle_rel

# Diesen Plot speichern
ggsave("plot_alle_rel.png", width = 8, height = 5)


Visualisierung: Relative Nennungen pro Medium

# Plot: Relative Nennungen
plot_alle_medien <- 
  dfm_corona %>%
  group_by(so_txt) %>% 
  select(corona) %>%
  summarize_all(mean) %>%
  ggplot() +
    geom_col(aes(x = fct_reorder(so_txt, corona*1000,), y = corona*1000), fill="#e65e90", alpha = .7) +
    coord_flip() +
    theme_538() +
    xlab("") +
    ylab("Durchschnittliche Häufigkeit pro 1000 Wörter") +
    labs(title = "Das SRF benutzt am meisten Corona-Begriffe, gefolgt von «20 Minuten»,", 
         subtitle = "swissinfo.ch und der «Basler-Zeitung»", 
         caption = "Daten: Digital Democracy Lab / SMD 2020") +
    theme(plot.title = element_text(size = 14, hjust = 5.5), 
          plot.subtitle = element_text(size = 14, hjust = -0.65),
          plot.caption = element_text(size = 8))

plot_alle_medien