9 Übung 2 Lösung
9.1 Aufgabe 1
Lese den Datensatz in R ein. Die Variable case_decision repräsentiert den jeweiligen Entscheid und hat drei Merkmalsausprägungen: dismissed (verworfen), upheld (bestätigt) und cancelled (widerrufen). Was sind die absoluten und relativen Häufigkeiten dieser Kategorien?
#| message: false
# Lade Packages
pacman::p_load("sjPlot", "texreg", "haven", "readr", "readxl", "fixest", "MASS", "glm.predict", "scales", "tidyverse")
# Lese Datensatz ein
df_asylentscheide <- read_csv("bvg_dataset.csv")
# Kurze Übersicht über Datensatz
glimpse(df_asylentscheide)
# Erster Schritt: Absolute Häufigkeiten
df_asylentscheide %>%
count(case_decision)
# Zweiter Schritt: Absolute und relative Häufigkeiten
df_asylentscheide %>%
count(case_decision) %>%
mutate(freq_rel = n / sum(n))Wir sehen, dass auf die grosse Mehrheit der Fälle (ca. 70 %) nicht eingetreten wurde. In ca. einem Viertel der Fälle wurde das vorangehende Urteil bestätigt, während nur ca. 0.7 % der vorangehenden Urteile widerrufen wurden. Beachte, dass das Urteil für ca. 5 % der Fälle nicht bekannt ist (NA).
9.2 Aufgabe 2
- Betrachte nun zunächst die absoluten Häufigkeiten der Entscheide pro Partei (
judge_party). Erstelle dazu eine Kreuztabelle, welche zusätzlich zu den Zelleinträgen die Zeilen- und Spaltensummen enthält. Inkludiere fehlende Fälle. Tipp: Verwende die Funktionentable()undaddmargins().
# Bonus: Wir fügen parteilose Richter:innen zu den fehlenden Werten hinzu
df_asylentscheide %>%
count(judge_party)
df_asylentscheide <- df_asylentscheide %>%
mutate(judge_party = if_else(judge_party == "Parteilos", NA, judge_party))
# Absolute Häufigkeiten mit NA + marginal frequencies über Zeilen und Spalten
table(df_asylentscheide$case_decision,
df_asylentscheide$judge_party, useNA = "ifany") %>%
addmargins()
# Falls wir die Parteien in den Zeilen möchten (erste Stelle = Zeilen, zweite Stelle = Spalten):
table(df_asylentscheide$judge_party,
df_asylentscheide$case_decision, useNA = "ifany") %>%
addmargins()- Die absolute Häufigkeiten sind für die Beantwortung unserer Fragestellung kaum hilfreich. Nutze deshalb deinen Code aus 2a (ohne
addmargins()) und transformiere die Kreuztabelle mithilfe vonprop.table()zu relativen Häufigkeiten Wie interpretierst du die erstellte Tabelle?
# Relative Häufigkeiten
tbl_relf <- table(df_asylentscheide$judge_party,
df_asylentscheide$case_decision, useNA = "ifany") %>%
prop.table(margin = 1) %>%
round(2)
tbl_relfDa wir an der Verteilung der Urteilskategorien pro Partei interessiert sind, berechnen wir die relativen Häufigkeiten pro Zeile, indem wir in der Funktion prop.table() das Argument margin = 1 hinzufügen. Machen wir das nicht, erhalten wir die Anteile relativ zur Gesamtzahl der Fälle.
Wir sehen, dass sich die Anteile der verworfenen Fälle zwischen den Parteien unterscheiden. Zum Beispiel ist dieser höher für die SVP (74 %) als die SP (67 %). Ferner ist der Anteil der widerrufenen Urteile tiefer für die GLP und die SP als für die übrigen Parteien.
9.3 Aufgabe 3
- Erstelle einen Datensatz
df_verworfen, welcher für jede Parteizugehörigkeit die Wahrscheinlichkeit einen Fall zu verwerfen enthält. Nehme vereinfachend an, dass ein Fall entweder verworfen oder bestätigt werden kann. Für die Lösung dieser Aufgabe kannst du unter anderem die Funktionenfilter(),group_by(), undcount()verwenden.
df_verworfen <- df_asylentscheide %>%
# Zunächst berechnen wir die absolute Anzahl verworfener und bestätigter Fälle je Partei
filter(case_decision %in% c("dismissed", "upheld")) %>%
group_by(judge_party, case_decision) %>%
count() %>%
# Dann berechnen wir die Wahrscheinlichkeit/den Anteil, dass ein Fall verworfen wird je Partei
group_by(judge_party) %>%
mutate(Prverworfen = round(n / sum(n), 2)) %>%
# Und filtern nach verworfenen Fällen
filter(case_decision == "dismissed")- Stelle nun die, in deinem Datensatz gespeicherten, Wahrscheinlichkeiten einen Fall zu verwerfen nach Partei als Balkendiagramm dar.
df_verworfen %>%
ggplot(aes(x = Prverworfen * 100, y = judge_party, fill = judge_party)) +
geom_col(width = 0.5) +
scale_fill_manual(values = c("BDP" = "#E6C820", "FDP" = "blue",
"GLP" = "#C4C43D", "GPS" = "#84B547",
"Mitte" = "#D6862B", "SP" = "skyblue",
"SVP" = "#4B8A3E")) +
# Für spezifische Farben können wir sogenannte Hex-Codes verwenden.
# Diese können wir z.B. über folgende Website finden: https://colorhunt.co/ oder für CH-Parteien über
# https://github.com/srfdata/swiss-party-colors
# Alternativ können wir auch Namen wie "lightblue" oder "green" verwenden.
theme_bw() +
theme(legend.position = "none") +
labs(x = "Anteil verworfener Fälle", y = "Parteizugehörigkeit") +
xlim(0,100)- Wie gross ist der Unterschied im Anteil der verworfenen Fälle zwischen Richtern der SVP und solchen der SP, ausgedrückt in Prozentpunkten?
# Mit untenstehendem Code greifen wir auf die für SP und SVP berechneten Anteile zu und berechnen anschliessend die Differenz
anteil_svp <- df_verworfen[7,4]
anteil_sp <- df_verworfen[6,4]
(anteil_svp - anteil_sp)*100Die Differenz beträgt 6 Prozentpunkte.
9.4 Aufgabe 4
Der in Aufgabe 3c errechnete Unterschied kann als Effekt der Parteizugehörigkeit (SP vs. SVP) auf die Wahrscheinlichkeit einen Asylrekurs zu verwerfen interpretiert werden. Die Frage ist aber, ob es sich um einen kausalen Effekt handelt. Überlege dir dies anhand des folgenden Artikels: https://www.republik.ch/2022/01/11/von-unsichtbarer-hand.
Der Unterschied von Aufgabe 3 kann nur als kausaler Effekt interpretiert werden wenn die Zuteilung der Fälle unabhängig von der Parteizugehörigkeit der Richter:innen erfolgt. Auf der Basis von 47’291 Urteilen (2008 bis 2018) wurde das zufällige Ergebnis der Spruchkörperbildung des Algorithmus in 45% der Fälle abgeändert. Daher müssen wir davon ausgehen, dass die Zuteilung der Fälle nicht randomisiert ist und der Unterschied von Aufgabe 3 nicht als kausaler Effekt interpretiert werden kann.
9.5 Aufgabe 5 (FORTGESCHRITTEN)
Sei \(D_i\in\{0,1\}\) ein Indikator für den Treatment-Status einer Untersuchungseinheit \(i\). Für alle Einheiten in der Treatment-Gruppe gilt \(D_i=1\), während \(D_i=0\) für alle Kontrolleinheiten. Ferner sei \(Y_i(0)\) das potentielle Ergebnis unter Kontrollstatus, während \(Y_i(1)\) das potentielle Ergebnis unter Treatmentstatus darstellt.
- Simuliere die beobachteten Werte \(Y\) einer randomisierten kontrollierten Studie (engl. randomized controlled trial RCT) mit 1000 Teilnehmenden. Der Treatment-Effekt betrage 2.55 für sämtliche Individuen. Nehme an, dass die potentiellen Ergebnisse aus folgendem Datengenerierungsprozess stammen:
\[\begin{align*} Y(0) &= 1 + \varepsilon, & \varepsilon\sim\mathcal{N}(0,1) \\ Y(1) &= 1 + \text{TE} + \varepsilon, & \varepsilon\sim\mathcal{N}(0,1) \end{align*}\]
Lösungshilfe: Gehe Schritt für Schritt vor. (1) Setze zunächst einen seed = 32. (2) Erstelle mit
tibble()einen Datensatz mit 1000 Reihen, welcher für jede Observation einen Fehlerterm, den Treatment-Effekt und den Treatment-Status enthält. Den Treatment-Status kannst du mit dem Code rbinom(n=1000, size=1, prob =0.5) randomisieren. (3) Generiere zwei Variablen für die potentiellen Ergebnisse, indem du die obenstehenden Formeln des Datengenerierungsprozesses in R nachbaust. (4) Nutze die Ergebnisse aus den zwei vorangegangenen Schritten um zum Schluss die beobachteten Werte \(Y\) zu generieren (4).
# TIDYVERSE VARIANTE
# Seed setzen für Nachvollziehbarkeit
set.seed(32)
# Treatment randomisieren, Fehlerterm und Treatment-Effekt generieren
exp <- tibble(
treatment = rbinom(n = 1000, size = 1, prob = 0.5), # Randomisierung, wer Treatment erhält
e = rnorm(n= 1000, mean = 0, sd = 1), # Individueller Fehler, Basisabweichung
effect = 2.55 # Treatment-Effekt, hier für alle gleich, in der Realität aber häufig unterschiedlich (für diese Übung irrelevant)
)
# Alles in Formel Datengenerierungsprozesse einsetzen und potentielle Ergebnisse Y(1) und Y(0) generieren
exp <- exp %>%
mutate(
y_0 = 1 + e,
y_1 = 1 + effect + e
)
# Beobachtete Werte Y generieren
# Wenn treatment = 1, dann y_1, sonst y_0
exp <- exp %>%
mutate(
y = ifelse(treatment == 1, y_1, y_0)
)- Berechne nun sowohl den Mittelwert der beobachteten Werte für die Kontroll- als auch die Treatment-Gruppe und bilde die Differenz beider Werte. Wiederhole dies für beide potentiellen Ergebnisse. Vergleiche die beiden erhaltenen Differenzen.
# Beobachtete Werte (y)
# Tidyverse
mean_treated <- exp |>
filter(treatment == 1) %>%
summarize(mean_y = mean(y))
mean_control <- exp |>
filter(treatment == 0) %>%
summarize(mean_y = mean(y))
mean_treated - mean_control
# Mit base r
mean(exp$y[exp$treatment == 1]) - mean(exp$y[exp$treatment == 0])
# Potential outcomes (y_0 und y_1)
mean(exp$y_1 - exp$y_0)Wir können erkennen, dass \(\mathbb{E}[Y|D=1]-\mathbb{E}[Y|D=0]\approx\mathbb{E}[Y(1)-Y(0)]\). In Worten ausgedrückt, sehen wir, dass der Unterschied in den beobachteten Mittelwerten approximativ dem durchschnittlichen Treatment-Effekt (engl. average treatment effect ATE) entspricht. Dies gilt, da das Treatment zufällig zugewiesen wurde, wodurch sich die potenziellen Outcomes in beiden Gruppen im Erwartungswert nicht unterscheiden.
Der beobachtete Mittelwert entspricht nicht genau dem Treatment-Effekt, da es aufgrund der randomisierten Treatment-Zuweisung in dieser spezifischen Iteration der Zuweisung mal diese, mal jene Observation ‘trifft’. Über viele Iterationen und viele Zuweisungen würde der Mittelwert der beobachteten Mittelwerte genau dem Treatment-Effekt entsprechen.
Übrigens: Den Treatment-Effekt, also in diesem Fall die Differenz zwischen den Mittelwerten der Treatment- und der Kontrollgruppe, können wir auch mittels einer linearen Regression berechnen. Dafür müssen wir den tatsächlich beobachteten Outcome auf den Treatment-Indikator regressieren.
m0 <- lm(y ~ treatment, data = exp)
coef(m0)