#Benötigte libraries aktivieren
library(dplyr)
library(data.table)
library(tidyr)
library(car)
library(ggplot2)
library(tidyverse)
library(gridExtra)
library(ggalt)
library(ggthemes)
library(ggridges)
library(hrbrthemes)
library(gcookbook)
library(ggpubr)
library(plotly)
library(gganimate)
library(gifski)
#Daten einlesen
setwd("~/Master UZH/Polito/Vorlesungen/HS20_Datenjournalismus/Daten_DDJ_HS20_Olat/Corona-Monitor/2-Daten")
file <- "CoronaMonitorAll.csv"
corona <-read.csv(file,
sep=",",
encoding = "UTF-8",
stringsAsFactors = TRUE)
#Werte für Variable massnBewegung (Meinung zu Einschränkungen der persönlichen Bewegungsfreiheit) anschauen
levels(corona$massnBewegung)
#Werte für Variablen party (Parteiaffinität für Welle 1-4), partyNahe (Parteiaffinität für Welle 5), sex (Geschlecht), edu(Bildungsgrad), zurechtkomm (Zurechtkommen mit der Krise), alltagHeraus (Gefühl der Eingeschränktheit durch die Massnahmen) anschauen
levels(corona$sex)
levels(corona$party)
levels(corona$edu)
levels(corona$alltagHeraus)
levels(corona$zurechtkomm)
#Missings für Variablen recodieren
corona$massnBewegung <- as.character(corona$massnBewegung)
corona$massnBewegung[corona$massnBewegung ==""] <- NA
corona$massnBewegung <- as.factor(corona$massnBewegung)
corona$party <- as.character(corona$party)
corona$party[corona$party==""] <- NA
corona$party[corona$party=="Weiss nicht"] <- NA
corona$party[corona$party=="Weiss nicht / Keine"] <- NA
corona$party[corona$party=="-oth-"] <- NA
corona$party <- as.factor(corona$party)
corona$partyNahe <- as.character(corona$partyNahe)
corona$partyNahe[corona$partyNahe=="-oth-"] <- NA
corona$partyNahe <- as.factor(corona$partyNahe)
corona$alltagHeraus <- as.character(corona$alltagHeraus)
corona$alltagHeraus[corona$alltagHeraus ==""] <- NA
corona$alltagHeraus <- as.factor(corona$alltagHeraus)
corona$zurechtkomm <- as.character(corona$zurechtkomm)
corona$zurechtkomm[corona$zurechtkomm ==""] <- NA
corona$zurechtkomm <- as.factor(corona$zurechtkomm)
corona$sex <- as.character(corona$sex)
corona$sex[corona$sex =="Andere / Keine Angabe"] <- NA
corona$sex <- as.factor(corona$sex)
#recodierte Variablen anschauen
levels(corona$party)
levels(corona$massnBewegung)
levels(corona$sex)
levels(corona$partyNahe)
levels(corona$zurechtkomm)
levels(corona$alltagHeraus)Ich schliesse hier AuslandschweizerInnen sowie Personen, die unter 18 Jahre alt sind, vom Gesamtdatensatz aus, da Personen unter 18 noch gar nicht wählen können (siehe nachfolgende Berechnungen) und Auslandschweizer*innen nicht von den Massnahmen, die die Schweiz getroffen hat, betroffen sind.
#AuslandschweizerInnen und Menschen unter 18 Jahren ausschliessen; dann party, partyNahe, education, massnBewegung, zurechtkomm, alltagHeraus recodieren; Erhebungswellen als Datum recodieren
corona <- dplyr:: filter(corona, age >=18 & !kanton=="Auslandschweizer/in") %>% dplyr::mutate(
party_fac=case_when(
party %in% c("EDU", "SVP", "FDP") | partyNahe %in% c("EDU", "SVP", "FDP") ~ "rechts",
party %in% c("Linke", "SP", "Grüne") | partyNahe %in% c("Linke", "SP", "Grüne") ~ "rot/grün",
party %in% c("BDP", "CVP", "GLP") | partyNahe %in% c("BDP", "CVP", "GLP") ~ "mitte",
party %in% "NA" | partyNahe %in% "NA" ~ "NA"
),
edu_fact=
case_when(
edu %in% c("Fachhochschule, PH", "Universität, ETH", "Höhere Fach- und Berufsausbildung") ~ "Hohes Bildungsniveau",
edu %in% c("Berufslehre", "Gymnasium, Berufsmatura, FMS, DMS") ~ "Mittleres Bildungsniveau",
edu %in% "Kein Bildungsabschluss, obligatorische Schule" ~ "Tiefes Bildungsniveau",
edu %in% "NA" ~ "NA"
),
massnBewegung_dich=
case_when(
massnBewegung %in% c("Sind angemessen", "Gehen viel zu wenig weit", "Gehen eher zu wenig weit") ~ "0",
massnBewegung %in% c("Gehen eher zu weit", "Gehen viel zu weit") ~ "1",
massnBewegung %in% "NA" ~ "NA"
),
date=
case_when(
Welle %in% 1 ~ "22/03/2020",
Welle %in% 2 ~ "06/04/2020",
Welle %in% 3 ~ "05/05/2020",
Welle %in% 4 ~ "08/06/2020",
Welle %in% 5 ~ "02/11/2020",
),
zurechtkomm_dich=
case_when(
zurechtkomm %in% c("1: Sehr schlecht", "2") ~ "nein",
zurechtkomm %in% c("3", "4", "5: Sehr gut") ~ "ja",
zurechtkomm %in% "NA" ~ "NA"),
alltag_dich=
case_when(
alltagHeraus %in% c("1 - sehr stark eingeschränkt", "2") ~ "eingeschränkt",
alltagHeraus %in% c("3", "4", "5 - gar nicht eingeschränkt") ~ "nicht eingeschränkt",
alltagHeraus %in% "NA" ~ "NA"),
vertrauen_dich=
case_when(vertrauen %in% c("1: Sehr klein", "2") ~ "1",
vertrauen %in% c("3", "4", "5") ~ "0",
vertrauen %in% "NA" ~ "NA"))
#age-Variable recodieren
corona$age_new <- cut(corona$age, breaks=c(-Inf, 30, 64, Inf), right=TRUE, labels=c("18-30", "31-64", ">65"))
#Recodierte Variablen ausser Alter und Datum wieder zu Faktoren umwandeln; Datum von R als Datum erkennbar machen
corona$party_fac <- as.factor(corona$party_fac)
corona$edu_fact <- as.factor(corona$edu_fact)
corona$massnBewegung_dich <- as.factor(corona$massnBewegung_dich)
corona$date <- as.Date(corona$date, "%d/%m/%y")
corona$zurechtkomm_dich <- as.factor(corona$zurechtkomm_dich)
corona$alltag_dich <- as.factor(corona$alltag_dich)
corona$vertrauen_dich <- as.factor(corona$vertrauen_dich)
#FurchtPersMax_SQ00-Variable recodieren, sodass diese ins Wide-Format passt; hierzu zunächst ein neues Datenset erstellen
dat1 <- corona %>%
select(id, Welle, paste0("furchtPersMax_SQ00", 1:7)) %>%
pivot_longer(!id & !Welle, names_to = "furchtPersMax", values_to = "question") %>%
separate(question, c("question","var.label"), ":") %>%
mutate(var.code = case_when(var.label == " Selected" ~ 1,
var.label == " Not selected" ~ 0,
TRUE ~ NA_real_)) %>%
group_by(id, Welle) %>%
mutate(sum = sum(var.code, na.rm=T)) %>%
filter(sum != 0)
dat1$furchtfinanz <- ifelse(dat1$question=="Finanzielle Einbussen" & dat1$var.code==1, 1, 0)
dat1$furchtarbeitsplatz <- ifelse(dat1$question=="Arbeitsplatzverlust" & dat1$var.code==1, 1, 0)
dat1$furchtfreiheit <- ifelse(dat1$question=="Eingeschränkte Freiheiten" & dat1$var.code==1, 1, 0)
dat1$furchtkonflikt <- ifelse(dat1$question=="Konflikte im privaten Umfeld" & dat1$var.code==1, 1, 0)
dat1$furchtisolation <- ifelse(dat1$question=="Soziale Isolation / Einsamkeit" & dat1$var.code==1, 1, 0)
dat1$furchtnichts <- ifelse(dat1$question=="Nichts" & dat1$var.code==1, 1, 0)
dat1$furchtcovid <- ifelse(dat1$question=="COVID-19-Erkrankung (Coronavirus)" & dat1$var.code==1, 1, 0)
dat1 <- dat1 %>% select(id, Welle, furchtfinanz, furchtarbeitsplatz, furchtfreiheit, furchtkonflikt, furchtisolation, furchtnichts, furchtcovid) %>% group_by(id, Welle) %>% summarise(furchtfinanz1=sum(furchtfinanz, na.rm = T), furchtarbeitsplatz1=sum(furchtarbeitsplatz, na.rm = T), furchtfreiheit1=sum(furchtfreiheit, na.rm = T), furchtkonflikt1=sum(furchtkonflikt, na.rm = T), furchtisolation1=sum(furchtisolation, na.rm = T), furchtcovid1=sum(furchtcovid, na.rm=T))
#Neu erstelltes Datenset mit Masterdatenset mergen
corona <- merge(corona, dat1, by=c("id", "Welle"))
#Gemergte Variablen zu Faktoren umwandeln
corona$furchtfinanz1 <- as.factor(corona$furchtfinanz1)
corona$furchtarbeitsplatz1 <- as.factor(corona$furchtarbeitsplatz1)
corona$furchtisolation1 <- as.factor(corona$furchtisolation1)
corona$furchtfreiheit1 <- as.factor(corona$furchtfreiheit1)
corona$furchtkonflikt1 <- as.factor(corona$furchtkonflikt1)
#Einzelne Datensätze für die drei zu untersuchenden Erhebungswellen erstellen
Welle3_massBe <- dplyr::filter(corona, Welle==3) %>% dplyr::select(massnBewegung_dich, sex, edu_fact, party_fac, age_new, weight, furchtfreiheit1, furchtisolation1, alltag_dich, zurechtkomm_dich, vertrauen_dich)
Welle4_massBe <- dplyr::filter(corona, Welle==4) %>% dplyr::select(massnBewegung_dich, sex, edu_fact, party_fac, age_new, weight, furchtfreiheit1, furchtisolation1, alltag_dich, zurechtkomm_dich, vertrauen_dich)
Welle5_massBe <- dplyr::filter(corona, Welle==5) %>% dplyr::select(massnBewegung_dich, sex,edu_fact, party_fac, age_new, weight, furchtfreiheit1, furchtisolation1, alltag_dich, zurechtkomm_dich, vertrauen_dich)
#Separate Datensets ohne NAs erstellen, um zu sehen, wie viele Observationen effektiv in die Regressionen einfliessen (siehe weiter unten)
na.Welle3 <- na.omit(Welle3_massBe)
summary(na.Welle3)
na.Welle4 <- na.omit(Welle4_massBe)
summary(na.Welle4)
na.Welle5 <- na.omit(Welle5_massBe)
summary(na.Welle4)#Dichotomisierte Variable massnBewegung zu numerisch umcodieren, um Ausrechnen von Prozentsätzen zu ermöglichen
corona$massnBewegung_dich_num <- as.numeric(as.character(corona$massnBewegung_dich))
#Datenset mit nur den für den Lineplot benötigten Variablen erstellen; anschliessend Gruppierung nach Datum und Ausrechnen der Prozentsätze an Personen, denen die Bewegungsmassnahmen teilweise oder viel zu weit gehen erstellen
means_Ablehnung_Bewegung <- corona %>% dplyr::select(date, weight, massnBewegung_dich_num) %>% na.omit()
means_Ablehnung_Bewegung <- means_Ablehnung_Bewegung %>% group_by(date) %>% summarize(prozent_against_Bewegung=100*weighted.mean(massnBewegung_dich_num, weight), n=n())
#Einfachen Plot mit der Entwicklung der Abelehungsrate über die Zeit erstellen
lines_massn2 <- ggplot(data=means_Ablehnung_Bewegung, aes(x=date, y=prozent_against_Bewegung)) + geom_line(size=1.2, color="#66C2A5") + labs(y="Prozent", x="") + theme_ipsum_rc()
#Hinzufügen von graphischen Elementen wie beispielsweise Linien für die Datenpunkte, Anpassen der Skala und des Farbschemas
lines_massn2 <- lines_massn2 + theme(plot.caption = element_text(hjust = 0)) + theme(legend.position = "none") + theme(plot.subtitle=element_text(size=15, vjust = 1)) + theme(plot.title=element_text(size=18)) +
geom_point(aes(x=date,y=prozent_against_Bewegung),size=3, color="#FC8D62") + ylim(0,100) + geom_point(aes(x=date,y=prozent_against_Bewegung),size=3, color="#FC8D62") + ylim(-7,100) + geom_text(y = 29.78, x = as.Date("07/05/2020", "%d/%m/%y", angle=45), label = "23%", size=4, angle=45) + geom_text(y = 31.87, x = as.Date("10/06/2020", "%d/%m/%y"), label = "25%", size=4, angle=45) + geom_text(y = 33.71, x = as.Date("04/11/2020", "%d/%m/%y"), label = "27%", size=4, angle=45) + geom_text(y = 10.83, x = as.Date("25/03/2020", "%d/%m/%y"), label = "4%", size=4, angle=45) + geom_text(y = 15.82, x = as.Date("08/04/2020", "%d/%m/%y"), label = "10%", size=4, angle=45)+
geom_segment(aes(x = as.Date("28/10/2020", "%d/%m/%y"), xend = as.Date("28/10/2020", "%d/%m/%y"), y=0, yend=50), size = .25, linetype = "dashed") + geom_segment(aes(x = as.Date("22/06/2020", "%d/%m/%y"), xend = as.Date("22/06/2020", "%d/%m/%y"), y=0, yend=50), size = .25, linetype = "dashed") +
geom_segment(aes(x = as.Date("30/05/2020", "%d/%m/%y"), xend = as.Date("30/05/2020", "%d/%m/%y"), y=0, yend=50), size = .25, linetype = "dashed") + geom_text(y = 57, x = as.Date("31/05/2020", "%d/%m/%y"), label = "max. 30 Pers.", size=4, angle=45, color="forestgreen") + geom_text(y = 57, x = as.Date("23/06/2020", "%d/%m/%y"), label = "Aufhebung\nBeschränkungen", size=4, angle=45, color="forestgreen") + geom_text(y = 57, x = as.Date("30/10/2020", "%d/%m/%y"), label = "max. 10/15 Pers.", size=4, angle=45, color="red") +
geom_segment(aes(x = as.Date("05/05/2020", "%d/%m/%y"), xend = as.Date("05/05/2020", "%d/%m/%y"), y=0, yend=22.77), size = .25, linetype = "dashed") +
geom_segment(aes(x = as.Date("08/06/2020", "%d/%m/%y"), xend = as.Date("08/06/2020", "%d/%m/%y"), y=0, yend=24.87), size = .25, linetype = "dashed") +
geom_segment(aes(x = as.Date("02/11/2020", "%d/%m/%y"), xend = as.Date("02/11/2020", "%d/%m/%y"), y=0, yend=26.71), size = .25, linetype = "dashed") +
geom_segment(aes(x = as.Date("20/03/2020", "%d/%m/%y"), xend = as.Date("20/03/2020", "%d/%m/%y"), y=0, yend=50), size = .25, linetype = "dashed") + geom_text(y = 57, x = as.Date("21/03/2020", "%d/%m/%y"), label = "max. 5 Pers.", size=4, angle=45, color="red") + geom_segment(aes(x = as.Date("06/04/2020", "%d/%m/%y"), xend = as.Date("06/04/2020", "%d/%m/%y"), y=0, yend=9.82), size = .25, linetype = "dashed") + geom_segment(aes(x = as.Date("23/03/2020", "%d/%m/%y"), xend = as.Date("23/03/2020", "%d/%m/%y"), y=0, yend=3.83), size = .25, linetype = "dashed")
#Hinzufügen der Labels und Punkte für die Erhebungsdaten und Daten der Massnahmenerlasse
lines_massn2 <- lines_massn2 +
annotate("point", x = as.Date("05/05/2020", "%d/%m/%y"), y = 0, colour = "black") +
annotate("point", x = as.Date("08/06/2020", "%d/%m/%y"), y = 0, colour = "black") +
annotate("point", x = as.Date("02/11/2020", "%d/%m/%y"), y = 0, colour = "black") +
annotate("point", x = as.Date("30/05/2020", "%d/%m/%y"), y = 0, colour = "black") +
annotate("point", x = as.Date("22/06/2020", "%d/%m/%y"), y = 0, colour = "black") +
annotate("point", x = as.Date("28/10/2020", "%d/%m/%y"), y = 0, colour = "black") +
annotate("point", x = as.Date("20/03/2020", "%d/%m/%y"), y = 0, colour = "black") +
annotate("point", x = as.Date("06/04/2020", "%d/%m/%y"), y = 0, colour = "black") +
annotate("point", x = as.Date("23/03/2020", "%d/%m/%y"), y = 0, colour = "black") + geom_text(y = -6.8, x = as.Date("20/03/2020", "%d/%m/%y"), label = "20. Mär", size=3.5, angle=90) + geom_text(y = -6, x = as.Date("05/05/2020", "%d/%m/%y"), label = "5. Mai", size=3.5, angle=90) + geom_text(y = -6, x = as.Date("02/11/2020", "%d/%m/%y"), label = "2. Nov", size=3.5, angle=90) + geom_text(y = -6.8, x = as.Date("30/05/2020", "%d/%m/%y"), label = "30. Mai", size=3.5, angle=90) + geom_text(y = -6.8, x = as.Date("22/06/2020", "%d/%m/%y"), label = "22. Jun", size=3.5, angle=90) + geom_text(y = -6, x = as.Date("08/06/2020", "%d/%m/%y"), label = "8. Jun", size=3.5, angle=90) + geom_text(y = -6.8, x = as.Date("28/10/2020", "%d/%m/%y"), label = "28. Okt", size=3.5, angle=90) + geom_text(y = -6.58, x = as.Date("23/03/2020", "%d/%m/%y"), label = "23. Mär", size=3.5, angle=90) + geom_text(y = -6, x = as.Date("06/04/2020", "%d/%m/%y"), label = "6. Apr", size=3.5, angle=90)####WELLE 3########
#Gewichtete, quasi-binomiale Regression laufen lassen
massBe_glm3 <- glm(massnBewegung_dich ~ relevel(party_fac, ref="rot/grün") + sex + relevel(edu_fact, ref="Tiefes Bildungsniveau") + relevel(age_new, ref="31-64"), data=Welle3_massBe, weights = weight, family="quasibinomial"(link="logit"))
#Ergebnisse summarisen lassen
summary(massBe_glm3)
#Odds Ratios berechnen
q3 <- as.data.frame(exp(cbind("Odds Ratio" = coef(massBe_glm3), confint.default(massBe_glm3, level = 0.95))))
#Berechnete Odds Ratios zu neuem Datensatz zusammenfassen
data_q3 <- data.frame(
predictor = c("mitte", "rechts", "männlich", "Mittleres\nBildungsniveau", "Hohes\nBildungsniveau", "18-30", ">65"),
boxOdds = c(1.45, 2.48, 1.39, 1.64, 1.45, 1.16, 0.60),
boxCILow = c(1.18, 2.12, 1.21, 1.11, 0.99, 0.97, 0.50),
boxCIHigh = c(1.79, 2.90, 1.59, 2.43, 2.14, 1.39, 0.71)
)
#Dem Datensatz das Erhebungsdatum als Variable hinzufügen
data_q3$date <- as.factor("5. Mai")
#Hieraus zwei neue Datensätze erstellen, sodass der erste nur die Ratios für die Faktoren Geschlecht und politische Affinität enthält und der zweite nur die Ratios für die Faktoren Bildung und Alter.
data_mannpolito_q3 <- data_q3 %>% filter(predictor=="männlich" | predictor=="rechts" | predictor=="mitte")
data_bildung_alter_q3 <- data_q3 %>% filter(predictor!="männlich" & predictor!="rechts" & predictor!="mitte")
####WELLE 4########
#Gewichtete, quasi-binomiale Regression laufen lassen
massBe_glm4 <- glm(massnBewegung_dich ~ relevel(party_fac, ref="rot/grün") + sex + relevel(edu_fact, ref="Tiefes Bildungsniveau") + relevel(age_new, ref="31-64"), data=Welle4_massBe, weights = weight, family="quasibinomial"(link="logit"))
#Ergebnisse summarisen lassen
summary(massBe_glm4)
#Odds Ratios berechnen
q4 <- as.data.frame(exp(cbind("Odds Ratio" = coef(massBe_glm4), confint.default(massBe_glm4, level = 0.95))))
#Berechnete Odds Ratios zu neuem Datensatz zusammenfassen
data_q4 <- data.frame(
predictor = c("mitte", "rechts", "männlich", "Mittleres\nBildungsniveau", "Hohes\nBildungsniveau", "18-30", ">65"),
boxOdds = c(0.85, 2.35, 1.25, 1.42, 1.13, 0.86, 0.52),
boxCILow = c(0.66, 2.00, 1.08, 0.88, 0.71, 0.71, 0.43),
boxCIHigh = c(1.08, 2.76, 1.44, 2.27, 1.8, 1.05, 0.63)
)
#Dem Datensatz das Erhebungsdatum als Variable hinzufügen
data_q4$date <- as.factor("8. Juni")
#Hieraus zwei neue Datensätze erstellen, sodass der erste nur die Ratios für die Faktoren Geschlecht und politische Affinität enthält und der zweite nur die Ratios für die Faktoren Bildung und Alter.
data_mannpolito_q4 <- data_q4 %>% filter(predictor=="männlich" | predictor=="rechts" | predictor=="mitte")
data_bildung_alter_q4 <- data_q4 %>% filter(predictor!="männlich" & predictor!="rechts" & predictor!="mitte")
####WELLE 5########
#Gewichtete, quasi-binomiale Regression laufen lassen
massBe_glm5 <- glm(massnBewegung_dich ~ relevel(party_fac, ref="rot/grün") + sex + relevel(edu_fact, ref="Tiefes Bildungsniveau") + relevel(age_new, ref="31-64"), data=Welle5_massBe, weights = weight, family="quasibinomial"(link="logit"))
#Ergebnisse summarisen lassen
summary(massBe_glm5)
#Odds Ratios berechnen
q5 <- as.data.frame(exp(cbind("Odds Ratio" = coef(massBe_glm5), confint.default(massBe_glm5, level = 0.95))))
#Berechnete Odds Ratios zu neuem Datensatz zusammenfassen
data_q5 <- data.frame(
predictor = c("mitte", "rechts", "männlich", "Mittleres\nBildungsniveau", "Hohes\nBildungsniveau", "18-30", ">65"),
boxOdds = c(0.47, 1.43, 1.30, 2.73,1.57, 0.97, 0.04),
boxCILow = c(0.16, 0.58, 0.59, 0.66, 0.40, 0.38, 0.003),
boxCIHigh = c(1.38, 3.56, 2.87, 11.2, 6.12, 2.47, 0.48)
)
#Dem Datensatz das Erhebungsdatum als Variable hinzufügen
data_q5$date <- as.factor("2. November")
#Hieraus zwei neue Datensätze erstellen, sodass der erste nur die Ratios für die Faktoren Geschlecht und politische Affinität enthält und der zweite nur die Ratios für die Faktoren Bildung und Alter.
data_mannpolito_q5 <- data_q5 %>% filter(predictor=="männlich" | predictor=="rechts" | predictor=="mitte")
data_bildung_alter_q5 <- data_q5 %>% filter(predictor!="männlich" & predictor!="rechts" & predictor!="mitte")
#Mergen der Datensätzen mit den Odds Ratios für die einzelnen Erhebungswellen zu je einem Datensatz für die Faktoren politische Affinität und Geschlecht sowie Alter und Bildung
OR_mannpolito_merge <- do.call("rbind", list(data_mannpolito_q3, data_mannpolito_q4, data_mannpolito_q5))
OR_bildung_alter_merge <- do.call("rbind", list(data_bildung_alter_q3, data_bildung_alter_q4, data_bildung_alter_q5))#Plot erstellen, der alle Odds Ratios für alle untersuchten Erhebungszeitpunkte für die Faktoren Geschlecht und politische Affinität enthält
OR_plot_mannpolito <- ggplot(OR_mannpolito_merge, aes(x = boxOdds, y = predictor, color=predictor)) +
geom_errorbarh(aes(xmax = boxCIHigh, xmin = boxCILow), size = .5, height = .1, color = "gray50") + geom_point(size = 4.5) +
scale_x_continuous(breaks = seq(0,9,1) ) +
geom_vline(aes(xintercept = 1), size = .25, linetype = "dashed") +
theme(panel.grid.minor = element_blank()) + theme_ipsum_rc()
#Farbpalette und Achsenbeschriftungen ändern
OR_plot_mannpolito <- OR_plot_mannpolito + labs(y="Demographie", x="Relative Chance")
OR_plot_mannpolito <- OR_plot_mannpolito + theme(legend.position = "none") +
scale_color_brewer(palette = "Set2")
#Plot-Animation vorbereiten
animated_demo_mannpolito <- OR_plot_mannpolito +
labs(subtitle = "{closest_state}") +
theme(
plot.caption = element_text(hjust = 0)
) + theme(plot.subtitle=element_text(size=15, face="bold.italic", vjust = 1)) + theme(plot.title=element_text(size=18)) +
transition_states(as.factor(date), transition_length = 2, state_length = 5,
wrap = FALSE)
#Plot animieren
animate(animated_demo_mannpolito, height = 400, width =500)
#Plot abspeichern
anim_save("demo_mannpolito.gif", animation = last_animation(), path="~/Master UZH/Polito/Vorlesungen/HS20_Datenjournalismus/FINAL/FINAL/")
##Plot erstellen, der alle Odds Ratios für alle Erhebungswellen für die Faktoren Bildung und Alter enthält
OR_plot_bildungalter <- ggplot(OR_bildung_alter_merge, aes(x = boxOdds, y = predictor, color=predictor)) +
geom_errorbarh(aes(xmax = boxCIHigh, xmin = boxCILow), size = .5, height = .1, color = "gray50") + geom_point(size = 4.5) +
scale_x_continuous(breaks = seq(0,9,1) ) +
geom_vline(aes(xintercept = 1), size = .25, linetype = "dashed") +
theme(panel.grid.minor = element_blank()) + theme_ipsum_rc()
#Farbpalette und Achsenbeschriftung ändern
OR_plot_bildungalter <- OR_plot_bildungalter + labs(y="Demographie", x="Relative Chance")
OR_plot_bildungalter <- OR_plot_bildungalter + theme(legend.position = "none") +
scale_color_brewer(palette = "Set2")
#Plot-Animation vorbereiten
animated_demo_bildungalter <- OR_plot_bildungalter +
labs(subtitle = "{closest_state}") +
theme(
plot.caption = element_text(hjust = 0)
) + theme(plot.subtitle=element_text(size=15, face="bold.italic", vjust = 1)) + theme(plot.title=element_text(size=18)) +
transition_states(as.factor(date), transition_length = 2, state_length = 5,
wrap = FALSE)
#Plot animieren
animate(animated_demo_bildungalter, height = 400, width =500)
#Plot speichern
anim_save("demo_bildungalter.gif", animation = last_animation(), path="~/Master UZH/Polito/Vorlesungen/HS20_Datenjournalismus/FINAL/FINAL/")####WELLE 3########
#Gewichtete, quasi-binomiale Regression laufen lassen
massfurcht_glm3 <-glm(massnBewegung_dich ~ furchtfreiheit1 + furchtisolation1 + relevel(alltag_dich, ref="nicht eingeschränkt") + relevel(zurechtkomm_dich, ref="ja") + vertrauen_dich, data=Welle3_massBe, weights = weight, family="quasibinomial"(link="logit"))
#Ergebnisse sumamrisen lassen
summary(massfurcht_glm3)
#Odds Ratios und Konfidenzintervalle berechnen
f3 <- as.data.frame(exp(cbind("Odds Ratio" = coef(massfurcht_glm3), confint.default(massfurcht_glm3, level = 0.95))))
#Berechnete Odds Ratios und Konfidenzintervalle zu neuem Datensatz binden
data_f3 <- data.frame(
predictor = c("Sorge:\nFreiheits-\nverlust", "Sorge:\nSoziale\nIsolation", "Subjektive\nEingeschränktheit", "Schlechtes\nZurechtkommen", "Tiefes\nVertrauen"),
boxOdds = c(3.09, 0.99, 3.00, 0.70, 3.02),
boxCILow = c(2.45, 0.80, 2.45, 0.52, 2.41),
boxCIHigh = c(3.89, 1.22, 3.69, 0.93, 3.79)
)
#Erhebungsdatum als Faktor hinzufügen
data_f3$date <- as.factor("5. Mai")
####WELLE 4########
#Gewichtete, quasi-binomiale Regression laufen lassen
massfurcht_glm4 <-glm(massnBewegung_dich ~ furchtfreiheit1 + furchtisolation1 + relevel(alltag_dich, ref="nicht eingeschränkt") + relevel(zurechtkomm_dich, ref="ja") + vertrauen_dich, data=Welle4_massBe, weights = weight, family="quasibinomial"(link="logit"))
#Ergebnisse summarisen lassen
summary(massfurcht_glm4)
#Odds Ratios und Konfidenzintervalle berechnen
f4 <- as.data.frame(exp(cbind("Odds Ratio" = coef(massfurcht_glm4), confint.default(massfurcht_glm4, level = 0.95))))
#Berechnete Odds Ratios und Konfidenzintervalle in neuem Datensatz speichern
data_f4 <- data.frame(
predictor = c("Sorge:\nFreiheits-\nverlust", "Sorge:\nSoziale\nIsolation", "Subjektive\nEingeschränktheit", "Schlechtes\nZurechtkommen", "Tiefes\nVertrauen"),
boxOdds = c(3.47, 0.97, 3.27, 1.02, 8.22),
boxCILow = c(2.68, 0.76, 2.52, 0.72, 6.29),
boxCIHigh = c(4.50, 1.24, 4.25, 1.44, 10.73)
)
#Erhebungsdatum als Faktor hinzufügen
data_f4$date <- as.factor("8. Juni")
####WELLE 5########
#Gewichtete, quasi-binomiale Regression laufen lassen
massfurcht_glm5 <-glm(massnBewegung_dich ~ furchtfreiheit1 + furchtisolation1+ relevel(alltag_dich, ref="nicht eingeschränkt") + relevel(zurechtkomm_dich, ref="ja") + vertrauen_dich, data=Welle5_massBe, weights = weight, family="quasibinomial"(link="logit"))
#Ergebnisse summarisen
summary(massfurcht_glm5)
#Odds Ratios und Konfidenzintervalle berechnen
f5 <- as.data.frame(exp(cbind("Odds Ratio" = coef(massfurcht_glm5), confint.default(massfurcht_glm5, level = 0.95))))
#Odds Ratios und Konfidenzintervalle in neuem Datensatz speichern
data_f5 <- data.frame(
predictor = c("Sorge:\nFreiheits-\nverlust", "Sorge:\nSoziale\nIsolation", "Subjektive\nEingeschränktheit", "Schlechtes\nZurechtkommen", "Tiefes\nVertrauen"),
boxOdds = c(5.70, 1.15, 5.63, 1.38, 3.83),
boxCILow = c(4.36, 0.93, 4.48, 1.06, 3.08),
boxCIHigh = c(7.43, 1.43, 7.08, 1.79, 4.75)
)
#Erhebungsdatum als Faktor hinzufügen
data_f5$date <- as.factor("2. November")
#Odds Ratios aller Erhebungswellen in einen Datensatz mergen.
OR_fear_merge <- do.call("rbind", list(data_f3,data_f4,data_f5))#Erstellen eines Plots, der alle Odds Ratios und Konfidenzintervalle für alle untersuchten Erhebungszeitpunkte enhält
Bewegung_OR_plot3 <- ggplot(OR_fear_merge, aes(x = boxOdds, y = predictor, color=predictor)) +
geom_errorbarh(aes(xmax = boxCIHigh, xmin = boxCILow), size = .5, height = .1, color = "gray50") + geom_point(size = 4.5) +
scale_x_continuous(breaks = seq(0,9,1) ) +
geom_vline(aes(xintercept = 1), size = .25, linetype = "dashed") +
theme(panel.grid.minor = element_blank()) + theme_ipsum_rc()
#Ändern der Farbpalette und Achsenbeschriftungen
Bewegung_OR_plot3 <- Bewegung_OR_plot3 + labs(y="Faktoren", x="Relative Chance")
Bewegung_OR_plot3 <- Bewegung_OR_plot3 + theme(legend.position = "none") +
scale_color_brewer(palette = "Set2")
#Animation vorbereiten
animated_fear <- Bewegung_OR_plot3 +
labs(subtitle = "{closest_state}") + theme(
plot.caption = element_text(hjust = 0)
) + theme(plot.subtitle=element_text(size=15, face="bold.italic", vjust = 1)) + theme(plot.title=element_text(size=18)) +
transition_states(as.factor(date), transition_length = 2, state_length = 5,
wrap = FALSE)
#Animation erstellen
animate(animated_fear, height = 400, width =500)
#Animation speichern
anim_save("fearanimation_ohneTitel_NEW.gif", animation = last_animation(), path="~/Master UZH/Polito/Vorlesungen/HS20_Datenjournalismus/FINAL/FINAL/")