DDJ-Blogbeitrag HS 2020
Kommentierter R-Code
Jonathan Progin
03 01 2021
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) # tableDaten laden
# Arbeitsverzeichnis definieren
setwd(paste0("~/Desktop/Daten, R, Homeworks, etc/Vorbereitung FS DDJ/Daten_DDJ_HS20_Olat"))
# Dateipfad definieren
file_path1 <- "./Corona-Monitor/2-Daten/CoronaMonitorAll.csv"
# Daten einlesen (Corona-Monitor von sotomo)
Corona_Data <- read.csv(file_path1,
sep = ",",
encoding = "UTF-8",
stringsAsFactors = FALSE)
# Dateipfad definieren
file_path2 <- "./Corona-Monitor/2-Daten/kantonnr.csv"
# Nummerierung der Kantone
ktnr <- read.csv(file_path2,
sep=";",
encoding="UTF-8",
stringsAsFactors = F)
# Dateipfad definieren
file_path3 <- "./Corona-Monitor/2-Daten/ag-b-00.03-875-gg20/ggg_2020-LV95/shp/g2k20.shp"
# Shapefile laden (Karte der Schweiz)
cantons_geo <- read_sf(file_path3)Karte 1: Vertrauen
# Datensatz für Karte zu Vertrauen erstellen und strukturieren
all_trust <- Corona_Data %>%
mutate(vertrauenNum = as.numeric(stringr::str_extract(vertrauen, "[0-9]+"))) %>%
group_by(Welle, kanton) %>%
mutate(trust = weighted.mean(vertrauenNum , na.rm=T, weight = weight)) %>%
subset(kanton != "- Auslandschweizer/in -") %>%
# Auslandschweizer*innen exkludieren; werden für die Analyse nicht gebraucht
select(kanton, trust, Welle) %>%
distinct() %>%
left_join(
ktnr, by = c("kanton" = "Kanton")) %>%
mutate(Date = case_when(Welle == 1 ~ "21.03. - 23.03.",
Welle == 2 ~ "03.04. - 06.04.",
Welle == 3 ~ "02.05. - 05.05.",
Welle == 4 ~ "05.06. - 08.06.",
Welle == 5 ~ "23.10. - 02.11."))
all_trust$Date <- factor(all_trust$Date, levels = unique(all_trust$Date[order(all_trust$Welle)]))
# Datensatz an Schweizerkarte anbinden
all_trust <- left_join(cantons_geo, all_trust,
by = c("KTNR" = "ktnr"))
# Karte erstellen
map_trust <- ggplot() +
geom_sf(data = cantons_geo,
aes(), fill = "#FCFCFC", color = "#666666", size = 0.4) +
geom_sf(data = all_trust, aes(fill = trust), color = "black", size = 0.08) +
scale_fill_gradient(low = "#b7beed", high = "#2339c2",
na.value = "grey50",
limits = c(min(all_trust$trust), max(all_trust$trust)),
oob = squish,
breaks = c(2.8, 3.2, 3.6, 4.0),
labels = c("2.8: Eher kleines Vertrauen","3.2", "3.6",
"4.0: Eher grosses Vertrauen")) +
theme_void() +
theme(panel.grid.major = element_line("transparent")) +
labs(title = "In der zweiten Corona-Welle hat der Bundesrat viel Vertrauen\nin der Bevökerung verloren\n",
fill = "Stärke des Vertrauens",
caption = "\nFrage: «Wie gross ist Ihr Vertrauen in die politische Führung der Schweiz in Bezug auf\ndie Bewältigung der Corona-Krise?» (1 = «sehr klein» bis 5 = «sehr gross»)\nDaten: Forschungsstelle sotomo (Corona-Monitor 2020)") +
theme(plot.title = element_text(size = 10, face = "bold", hjust = 0),
plot.caption = element_text(size = 7, hjust = 0)) +
theme(legend.position = c(0.75, 0.175)) +
facet_wrap(~Date, nrow = 3, ncol = 2)
map_trust
# Karte zu Vertrauen abspeichern
ggsave("map_vertrauen.png", width = 5, height = 7)Karte 2: Kommunikation
# Datensatz für Karte zu Kommunikation erstellen und strukturieren
all_comm <- Corona_Data %>%
mutate(kommunikationNum = as.numeric(stringr::str_extract(kommunikation, "[0-9]+"))) %>%
group_by(Welle, kanton) %>%
mutate(comm = weighted.mean(kommunikationNum , na.rm=T, weight = weight)) %>%
subset(kanton != "- Auslandschweizer/in -") %>%
# Auslandschweizer*innen exkludieren; werden für die Analyse nicht gebraucht
select(kanton, comm, Welle) %>%
distinct() %>%
left_join(
ktnr, by = c("kanton" = "Kanton")) %>%
mutate(Date = case_when(Welle == 1 ~ "21.03. - 23.03.",
Welle == 2 ~ "03.04. - 06.04.",
Welle == 3 ~ "02.05. - 05.05.",
Welle == 4 ~ "05.06. - 08.06.",
Welle == 5 ~ "23.10. - 02.11."))
all_comm$Date <- factor(all_comm$Date, levels = unique(all_comm$Date[order(all_comm$Welle)]))
# Datensatz an Schweizerkarte anbinden
all_comm <- left_join(cantons_geo, all_comm,
by = c("KTNR" = "ktnr"))
# Karte erstellen
map_comm <- ggplot() +
geom_sf(data = cantons_geo,
aes(), fill = "#FCFCFC", color = "#666666", size = 0.4) +
geom_sf(data = all_comm, aes(fill = comm), color = "black", size = 0.08) +
scale_fill_gradient(low = "#edd0ca", high = "#bd2c28",
na.value = "grey50",
limits = c(min(all_comm$comm), max(all_comm$comm)),
oob = squish,
breaks = c(2.8, 3.2, 3.6, 4.0),
labels = c("2.8: Eher schlechtes Urteil","3.2", "3.6",
"4.0: Eher gutes Urteil")) +
theme_void() +
theme(panel.grid.major = element_line("transparent")) +
labs(title = "Auch das Urteil über die behördliche Kommunikation fällt in\nder zweiten Welle schlechter aus\n",
fill = "Stärke des Urteils",
caption = "\nFrage: «Wie beurteilen Sie die Kommunikation durch Regierung und Verwaltung?»\n(1 = «sehr schlecht» bis 5 = «sehr gut»)\nDaten: Forschungsstelle sotomo (Corona-Monitor 2020)") +
theme(plot.title = element_text(size = 10, face = "bold", hjust = 0),
plot.caption = element_text(size = 7, hjust = 0)) +
theme(legend.position = c(0.75, 0.175)) +
facet_wrap(~Date, nrow = 3, ncol = 2)
map_comm
# Karte zu Kommunikation abspeichern
ggsave("map_kommunikation.png", width = 5, height = 7)Grafik Regression: Einfluss auf Vertrauen
In diesem Abschnitt bereite ich die Grafik (ein sogenannter “Forest Plot”) vor. In dieser Grafik werden nur Umfragedaten aus der fünften Welle und somit aus dem Zeitraum vom 23. Oktober bis zum 2. November 2020 untersucht.
# Datensatz für fünfte Welle erstellen und auf zu untersuchende Variablen beschränken
CoronaW5 <- Corona_Data %>% filter(Welle == 5)
CoronaW5 <- dplyr::select(CoronaW5, vertrauen, kanton, HHeinkommen, age, edu, sex, kommunikation, weight)
# Variable "vertrauen" recodieren
CoronaW5 <- CoronaW5 %>%
mutate(vertrauenNum = case_when(vertrauen == "1: Sehr klein" ~ 1,
vertrauen == "5: Sehr gross" ~ 5,
TRUE ~ as.numeric(vertrauen)))
# Variable "kommunikation" recodieren
CoronaW5 <- CoronaW5 %>%
mutate(kommunikationNum = case_when(kommunikation == "1: Sehr schlecht" ~ 1,
kommunikation == "5: Sehr gut" ~ 5,
TRUE ~ as.numeric(kommunikation)))
# Neuer Datensatz für Regression und Grafik erstellen
W5 <- CoronaW5 %>%
group_by(kanton) %>%
subset(kanton != "- Auslandschweizer/in -") %>%
# Auslandschweizer*innen exkludieren; werden für die Analyse nicht gebraucht
filter(!(HHeinkommen %in% c("", "Weiss nicht / keine Angabe"))) %>%
mutate(HHeinkommen = case_when(HHeinkommen == "4'000 bis 6‘000" ~ "4'000 bis 6'000 ",TRUE~HHeinkommen)) %>%
mutate(HHeinkommen = case_when(
HHeinkommen %in% c("10'001 bis 16'000 ", "Über 16'000 ") ~ "Hohes Haushaltseinkommen",
HHeinkommen %in% c("4'000 bis 6'000 ", "6'001 bis 10'000 ") ~ "Mittleres Haushaltseinkommen",
HHeinkommen %in% "Weniger als 4'000 " ~ "Tiefes Haushaltseinkommen",
HHeinkommen %in% "NA" ~ "NA")) %>%
# Haushaltseinkommen in drei Kategorien unterteilen: hoch, mittel, tief
mutate(HHeinkommen = factor(HHeinkommen, levels = c("Tiefes Haushaltseinkommen", "Mittleres Haushaltseinkommen", "Hohes Haushaltseinkommen"))) %>%
mutate(edu = case_when(
edu %in% c("Universität, ETH", "Fachhochschule, PH", "Höhere Fach- und Berufsausbildung") ~ "Hohes Bildungsniveau",
edu %in% c("Gymnasium, Berufsmatura, FMS, DMS", "Berufslehre") ~ "Mittleres Bildungsniveau",
edu %in% "Kein Bildungsabschluss, obligatorische Schule" ~ "Tiefes Bildungsniveau",
edu %in% "NA" ~ "NA")) %>%
# Bildung in drei Kategorien unterteilen: hoch, mittel, tief
mutate(edu = factor(edu, levels = c("Tiefes Bildungsniveau", "Mittleres Bildungsniveau", "Hohes Bildungsniveau"))) %>%
# Geschlechtskategorie "Andere / Keine Angabe" für die anschliessende Regression löschen
filter(!(sex %in% c("Andere / Keine Angabe"))) %>%
select(kanton, vertrauenNum, kommunikationNum, sex, edu, HHeinkommen, age, weight) %>%
distinct()
# Datensatz inspizieren
head(W5)
# Referenzkategorie der Regression anpassen, damit die Reihenfolge im Plot "absteigend" ist
W5$edu <- relevel(W5$edu, ref = "Tiefes Bildungsniveau")
W5$HHeinkommen <- relevel(W5$HHeinkommen, ref = "Tiefes Haushaltseinkommen")
# NA's weglassen
W5 <- na.omit(W5)
# Regression durchführen und betrachten
reg <- lm(vertrauenNum ~ kommunikationNum + sex + age + I(age^2) + edu + HHeinkommen, weights = weight, data = W5)
summary(reg)Nun erstelle ich in einem ersten Schritt eine Tabelle für die Regressionsresultate. Diese werde ich nicht direkt in den Blog hineinbetten, aber für Interessierte verlinken. In einem zweiten Schritt plotte ich den Datensatz und erstelle somit die Grafik, die die Regressionsresultate vereinfacht darstellen.
# Tabelle erstellen
table_reg <- stargazer(reg, type = "html", title="Tabelle 1: Einfluss auf Vertrauen in den Bundesrat",
digits=2, align = TRUE,
covariate.labels = c("Urteil über Kommunikation", "Geschlecht: Mann", "Alter", "Alter quadriert",
"Mittleres Bildungsniveau",
"Hohes Bildungsniveau",
"Mittleres Haushaltseinkommen",
"Hohes Haushaltseinkommen"),
dep.var.labels = "Vertrauen in den Bundesrat",
dep.var.caption = "<i>Abhängige Variable</i>",
out = "Tabelle_Vertrauen_Bundesrat.html")
table_reg
# Labels (Namen) der Variablen für Grafik anpassen
labels <- c("Hohes Haushaltseinkommen pro Monat", "Mittleres Haushaltseinkommen pro Monat", "Hohes Bildungsniveau", "Mittleres Bildungsniveau", "Alter quadriert", "Alter", "Geschlecht: Mann", "Urteil über Kommunikation")
# Grafik Regression erstellen
plot_reg <- plot_model(reg, show.values = TRUE,
value.offset = 0.25, group.terms = c(1, 2, 3, 3, 4, 4, 5, 5),
axis.labels = labels,
axis.title = "Einfluss auf Vertrauen\n(23.10. - 02.11.)",
title = "In der zweiten Corona-Welle hat das Urteil über\nKommunikation einen Einfluss auf Vertrauen",
wrap.title = 100)
plot_reg
# Grafik Regression abspeichern
ggsave("plot_einfluss_vertrauen_bundesrat.png", width = 6, height = 6)