#Datenbereinigung und Vorbereitung In diesem Abschnitt bereinige und bereite ich die Zeitungsdaten des SMD vor. Für die Analyse verwende ich nur deutsche Zeitungsartikel und nur Artikel von Medienoutlets, die Tages- oder Sonntagszeitungen sind (d.h. keine fachspezifischen Zeitungen).
#WD setzen
setwd("~/Master UZH/Polito/Vorlesungen/FS21_Datenjournalismus/Daten/Zeitungsdaten")
#Memorylimit raufsetzen für einfachere Datenverarbeitung
memory.limit(9999999999)## [1] 1e+10#Benötigte Libraries laden
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(quanteda)## Warning: package 'quanteda' was built under R version 4.0.4## Package version: 2.1.2## Parallel computing: 2 of 8 threads used.## See https://quanteda.io for tutorials and examples.##
## Attaching package: 'quanteda'## The following object is masked from 'package:utils':
##
## Viewlibrary(readtext)## Warning: package 'readtext' was built under R version 4.0.4library(syuzhet)## Warning: package 'syuzhet' was built under R version 4.0.4library(cld3)## Warning: package 'cld3' was built under R version 4.0.4library(ggplot2)
library(hrbrthemes)## NOTE: Either Arial Narrow or Roboto Condensed fonts are required to use these themes.## Please use hrbrthemes::import_roboto_condensed() to install Roboto Condensed and## if Arial Narrow is not on your system, please see https://bit.ly/arialnarrowlibrary(bbplot)
library(RColorBrewer)
library(quanteda.dictionaries)
library(tidyr)
library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.0 --## v tibble 3.0.1 v stringr 1.4.0
## v readr 1.4.0 v forcats 0.5.0
## v purrr 0.3.4## Warning: package 'readr' was built under R version 4.0.5## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(ggpubr)
#Zeitungsdaten einlesen
zeitungsdaten <- readRDS("zeitungsartikel_de_2020.rds")
#Nur deutsche Artikel behalten
zeitungsdaten_de <- dplyr::filter(zeitungsdaten, la=="de")
#Datum richtig formatieren
zeitungsdaten_de$Datum <- as.Date(zeitungsdaten_de$pubDateTime ,format="%Y-%m-%d")
#Cutoff-Variable definieren: Vier Zeitperioden
#Medienhäuser-Variable recodieren
zeitungsdaten_de <- zeitungsdaten_de %>% dplyr::mutate(cutoff = case_when(
Datum < "2020-03-16" ~ "prä-Lockdown I",
Datum >= "2020-03-16" & Datum < "2020-06-22" ~ "Lockdown I",
Datum >= "2020-06-22" & Datum < "2020-10-19" ~ "Massnahmen aufgehoben",
Datum >= "2020-10-19" ~ "Verschärfung/Lockdown II"))
#Themenspezifische News Outlets herausfiltern
zeitungsdaten_de <- zeitungsdaten_de %>% dplyr::filter(so_txt!="Der Landbote"&so_txt!="Finanz und Wirtschaft")
#Korpus machen
corpus_zeitungen <- corpus(zeitungsdaten_de, text_field="tx")
#Bedeutungsvolle ID definieren (Datum, Artikelklasse, Medienhauskategorie)
docid <- paste(zeitungsdaten_de$Datum,
zeitungsdaten_de$selectsclass,
zeitungsdaten_de$medium_polit,
sep=" ")
#Bedeutungsvolle ID dem Korpus hinzufügen
docnames(corpus_zeitungen) <- docid
#Korpus tokenisen; Punkte, Zahlen, URLs, Symbole rausnehmen, zusammengesetzte Worte auseinandersplitten
token_all <- tokens(corpus_zeitungen, "word", remove_number=T, remove_punct=T, remove_url = T, remove_symbols=T)
#Alles klein schreiben
token_all2 <- tokens_tolower(token_all)
#Stopworte in Deutsch rausnehmen + custom stopwords
token_all2 <- tokens_select(token_all2, pattern = stopwords("de"), selection = "remove")
token_all2 <- tokens_select(token_all2, pattern = c("dass", "les", "ami", "form", "rey", "angemeldet", "anmelden","reden", "geredet", "begründet", "begründen", "oftmals", "gefühlt", "fühlen", "fühlte", "bisher", "angesprochen", "ansprechen", "dennoch", "zeigen", "zeigt", "zeigte", "jornot", "sei", "ist", "bezeichnet", "bezeichnete", "bezeichnen", "ed", "rund", "findest", "findet", "finden", "mehr", "sagt", "wurde", "schon", "zwei", "seit", "immer", "gibt", "beim", "viele", "bereits", "ab", "müssen", "wegen", "heute", "drei", "geht", "neue", "wurden", "sagte", "rund", "ersten", "etwa", "seien", "dabei", "worden", "letzten", "neuen", "erst", "mal", "dafür", "sollen", "kommt", "wäre", "ja", "steht", "us", "ganz", "jährige", "laut", "zudem", "weniger", "deshalb", "vier", "davon", "macht", "beiden", "sowie", "wer", "allerdings", "fast", "sda","grossen", "hätten", "jedoch", "kommen", "heisst", "grosse", "weitere", "gab", "lassen", "erste", "nie", "gar", "einfach", "hätte", "lange", "möglich", "wohl", "kam", "gehen", "später", "pro", "gerade", "fünf", "zeigt", "stehen", "darauf", "wenig", "gilt", "zurück", "kaum", "bleiben", "konnte", "derzeit", "liegt", "sogar", "statt", "bisher", "sieht", "oft", "vergangenen", "bleibt", "geben", "unsere", "neu", "lässt", "denen", "damals", "gegenüber", "zehn", "finden", "zweiten", "eigenen", "tun", "vielen", "nächsten", "gemacht", "sagen", "dürfen", "könne", "ebenfalls", "gestern", "bekannt", "weiss", "trotz", "zahl", "meisten", "gleich", "vielleicht", "schreibt", "genau", "je", "plantage", "mehrere", "eigentlich", "darf", "weiterhin", "darum", "gemäss", "g", "natacha", "david", "halten", "ganze", "sechs", "zeigen", "findet", "deren", "st", "paar", "dürfte", "daran", "ging", "neben", "eher", "selber", "gehört", "braucht", "bald", "knapp", "danach", "darüber", "aufgrund", "trotzdem", "zuvor", "wirklich", "insgesamt", "per", "the", "ali", "coninx", "liege", "vivien", "wehrli", "paul", "kim", "meist", "kanye", "west", "kim", "kardashian", "rapper", "sheeran", "kneubühl", "albermann", "lukaschenko", "young", "neil", "mögliche", "abfragen", "kennst", "titel", "erinnert", "gesagt", "bleuler", "solle", "verwalters", "rabiei", "prozent.ein", "elin", "désiré", "beantwortet.laut", "kurt", "zentrums", "zivilisierte", "geschätzt", "wests", "betonte", "flament", "übernehmen", "günstig", "treffen", "beschäfigen.regierungssprecher", "erreichbar", "linden", "michael", "netanyahu", "rothenbühler", "beschädigen.regierungssprecher", "glauben", "science", "fiction", "schwarzen", "post", "elyne", "coop", "begriff", "wüest", "live", "klare", "erhöhen", "weil", "darum", "fast", "bleuler", "möglicherweise", "jüngste", "ahnung", "pk", "niklas", "nicht-essen", "baer", "m", "verschiedene", "pauli", "jemand", "spears", "halsey", "sarah"), selection="remove")
#Einige Stichworte compounden
bipolar <- c("bipolar", "bipolare", "bipolaren")
lemma <- rep("bipolar", length(bipolar))
token_all2 <- tokens_replace(token_all2, bipolar, lemma, valuetype = "fixed")
angeklagt <- c("angeklagt", "angeklagte", "angeklagten")
lemma2 <- rep("angeklagt", length(angeklagt))
token_all2 <- tokens_replace(token_all2, angeklagt, lemma2, valuetype = "fixed")
corona <- c("corona", "coronavirus", "virus", "coronakrise", "corona-krise")
lemma3 <- rep("corona", length(corona))
token_all2 <- tokens_replace(token_all2, corona, lemma3, valuetype = "fixed")
#DFM machen
dfm_all <- dfm(token_all2)
#Topfeatures herausgeben lassen und hierdurch induktiv die Stopwortliste ergänzen
a <- topfeatures(dfm_all, n=300)
#Originaldaten rauslöschen für extra Speicherkapazitäten
rm(zeitungsdaten)
#Assoziierte Keywords finden für Dictionary zu psychischer Gesundheit und Dictionary definieren;
#Ich nehme Depression nicht rein, weil Depression oft auch in wirtschaftlichen oder politischen Kontexten verwendet wird
psychische_krankheit <- dictionary(list(psychische_krankheit = c("angststörung*", "angstgestört*", "schziophren*", "schizoid*", "psychisch krank*", "psychische krankheit*", "panikstörung*", "angsterkrank*", "sozialphob*", "posttraum*", "panikattacke*","belastungsstörung*", "zwangsstörung*", "zwangsgestört*", "anorexi*", "bulimi*", "borderline*", "persönlichkeitsstörung*","adhs*", "autis*", "aufmerksamkeitsdefizit*", "psychische erkrankung*", "bipolar*", "manisch*", "burnout*", "burn-out*", "dissoziativ*", "multiple persönlichkeits*", "psychotisch*", "psychose*", "essstörung*", "essgestört*", "binge eating*", "multiple persönlichkeit*", "ptsb*", "dysthymi*", "zyklothym*", "cyclothym*", "cptsb*", "klaustrophob*", "psychische störung*")))
#toks_inside <- tokens_keep(token_all, pattern = psychische krankheit, window = 10)
#toks_inside <- tokens_remove(toks_inside, pattern = psychische krankheit)
#toks_outside <- tokens_remove(token_all, pattern = psychische krankheit, window = 10)
#dfmat_inside <- dfm(toks_inside)
#dfmat_outside <- dfm(toks_outside)
#tstat_key_inside <- textstat_keyness(rbind(dfmat_inside, dfmat_outside),
# target = seq_len(ndoc(dfmat_inside)))
#head(tstat_key_inside, 50)
#Negative, stereotypische Charaktereigenschaften psychisch kranker Personen definieren (durch Research)
stigma <- dictionary(list(Unintelligent = c("dumm*", "blöd*", "dämlich*","unintelligent*", "unfähig*"), Faul = c("faul*", "willensschwach*", "willensschwäche*", "charakterschwach*", "charakterschwäche*", "bequem*", "träge*"), Verrueckt=c("verrückt*", "wahn*", "durchdrehen*", "drehen durch*", "durchgedreht*", "wahnhaft*", "gestört*", "bescheuert*", "bekloppt*", "unvorhersehbar*", "abnormal*", "irr*", "hirnrissig*", "übergeschnappt*", "überschnapp*", "ausflippen*", "ausgeflippt*", "ausrasten*", "ausgerastet*"), Unzuverlaessig= "unzuverlässig*", Asozial =c("hinterlistig*", "hinterhältig*", "asozial*", "unverantwortlich*", "unmenschlich*", "querulant*", "unerzogen*", "unmoralisch*"), Strange = c("komisch*", "merkwürdig*", "unbeholfen*", "tolpatschig*", "tölpel*", "peinlich*", "sonderbar*", "schräg*", "bizarr*", "seltsam*", "eigenartig*"), Ueberempfindlich = c("empfindlich*", "überempfindlich*", "hypersensibel*", "emotional*", "dramatisch*"), Unmoralisch="unmoralisch*", Gefaehrlich=c("kriminell*", "gefährlich*", "gefahr*", "verbreche*", "alibi*", "attack*", "pistol*", "munition*", "messer*", "angriff*", "angreiff*", "angegriff*", "gewehr*", "sturmgewehr*", "brand*", "überfall*", "bedroh*", "tätlich*", "körperverletz*", "verletz*", "vergewaltig*", "sachschaden*", "polizei*", "tot*", "getötet*", "tödlich*", "täter*", "lebensgefährlich*", "stichwaffe*", "lebensbedrohlich*", "feuer*", "schwerverletz*", "angreifer*", "waffe*", "auseinandersetzung*")))#Analyse I/ Plots I & II: Salienz des Themas psychische Krankheiten über die Zeit
#Artikel, die Themen rund um psychische Gesundheit erwähnen; wir müssen über Tokens gehen, weil Quanteda ansonsten keine multi-word expressions, wie ich sie im Dictionary habe, matched
artikel_illness <- tokens_lookup(token_all2, psychische_krankheit, nomatch ="_unmatched") %>% dfm()
#Artikel-Anzahl pro Tag; ungematchte Features drinbehalten, sodass sich die rohen Zahlen gewichten lassen dann
textstat_artikel_illness_date <- textstat_frequency(artikel_illness, group = "Datum")
#Prep für Visualisierung
freq_artikel_illness_date <- textstat_artikel_illness_date %>% group_by(group) %>% #group=Datum
mutate(sum_docfreq = sum(docfreq)) %>% #sum_docfreq: Artikel insgesamt
ungroup()
#Ungematchte wieder herausfiltern
freq_artikel_illness_date <- freq_artikel_illness_date %>% filter(feature!="_unmatched")
#Prozentualer Anteil von Artikeln zu psychischer Gesundheit vs. Gesamtzahl pro Datum berechnen
freq_artikel_illness_date <- freq_artikel_illness_date %>% group_by(group) %>% #group=Datum
mutate(rel_psych = 100*(docfreq/sum_docfreq)) %>% #sum_docfreq: Artikel insgesamt
mutate(freq_per_doc = frequency/docfreq) %>%
ungroup()
#Datum wieder ins richtige Format übertragen
freq_artikel_illness_date <- freq_artikel_illness_date %>% dplyr::mutate(Datum = as.Date(group, format="%Y-%m-%d"))
#Outliers berechnen
outliers1 <- freq_artikel_illness_date %>% filter(rel_psych>=3.5)
outliers2 <- freq_artikel_illness_date %>% filter(freq_per_doc>=7.5)
#Plot: Artikelzahl über Zeit, Frequenz, Smooth-line-plot
plot_freq_artikel_datum <- ggplot(data = freq_artikel_illness_date, aes(x=Datum, y=rel_psych)) +
geom_point(size=1.1, alpha=0.5, color="#3B528B") +
geom_smooth(color="#3B528B") +
scale_x_date(date_labels="%b/%Y", date_breaks ="1 month") + theme_ipsum() + ylim(0,4.5) + labs(y="", x="", title="Artikel, die psychische Krankheiten erwähnen", subtitle="Trendlinie: Durchschnittlicher Prozentsatz über die Zeit", caption="Daten: Digital Democracy Lab. Grafik: Gina Messerli") + theme(
axis.text.y = element_text(size=rel(1.1)),
axis.text.x = element_text(size=rel(0.95), angle = 45, hjust = 1), plot.title = element_text(size=rel(1.05)), legend.title = element_text(face="bold"), plot.caption = element_text(size=rel(.7), face="italic", hjust = 0)) + geom_segment(data = freq_artikel_illness_date, aes(x = as.Date("16/03/2020", "%d/%m/%y"), xend = as.Date("16/03/2020", "%d/%m/%y"), y=0, yend=2.5), size = .72, linetype = "dashed", color="#404040") + geom_segment(data = freq_artikel_illness_date,aes(x = as.Date("22/06/2020", "%d/%m/%y"), xend = as.Date("22/06/2020", "%d/%m/%y"), y=0, yend=2.5), size = .72, linetype = "dashed", color="#404040") + geom_segment(data = freq_artikel_illness_date, aes(x = as.Date("19/10/2020", "%d/%m/%y"), xend = as.Date("19/10/2020", "%d/%m/%y"), y=0, yend=2.5), size = .72, linetype = "dashed", color="#404040") + geom_text(data = freq_artikel_illness_date, y = 2.8, x = as.Date("16/03/2020", "%d/%m/%y"), label = "Erster Lockdown", size=3.5, color="#404040") + geom_text(data = freq_artikel_illness_date, y = 2.8, x = as.Date("22/06/2020", "%d/%m/%y"), label = "Aufhebung der \n meisten Massnahmen", size=3.5, color="#404040") + geom_text(data = freq_artikel_illness_date, y = 2.8, x = as.Date("19/10/2020", "%d/%m/%y"), label = "Stärkere Verschärfung \n der Massnahmen", size=3.5, color="#404040") + geom_text(data = freq_artikel_illness_date, y = 4.15, x = as.Date("29/03/2020", "%d/%m/%y"), label = "29/03/2020", size=3.2, color="#404040") + geom_text(data = freq_artikel_illness_date, y = 3.85, x = as.Date("15/11/2020", "%d/%m/%y"), label = "15/11/2020", size=3.2, color="#404040") + geom_text(data = freq_artikel_illness_date, y = 3.92, x = as.Date("27/12/2020", "%d/%m/%y"), label = "27/12/2020", size=3.2, color="#404040")
#Plot: Anzahl Erwähnungen psychischer Krankheiten in Artikeln, die psychische Krankheiten erwähnen, über die Zeit
plot_freq_artikel_datum2 <- ggplot(data = freq_artikel_illness_date, aes(x=Datum, y=freq_per_doc)) +
geom_point(size=1.1, alpha=0.5, color="#3B528B") +
geom_smooth(color="#3B528B") +
scale_x_date(date_labels="%b/%Y", date_breaks ="1 month") + theme_ipsum() + labs(y="", x="", title="Erwähnungen psychischer Krankheiten in Artikeln, die psychische Krankheiten erwähnen", subtitle="Trendlinie: Durchschnittliche Anzahl Erwähnungen pro Artikel über die Zeit", caption="Daten: Digital Democracy Lab. Grafik: Gina Messerli") + ylim(0,13) + theme(
axis.text.y = element_text(size=rel(1.1)),
axis.text.x = element_text(size=rel(0.95), angle = 45, hjust = 1), plot.title = element_text(size=rel(1.05)), legend.title = element_text(face="bold"), plot.caption = element_text(size=rel(.7), face="italic", hjust = 0)) + geom_segment(data = freq_artikel_illness_date, aes(x = as.Date("16/03/2020", "%d/%m/%y"), xend = as.Date("16/03/2020", "%d/%m/%y"), y=0, yend=5.5), size = .72, linetype = "dashed", color="#404040") + geom_segment(data = freq_artikel_illness_date,aes(x = as.Date("22/06/2020", "%d/%m/%y"), xend = as.Date("22/06/2020", "%d/%m/%y"), y=0, yend=5.5), size = .72, linetype = "dashed", color="#404040") + geom_segment(data = freq_artikel_illness_date, aes(x = as.Date("19/10/2020", "%d/%m/%y"), xend = as.Date("19/10/2020", "%d/%m/%y"), y=0, yend=5.5), size = .72, linetype = "dashed", color="#404040") + geom_text(data = freq_artikel_illness_date, y = 6.3, x = as.Date("16/03/2020", "%d/%m/%y"), label = "Erster Lockdown", size=3.5, color="#404040") + geom_text(data = freq_artikel_illness_date, y = 6.3, x = as.Date("22/06/2020", "%d/%m/%y"), label = "Aufhebung der \n meisten Massnahmen", size=3.5, color="#404040") + geom_text(data = freq_artikel_illness_date, y = 6.3, x = as.Date("19/10/2020", "%d/%m/%y"), label = "Stärkere Verschärfung \n der Massnahmen", size=3.2, color="#404040") + geom_text(data = freq_artikel_illness_date, y = 8.1, x = as.Date("11/03/2020", "%d/%m/%y"), label = "11/03/2020", size=3.2, color="#404040") + geom_text(data = freq_artikel_illness_date, y = 9.26, x = as.Date("03/08/2020", "%d/%m/%y"), label = "03/08/2020", size=3.2, color="#404040")#Analyse II/ Plot III: Worüber wird in den jeweiligen Perioden charakteristischerweise gesprochen?
#Wortfenster rund um psychische Erkrankungen rausschneiden
token_psych_window <- tokens_keep(token_all2,
pattern = c("angststörung*", "angstgestört*", "schziophren*", "schizoid*", "psychisch krank*", "psychische krankheit*", "panikstörung*", "angsterkrank*", "sozialphob*", "posttrauma*", "panikattacke*","belastungsstörung*", "zwangsstörung*", "anorexi*", "bulimi*", "borderline*", "persönlichkeitsstörung*","adhs*", "autis*", "aufmerksamkeitsdefizit*", "psychische erkrankung*", "bipolar*", "manisch*", "burnout*", "burn-out*", "erschöpfungsdepression*", "dissoziale*", "dissoziativ*", "multiple persönlichkeits*", "psychotisch*", "psychose", "essstörung*", "essgestört*", "binge eating*", "multiple persönlichkeit*", "ptsb*", "dysthymi*", "zyklothym*", "cyclothym*", "cptsb*", "klaustrophob*", "psychische störung*"),
window = 10, valuetype="glob")
#Psychische Krankheiten herausschneiden, um diese nicht in Keyness Statistik zu haben
token_psych_window <- tokens_select(token_psych_window, pattern = c("bipolar", "störung", "persönlichkeitsstörung", "manisch", "manische", "manischen", "zwangsstörung", "adhs", "psychische", "angststörung", "angststörungen", "angstgestört", "schizophren", "schizoid", "psychisch krank", "psychische krankheit", "panikstörung", "angsterkrankt", "sozialphobie", "posttrauma", "panikattacke", "belastungsstörung", "anorexie", "bulimie", "borderline", "autismus", "aufmerksamkeitsdefizit", "psychische erkrankung", "burnout", "burn-out", "erschöpfungsdepression", "dissoziale", "dissoziativ", "multiple persönlichkeitsstörung", "psychotisch", "esstörung", "essgestörung", "binge eating", "ptbs", "dysthymie", "zyklothymie", "cyclothymia", "ctsb", "klaustrophob", "psychische störung", "borderline-störung", "borderline-persönlichkeit"), selection="remove")
#DFM machen
dfm_psych_window <- token_psych_window %>% dfm()
#Keyness ausrechnen für alle Zeitperioden. Dann für alle Berechnungen einen Plot machen
#Prä-Lockdown
keyness_pre <- dfm_group(dfm_psych_window,"cutoff") %>%
textstat_keyness("prä-Lockdown I") %>% top_n(20, chi2)
keyness_pre_plot <- keyness_pre %>% mutate(feature = fct_reorder(feature, chi2)) %>% ggplot() + geom_bar(mapping=aes(x = feature, y = chi2), fill="#450D54", stat = "identity") + theme_ipsum() + labs(x="", y="", title="Prä-Lockdown") + coord_flip() + theme(plot.title = element_text(size=rel(1.05)), panel.border = element_blank(),
panel.grid.major.x = element_blank(), plot.caption = element_text(size=rel(.7), face="italic", hjust = 0), legend.position = "none")
#Während Lockdown
keyness_lockdownI <- dfm_group(dfm_psych_window,"cutoff") %>%
textstat_keyness("Lockdown I") %>% top_n(20, chi2)
keyness_lockdownI_plot <- keyness_lockdownI %>% mutate(feature = fct_reorder(feature, chi2)) %>% ggplot() + geom_bar(mapping=aes(x = feature, y = chi2), fill="#472D7B", stat = "identity") + theme_ipsum() + labs( x="", y="", title="Lockdown I") + coord_flip() + theme(plot.title = element_text(size=rel(1.05)), panel.border = element_blank(),
panel.grid.major.x = element_blank(), plot.caption = element_text(size=rel(.7), face="italic", hjust = 0), legend.position = "none")
#Nach Aufhebung der Massnahmen und vor erneuter starker Verschärfung der Massnahmen
keyness_during <- dfm_group(dfm_psych_window,"cutoff") %>%
textstat_keyness("Massnahmen aufgehoben") %>% top_n(20, chi2)
keyness_during_plot <- keyness_during %>% mutate(feature = fct_reorder(feature, chi2)) %>% ggplot() + geom_bar(mapping=aes(x = feature, y = chi2), fill="#3B528B", stat = "identity") + theme_ipsum() + labs( x="", y="", title="Massnahmen aufgehoben") + coord_flip() + theme(plot.title = element_text(size=rel(1.05)), panel.border = element_blank(),
panel.grid.major.x = element_blank(), plot.caption = element_text(size=rel(.7), face="italic", hjust = 0), legend.position = "none")
#Nach erneuter starker Verschärfung der Massnahmen
keyness_lockdownII <- dfm_group(dfm_psych_window,"cutoff") %>%
textstat_keyness("Verschärfung/Lockdown II") %>% top_n(20, chi2)
keyness_lockdownII_plot <- keyness_lockdownII %>% mutate(feature = fct_reorder(feature, chi2)) %>% ggplot() + geom_bar(mapping=aes(x = feature, y = chi2), fill="#2B728E", stat = "identity") + theme_ipsum() + labs( x="", title="Verschärfung/ Lockdown II") + coord_flip() + theme(plot.title = element_text(size=rel(1.05)), panel.border = element_blank(),
panel.grid.major.x = element_blank(), plot.caption = element_text(size=rel(.7), face="italic", hjust = 0), legend.position = "none")
#Kombinieren der vier Plots auf einem Grid
plots_keyness_combined <- ggarrange(keyness_pre_plot, keyness_lockdownI_plot, keyness_during_plot, keyness_lockdownII_plot,
ncol = 2, nrow = 2, align = "v")## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)):
## Zeichensatzfamilie 'Arial Narrow' in der PostScript-Zeichensatzdatenbank nicht
## gefunden#Annotieren der kombinierten Plots
plots_keyness_combined <- annotate_figure(plots_keyness_combined,
top = text_grob("Charakteristische Worte in 10-Wort-Kontexten um Erwähnungen psychischer Krankheiten", color = "black", face = "bold", size = 12, hjust=0.38), bottom = text_grob("Daten: Digital Democracy Lab. Grafik: Gina Messerli", color = "black", face = "italic", size = 10, hjust=0.85))#Analyse III/ Plots IV & V: Wie stigmatisierend wird in den jeweiligen Perioden im Zusammenhang mit psychischen Krankheiten gesprochen?
#Artikel, die psychische Krankheiten erwähnen
artikel_illness_stereotyp <- dfm_lookup(dfm_psych_window, stigma, nomatch = "_UNMATCHED")
#Artikel-Anzahl über Cutoff & Medienblatt
textstat_illness_stereotyp_cutoff <- textstat_frequency(artikel_illness_stereotyp, group = "cutoff")
#Prep für Visualisierung
freq_illness_stereotyp_cutoff <- textstat_illness_stereotyp_cutoff %>% group_by(group) %>% #group=cutoff
mutate(sum_frequency=sum(frequency)) %>% #sum_frequency: Summer aller Worte in den 10-Wort windows
mutate(sum_docfreq_all=sum(docfreq)) %>%
filter(feature!="_UNMATCHED") %>% #Ungematche rausfiltern, brauchen wir nicht mehr
mutate(sum_frequency_stereo=sum(frequency)) %>% #sum_frequency_stereo: Summe aller stereotyptischen Worte in dem 10-Wort windows
mutate(sum_docfreq_stereo=sum(docfreq)) %>%
mutate(pct_stereotyp_worte_all= 100*(sum_frequency_stereo/sum_frequency)) %>% #pct_steretyp_worte: Wieviele % der Worte in den 10-Wort-Fenstern enthalten überhaupt einen Stereotypen?
mutate(pct_stereotyp_worte = 100*(frequency/sum_frequency)) %>%#pct_stereotyp_worte: wieviele % der Worte in den 10-Wort-Fenstern enthalten die jeweils spezifischen Stereotypen?
mutate(pct_stereotyp_article_all=100*(sum_docfreq_stereo/sum_docfreq_all)) %>%
mutate(pct_stereotyp_article=100*(docfreq/sum_docfreq_all)) %>%
ungroup()
#Cutoff-Variable zu Faktor machen
freq_illness_stereotyp_cutoff$group <- as.factor(freq_illness_stereotyp_cutoff$group)
#Faktorlevels umordnen
freq_illness_stereotyp_cutoff$group <- factor(freq_illness_stereotyp_cutoff$group, levels = c("prä-Lockdown I", "Lockdown I", "Massnahmen aufgehoben", "Verschärfung/Lockdown II"))
#Slope-Plot: %-Anteil von stereotypen Worten an allen Worten in 10-Wort-Fenster um psychische Krankheiten
slopeplot_stereotypes <- ggplot(data = freq_illness_stereotyp_cutoff, aes(x=group, y=pct_stereotyp_article, group=feature)) +
geom_line(aes(color=feature), size=1.7, alpha=1) +
geom_point(aes(color=feature), size=2, alpha=1) + labs(y="", x="", title="%-Anteil an 10-Wort-Kontexten um psychische Erkrankungen, die auch Stigmata enthalten", subtitle="Entwicklung über vier Perioden: Unterschiedliche Stereotypen") + theme_ipsum() + ylim(0,15) + theme(plot.title = element_text(size=rel(1)), plot.subtitle = element_text(size=rel(1)), panel.border = element_blank(),
panel.grid.major.x = element_blank(),
axis.text.x = element_text(size=rel(0.9), angle = 45, hjust = 1), legend.title = element_text(face="bold")) + scale_color_brewer(name="Stereotype Eigenschaft", palette="Paired", labels=c("Asozial", "Faul", "Gefährlich", "Merkwürdig", "Überempfindlich", "Unintelligent", "Unzuverlässig", "Verrückt"))
#Datensatz filtern, sodass nur die Variablen pct_stereotyp_artikel_all und pct_stereotyp_worte_all drinbleiben, um Berechnungsfehler im Plot zu vermeiden (Stereotypen insgesamt)
freq_illness_stereotyp_cutoff_barchart <- freq_illness_stereotyp_cutoff %>% select(group, pct_stereotyp_worte_all, pct_stereotyp_article_all) %>% group_by(group) %>% slice(1, 7, 14, 21) %>% slice(1, 3, 4, 5)
#Bar-Plot: %-Anteil von stereotypen Worten an allen Worten in 10-Wort-Fenster um psychische Krankheiten
barchart_stereotypes <- ggplot(data=freq_illness_stereotyp_cutoff_barchart) + geom_bar(mapping=aes(x = group, y = pct_stereotyp_article_all), fill = "#990000", stat = "identity") + labs(y="", x="", title="%-Anteil an 10-Wort-Kontexten um psychische Erkrankungen, die auch Stigmata enthalten", subtitle="Entwicklung über vier Perioden: Stereotypen insgesamt") + theme_ipsum() + ylim(0,23) + theme(plot.title = element_text(size=rel(1)), panel.border = element_blank(),
panel.grid.major.x = element_blank(), plot.caption = element_text(size=rel(.7), face="italic", hjust = 0),
axis.text.x = element_text(size=rel(0.9), angle = 45, hjust = 1))