20 Übung 13 Lösung
20.1 Aufgabe 1a
Lade den Datensatz death_penalty.dta. Die Beschreibung der Variablen findest du im Codebook (codebook_death.pdf) auf OLAT.
Du erhältst die Aufgabe mithilfe eines binären Modelles zu erklären welche Faktoren die Verhängung der Todesstrafe beeinflussen. Benutze dazu die Variable v2, sowie eine sinnvolle Auswahl der Variablen fv, vs, ac, ms und yv. Schätze die Koeffizienten mithilfe der Probit oder Logit Linkfunktion. Stelle das Modell in einer Tabelle dar und interpretiere die Resultate.
Überprüfe ob alle Variablen, welche du in deinem Modell verwenden möchtest richtig kodiert sind. Falls du die Variablennamen nicht intuitiv findest, kannst du diese mit der rename() Funktion einfach umbennenen.
pacman::p_load("sjPlot", "texreg", "haven", "readr", "readxl", "fixest", "MASS", "glm.predict", "scales", "tidyverse")
# Daten einlesen
df_penalty <- read_dta("death_penalty.dta")
table(df_penalty$death) # Death hat aktuell noch drei Ausprägungen. Wenn wir das nicht korrigieren wird uns beim Schätzen eines binären Modells ein Fehler angezeigt ("Fehler in eval(family$initialize) : y Werte müssen in [0, 1] liegen")
df_penalty <- df_penalty %>%
mutate(death = ifelse(death == 99, NA, death),
ac = ifelse(ac == 99, NA, ac), # auch auf der Variable ac haben wir noch eine Beobachtung, welche NA sein sollte
vs = ifelse(vs == "", NA, vs)) # eine Ausprägung von vs ist "leer" -> als NA kodieren
# Variablen umbenennen
df_penalty2 <- df_penalty %>%
rename(nrvictimcs = v2,
gender = fv,
relationship = vs, # hat kaum einen Einfluss auf Strafmass
aggravating = ac,
stabwounds = ms, # Stab wounds sind nicht bei jedem tödlichen Verbrechen
# ausschlaggebend
agevictim = yv)
# Wir fahren nun aber mit den ursprünglichen Variabelnamen weiter
model_logit <- glm(death ~ v2 + fv + ac + yv,
family = binomial,
data = df_penalty)
# Logit ist die default Linkfunktion. Für Probit: binomial("probit")
summary(model_logit)Die Variable ac misst die Anzahl der erschwerenden Umstände (bspw. Opfer war Polizeibeamter/beamtin, das Opfer war ein Kinder unter 12 Jahren, etc. siehe Codebook). Sie ist positiv und statistisch signifikant. Die Todesstrafe wird demnach mit der steigenden Anzahl an erschwerenden Umständen wahrscheinlicher. Dies entspricht auch unserer Intuition, wonach schwerere Verbrechen härter bestraft werden. Alle anderen Variablen weisen keinen statistisch signifikanten Zusammenhang mit der Wahrscheinlichkeit der Verhängung der Todesstrafe auf.
20.2 Aufgabe 1b
Stelle den Zusammenhang zwischen der Anzahl Opfer und der Wahrscheinlichkeit für die Todesstrafe graphisch dar.
set.seed(666)
predicts(model_logit, "0-6, 1; mode; median; mode") %>%
ggplot(aes(x = v2, y = mean,
ymin = lower, ymax = upper)) +
geom_ribbon(alpha = 0.3) +
geom_line() +
scale_y_continuous(labels = scales::percent)Mit steigender Opferzahl nimmt die vorhergesagte Wahrscheinlichkeit für die Todesstrafe zwar leicht zu, sie bleibt jedoch insgesamt auf einem tiefen Niveau. Das ist konsistent mit dem nicht-signifikanten Effekt von v2. Das Konfidenzband weitet sich bei höheren Opferzahlen stark aus, da Fälle mit vielen Opfern im Datensatz selten sind und die Schätzung dort auf einer dünneren Datengrundlage beruht.
20.3 Aufgabe 2a
Nun sollst du den Einfluss der Hautfarbe auf das Verhängen der Todesstrafe genauer untersuchen. Du rechnest daher ein binäres Modell (Logit oder Probit). Benutze dazu neben dem Indikator für die Hautfarbe der angeklagten Person die Variablen v2, fv, ac und yv. Interpretiere das Resultat.
race_model1 <- glm(death ~ bd + v2 + fv + ac + yv,
family = binomial,
data = df_penalty)
summary(race_model1)Die Hautfarbe der angeklagten Person scheint keinen statistisch signifikanten Einfluss auf die Verurteilung zur Todesstrafe zu haben. Aufgrund dieses Modelles können wir keine rassistische Diskriminierung im US Justizsystem feststellen. Wie im Modell aus Aufgabe 1a weist lediglich die Variable ac einen statistisch signifikanten Einfluss auf die Verurteilung zur Todesstrafe aus.
20.4 Aufgabe 2b
Eine Kollegin wendet ein, dass rassistische Einstellungen insbesondere relevant sein könnten, wenn die Opfer weiss sind. Füge daher den entsprechenden Indikator zur Regression aus Aufgabe 2a hinzu, welcher angibt ob es sich im vorliegenden Fall um ein Verbrechen an einem weissen Opfer handelt. Welche Schlüsse ziehst du?
race_model2 <- glm(death ~ bd + v2 + fv + ac + yv + wv,
family = binomial,
data = df_penalty)
summary(race_model2)Die Hypothese der Kollegin scheint standzuhalten. Die Variable wv ist positiv und statistisch signifikant. Wir sehen auch, dass die Hautfarbe des Angeklagten weiterhin nicht signifikant ist (auf einem \(\alpha=0.05\) Niveau). Wir schliessen daraus, dass schwarze Personen auf der Anklagebank zwar nicht rassistisch benachteiligt werden, dafür aber ein rassistisches höheres Strafmass bei weissen Opfern angewendet wird. In aller Kürze: Ja, es gibt Anzeichen für Rassismus aber nicht so, wie man vielleicht zunächst erwarten würde.
Wie bereits in Aufgabe 1a festgestellt wurde, steigt die Wahrscheinlichkeit der Todesstrafe mit der Anzahl erschwerender Umstände.
20.5 Aufgabe 2c
Berechne nun die Effektgrösse, also wie stark sich die vorhergesagte Wahrscheinlichkeit der Todesstrafe bei weissen Opfern erhöht, im Gegensatz zu nicht-weissen Opfern (discrete change). Nutze dafür wie in Übungsblatt 12 die predicts() Funktion aus dem package glm.predict. Setze die restlichen Kontrollvariablen auf ihren Modus.
Nutze das Argument position = zur automatischen Berechnung des discrete change. Nimm allenfalls die Dokumentation der Funktion zur Hilfe: ?glm.predict::predicts
set.seed(123)
dc <- predicts(race_model2, "Mode; Mode; Mode; Mode; Mode; 0-1", position = 6)
dc[7]
# Package berechnet discrete change als Wahrscheinlichkeit für Wert 1 (hier 0) -
# Wahrscheinlichkeit für Wert 2 (hier 1). Hier also Wechsel der Wahrscheinlichkeit, wenn
# wir von den Weissen zu den Nicht-Weissen wechseln.
# Wir können die Interpretation auch umkehren:
dc[7]*(-1)Die Wahrscheinlichkeit der Todesstrafe ist bei weissen Opfer gut r -1*round(100*dc[7],0) Prozentpunkte höher als bei nicht-weissen Opfer für diese durchschnittlichen Beobachtungen.
20.6 Aufgabe 3a
In Übung 12 haben wir gelernt, dass bei binären Modellen aus der Regressionstabelle ausschliesslich die Vorzeichen der Koeffizienten, sowie die statistische Signifikanz ablesbar sind. Ein Kollege argumentiert, dass man damit ja alles habe, was man zur Beantwortung einer Forschungsfrage benötige. Die Berechnung der vorhergesagten Wahrscheinlichkeiten sei daher nicht notwendig. Bist du mit dieser Aussage einverstanden oder nicht? Weshalb?
Anhand der Regressiontabelle können wir die statistische Signifikanz, sowie die Richtung der Zusammenhänge erkennen. Damit können wir grobe Aussagen über unsere Hypothesen tätigen. Die substanzielle Interpretation der Koeffizienten ist jedoch nicht zulässig. Damit können wir anhand der Regressiontabelle keine Aussagen über die Effektgrösse tätigen. Die Effektgrösse ist relevant für eine gute Einordnung unserer Ergebnisse. Findet sich ein signifikanter aber kleiner Unterschied der Mittelwerte, müssen wir unsere Ergebnisse zurückhaltender beurteilen, als wenn wir grosse Effekte finden, die scheinbar ausschlaggebend sein könnten.
20.7 Aufgabe 3b
Eine Kollegin untersucht die Hypothese, dass linke Personen eher Fake News teilen als rechte Personen. Aufgrund des Ergebnisses ihres binären Modelles sieht sie sich bestätigt und zeigt dir ihre Resultate. Wie beurteilst du die untenstehenden Ergebnisse?
Hinweis: Die Links-Rechts Selbsteinschätzung wurde folgendermassen codiert: 0 = sehr links, 10 = sehr rechts.
| Coefficient | p-value | |
|---|---|---|
| Intercept | 1.8 | 0.0021 |
| left-right self-placement | -3.8 | 0.04 |
| age | 0.2 | 0.8 |
container_pp <- rep(NA,10)
container_upper <- rep(NA,10)
container_lower <- rep(NA,10)
x = 0.56
for (i in 1:10){
pp = x+ i*-0.0015
container_pp[i] <- pp
container_upper[i] <- pp+ 0.02
container_lower[i] <- pp- 0.02
}
tibble(lr = c(1:10),
pp = container_pp,
upper = container_upper,
lower = container_lower) %>%
ggplot(aes(x= lr, y= pp,
ymin= lower, ymax= upper))+
geom_ribbon(alpha= 0.3)+
geom_line(color= "darkred", linewidth= 1)+
theme_bw()+
labs(x= "left-right self-placement (left = 1, right = 10)",
y= "predicted probability",
title = "Effect of political ideology \non probability to share fake news")Aufgrund der Tabelle 1 können wir erkennen, dass es sich um einen negativen und statistisch signifikanten Zusammenhang handelt. Linke Personen scheinen also häufiger Falschinformationen zu teilen als rechte Personen. Grafik 1 zeigt uns jedoch, dass die Effektgrösse sehr bescheiden ist. Vom minimalen bis zum maximalen Wert auf der Links-Rechts-Achse reduziert sich die vorhergesagte Wahrscheinlichkeit lediglich um etwa 1.5 Prozentpunkte. Obwohl es also einen statistischen Zusammenhang gibt, ist dieser nicht wirklich relevant. Wir würden also daraus schliessen, dass sich die politische Ideologie kaum darauf auswirkt ob eine Person Fake News teilt.
Anmerkung: Grafik 1 ist ein sehr gutes Beispiel, weshalb man, wenn immer möglich, das gesamte mögliche Ausprägungsintervall darstellen sollte. Die obenstehende Grafik verzerrt die Grösse des tatsächlichen Zusammenhangs, indem lediglich die Wahrscheinlichkeiten von ca. 53% bis 58% dargestellt werden. Erweitert man die y-Achse auf 0% bis 100%, so wird sehr schnell ersichtlich, dass der Zusammenhang nur sehr flach ist. Achtet daher in eurer wissenschaftlichen Arbeit darauf nicht bloss Unsicherheiten anzugeben, sondern auch eure Grafiken so darzustellen, dass sie die Resultate unverzerrt wiedergeben.
tibble(lr = c(1:10),
pp = container_pp,
upper = container_upper,
lower = container_lower) %>%
ggplot(aes(x= lr, y= pp,
ymin= lower, ymax= upper))+
geom_ribbon(alpha= 0.3)+
geom_line(color= "darkred", linewidth= 1)+
theme_bw()+
labs(x= "left-right self-placement (left = 1, right = 10)",
y= "predicted probability",
title = "Effect of political ideology \non probability to share fake news")+
scale_y_continuous(limits = c(0,1))