18 Übung 11 Lösung
18.1 Aufgabe 1a
Welche der folgenden Hypothesen stufst du als valide ein?
- Linke Parteien unterstützen politische Vorstösse für ökonomische Umverteilung.
- Regenfall reduziert die Wahrscheinlichkeit von Bürgerkrieg in Entwicklungsländern.
- Parteien mit höheren Werbeausgaben sind erfolgreicher bei nationalen Wahlen.
- Das Wetter beeinflusst die Stimmbeteiligung.
Hypothese 1: Hierbei handelt es sich um eine Tautologie. Unter einer “linken” Partei verstehen wir eine Partei, welche sich auf der ökonomischen Achse für Umverteilung, einen starken Sozialstaat und Arbeitnehmerrechte einsetzt. Diese Hypothese ist somit per Definition nicht falsifizierbar.
Hypothese 2: Die Hypothese ist falsifizierbar und postuliert einen deutlichen Zusammenhang. Es handelt sich um eine valide Hypothese.
Hypothese 3: Die Hypothese ist falsifizierbar und postuliert einen deutlichen Zusammenhang. Es handelt sich um eine valide Hypothese.
Hypothese 4: Diese Hypothese ist potenziell falsifizierbar, macht jedoch keine genaueren Aussagen über den erwarteten Zusammenhang. Mit einer kleinen Umformulierung lässt sich eine valide Hypothese bilden: Regen reduziert die Wahrscheinlichkeit, dass eine Person zur Urne geht.
18.2 Aufgabe 1b
Eine Kollegin präsentiert ihre Hypothese: Personen mit extremen politischen Positionen teilen eher Fake News, als Personen aus der politischen Mitte. Formuliere die Null-Hypothese.
Die Nullhypothese lautet: Die politische Einstellung hat keinen Einfluss auf die Wahrscheinlichkeit Fake News zu teilen. Sie ist die vorsichtige Grundannahme (es gibt kein Zusammenhang). Nur wenn es sehr unwahrscheinlich ist, dass die gefundenen Unterschiede zufällig entstanden sind, verwerfen wir die Null-Hypothese.
18.3 Aufgabe 2a
Erinnere dich zurück an die Übung 5. Dort haben wir uns unter anderem mit Geschlechterunterschieden bezüglich politischer Präferenzen beschäftigt. Du sollst nun zeigen, ob sich die beiden Gruppen im Durchschnitt signifikant unterscheiden. Lade den Datensatz df_selects19_2.RData und berechne zuerst die Differenz der durchschnittlichen Selbsteinschätzung zwischen den Geschlechtern. Welche Aussagen kannst du mit dieser Information treffen?
pacman::p_load("sjPlot", "texreg", "haven", "readr", "readxl", "fixest", "MASS", "glm.predict", "scales", "tidyverse")
load("df_selects19_2.RData")
selects <- df_selects19_2 %>%
mutate(
leftright = as.numeric(case_when(
leftright == "0 - Left" ~ "0",
leftright == "10 - Right" ~ "10",
T ~ leftright))
)
# Variante 1
males <- selects %>%
filter(gender == "Male") |>
drop_na(leftright) # Vorarbeit für die nächste Aufgabe
females <- selects %>%
filter(gender == "Female") |>
drop_na(leftright)
mean_diff <- mean(males$leftright) - mean(females$leftright)
mean_diff
# Variante 2: Ein wenig eleganter
selects |>
group_by(gender) |>
summarise(means = mean(leftright, na.rm = T)) |>
summarise(diff = diff(means))Die durchschnittliche Links-Rechts Selbsteinschätzung ist bei den Männern um 0.678 höher (= rechter) als bei den Frauen. Wir wissen jedoch noch nicht, ob dieser Unterschied auch statistisch signifikant ist. Es lassen sich daher lediglich deskriptive Aussagen über das Sample treffen.
18.4 Aufgabe 2b
Nehme nun die Folien der Vorlesung zur Hilfe und berechne damit den Standardfehler der Mittelwertsdifferenz.
# Variante 1: Bestandteile schrittweise berechnen
## N ##
# Achtung: Wir müssen diejenigen Beobachtungen entfernen, welche
# ein NA auf leftright haben, sonst erhalten wir ein falsches n
n_male <- nrow(males)
n_female <- nrow(females)
### Varianz ##
var_male <- var(males$leftright)
var_female <- var(females$leftright)
## Standardfehler ##
std_error <- sqrt((var_male/n_male) + (var_female/n_female))
std_error
# Variante 2: Alles in einem Schritt
selects |>
drop_na(leftright) |>
group_by(gender) |>
summarise(vars = var(leftright, na.rm =T),
counts = n(),
div = vars / counts) |>
summarise(se = sqrt(sum(div)))Der Standardfehler beläuft sich auf r round(std_error, 4)
18.5 Aufgabe 2c
Berechne nun die t-Statistik. Was schliesst du daraus?
mean_diff/std_errorMit über 6000 Freiheitsgraden (DF = N-1) entspricht der Schwellenwert des t-Wertes bei einem zweiseitigen t-Test \(\pm 1.96\). Mit einem Wert von r round((mean_diff/std_error),3) liegen wir deutlich darüber. Die Null-Hypothese wird verworfen. Die beiden Mittelwerte unterscheiden sich statistisch signifikant voneinander, d.h. der Unterschied, den wir finden, ist nicht zufällig, sondern systematisch.
18.6 Aufgabe 3a
Aus der Literatur wissen wir, dass Frauen im Durchschnitt oft eher linker eingestellt sind als Männer. Überprüfe nun, ob sich in der Schweiz ebenfalls ein solcher Unterschied finden lässt (wie in Aufgabe 2c), nutze dazu die t.test() Funktion.
# Variante 1
t.test(females$leftright, males$leftright)
# Variante 2
t.test(leftright ~ gender, data = selects) Wir sehen, dass der Befehl t.test() dieselben Werte liefert wie unsere manuellen Berechnungen aus Aufgabe 2
18.7 Aufgabe 3b
Berechne eine Regression bei der du als erklärende Faktoren für die Links-Rechts-Selbstpositionierung die Variable alter, gender verwendest. Füge mitglied_religiorg1 als dichotome erklärende Variable ebenfalls zum Modell hinzu. Interpretiere die Resultate des Regressionsmodells. Findest du Hinweise darauf, dass Personen, die Mitglied in einer religiösen Organisation sind, eher links oder eher rechts eingestellt sind?
table(selects$mitglied_religiorg, useNA="ifany")
# Wir recodieren mitglied_religiort zu einer dichotomen Variable
selects <- selects %>%
mutate(mitglied_religiorg = case_when(
mitglied_religiorg == 0 ~ "No",
mitglied_religiorg == 1 ~ "Yes",
TRUE ~ NA_character_
))
m1 <- lm(leftright ~ alter + gender + mitglied_religiorg, data = selects)
summary(m1)
# Vereinfachung Interpretation p-value (wissenschaftliche Schreibweise ausschalten)
format(2e-16, scientific = F)(Intercept): Eine neugeborene Frau, die kein Mitglied einer religiösen Organisation ist, hätte laut Modell einen vorhergesagten Wert vonr round(coef(m1)[1], 2)auf der Links-Rechts-Skala. Die Interpretation des Intercepts ist hier inhaltlich nicht sinnvoll (wir haben keine 0-jährige Person im Datensatz).alter: Mit jedem zusätzlichen Lebensjahr steigt die Rechts-Positionierung um durchschnittlichr round(coef(m1)[2], 2)Punkte. Dieser Zusammenhang ist statistisch signifikant. Dies lässt sich einerseits am t-Wert erkennen, welcher deutlich über dem, für ein Signifikanzniveau von 95% kritischen Wert von 1.96 zu liegen kommt. Andererseits gibt uns r an, dass der p-Wert für diesen Koeffizienten kleiner als 2e-16 ist, also kleiner alsr format(2e-16, scientific = F), was die Schwelle von 0.05 deutlich unterschreitet.gender: Männer positionieren sich im Durchschnittr round(coef(m1)[3], 2)Punkte weiter rechts als Frauen. Auch dieser Zusammenhang erreicht statistische Signifikanz.mitglied_religiorg: Der p-Wert des Koeffizientenschätzers beträgtr round(summary(m1)$coefficients[,4][4], 3). Die Wahrscheinlichkeit rein durch Zufall einen mindestens so grossen Koeffizienten zu beobachten, obwohl es in der Realität gar keinen Zusammenhang gibt, beträgt also rundr round(summary(m1)$coefficients[,4][4], 3)*100%. Das überschreitet die konventionelle Schwelle von 5% deutlich, weshalb wir schlussfolgern, dass der Koeffizient fürmitglied_religiorgnicht signifikant ist. Wir finden entsprechend keine Hinweise darauf, dass es einen Zusammenhang gibt zwischen der Mitgliedschaft in einer religiösen Organisation und der politischen Selbsteinschätzung einer Person.
Das Regressionsmodell basiert auf Querschnittsdaten. Da die Mitgliedschaft in einer religiösen Gruppierung nicht experimentell manipuliert wurde und es noch weitere Confounder gibt, welche nicht in das Modell aufgenommen wurden (bspw. Bildung), können wir die Ergebnisse nicht kausal interpretieren.
18.8 Aufgabe 3c
Wir erinnern uns, dass wir in Übung 5 auch einen nicht-linearen Zusammenhang zwischen leftright und alter angeschaut haben. Ergänze eine Interaktion von alter mit sich selber zum obigen Modell und teste, ob man das Alter im Quadrat ins Modell aufnehmen sollte.
m2 <- lm(leftright ~ alter + I(alter^2) + gender + mitglied_religiorg, data = selects)
summary(m2)Wir sehen, dass der Koeffizientenschätzer für alter^2 nicht signifikant ist. Es gibt also keine Hinweise darauf, dass man hier einen kurvlinearen Zusammenhang zwischen der Links-Rechts-Selbstpositionierung und dem Alter modellieren sollte. Wir sehen ebenfalls, dass die Varianz von \(\beta_{alter}\) viel grösser wurde. Das ist eine direkte Folge davon, dass wir mit alter^2 eine Variable ins Modell eingefügt haben, die stark mit alter korreliert.
18.9 Aufgabe 4 (herausfordernd)
Generiere mithilfe des untenstehenden Codes einen Datensatz.
Der Code erzeugt einen Datensatz mit 2000 Beobachtungen, welcher für diese Übung die Population/Grundgesamtheit bildet. Die Variable V1 agiert als unsere abhängige Variable und V2 als unsere unabhängige Variable. Mithilfe der Funktion sample_n() sollst du nun 100 Individuen zufällig aus dieser Population ziehen und damit eine lineare Regression rechnen. Speichere das obere und untere Ende des Konfidenzintervalles dieser Regression. Das Konfidenzintervall erhältst du mit der Funktion confint(). Nutze einen Loop und wiederhole den gesamten Prozess (Sample ziehen und Konfidenzintervall abspeichern) 1000 Mal.
Rechne anschliessend eine Regression mit der gesamten Population. Der resultierende Koeffizient dieser Regression ist somit unser unverzerrter wahrer Wert. Stelle deine Konfidenzintervalle diesem Wert gegenüber. Wie häufig war der wahre Wert nicht im Konfidenzintervall?
#Varianz-Kovarianz-Matrix
sigma <- rbind(c(1,-0.8), c(-0.8,1))
#Durchschnitt der Verteilung
mu <- c(10, 2)
set.seed(666)
df <- as.data.frame(mvrnorm(n=2000, mu=mu, Sigma=sigma))# Leere Vektoren erzeugen
coef <- rep(NA, 1000)
upper <- rep(NA, 1000)
lower <- rep(NA, 1000)
# Loop, der Sample zieht, Regression schätzt und Konfidenzintervall abspeichert.
for (i in 1:1000) {
df_sample <- sample_n(df, size = 100)
reg <- lm(V1 ~ V2, df_sample)
coef[i] <- reg$coefficients[2]
lower[i] <- confint(reg)[2,1]
upper[i] <- confint(reg)[2,2]
}
# Wahren Wert berechnen
full_model <- lm(V1 ~ V2, df)
# Wie häufig war wahrer Wert nicht im Konfidenzintervall?
n_not <- tibble(upper = upper,
lower = lower,
true_val = full_model$coefficients[2]) %>%
filter(upper < true_val | lower > true_val) %>%
nrow()
n_not
# Alternativer Code ohne dataframe
sum(upper < full_model$coefficients[2] | lower > full_model$coefficients[2])
# Illustration mittels plot
df_regs <- tibble(coef = coef,
lower = lower,
upper = upper,
ID = 1:1000) %>%
mutate(interval = case_when( # Die Variable "interval" benötigen wir für die
# Einfärbung der Intervalle in ggplot
upper < full_model$coefficients[2] ~ "Out",
lower > full_model$coefficients[2] ~ "Out",
T ~ "In"
))
ggplot(df_regs, aes(y = reorder(ID, coef),
x = coef,
xmin = lower,
xmax = upper,
color = interval))+
geom_vline(xintercept = full_model$coefficients[2],
linetype = "longdash",
color = "grey")+
geom_pointrange(alpha= 0.1)+
labs(y=NULL)+
scale_color_manual(values=c("dodgerblue", "darkred"))+
theme_classic()+
theme(axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
legend.position = "none")In gut 95% aller Regressionen (r 1000 - n_not von 1000) war der wahre Wert innerhalb des Konfidenzintervalls zu finden. Dies entspricht der durch den p-Wert = 0.05 festgelegten akzeptablen Fehlerquote. Somit liegen wir bei 1000 Schätzungen lediglich in rund 50 Fällen (in diesem Beispiel sind es genau 41) ausserhalb unseres angegebenen Unsicherheitsbereiches.
Kodierung mitglied_religiorg: 0 = No, 1 = Yes, 99 = unknown↩︎