---
title: "Tutorial 7"
author: "Lars Abt"
format: pdf
editor: visual
---

## Setup - Pakete laden

```{r}
pacman::p_load(data.table)
```

## Daten einlesen um Aufgaben zu bearbeiten

```{r}
# Überprüfen des Working Directories, um die Datei korrekt zu addressieren
getwd()

# Sie liegt in input, und wir befinden uns in code
# daher müssen wir zuerst eine Ebene hoch
data <- fread("../input/data.csv")

# Überblick über die Daten
head(data)
```

Wir laden unsere vorbereiteten Daten aus der Datei `data.csv`, die wir von der Website herunterladen können. Dort befinden sich Informationen zu Bildung (education), Leistungseinsaz (effort) und Gehalt (wage).

## Confounder

Definition (aus der Vorlesung):

*"Ein Confounder ist eine Variable, die sowohl mit der unabhängigen als auch der abhängigen Variable korreliert ist. Confounder können die Ergebnisse stark verzerren und sollten daher in der Analyse berücksichtigt werden."*

Unsere Hypothese: Die Leistungsbereitschaft erklärt sowohl das Gehalt einer Person, als auch das Bildungsniveau einer Person.
Alternativ kann man aber auch davon ausgehen, dass das Bildungsniveau das Gehalt einer Person erklärt/beeinflusst (was in der Realität mit Sicherheit der Fall ist), oder das Bildungsniveau die Leistungsbereitschaft beeinflusst, quasi eine Art Wissen vom Wert dieser Leistungsbereitschaft. Oder frühe Früchte einer höheren Leistungsbereitschaft. Gehalt kann tendenziell eher weniger als Treiber von Bildungsniveau gesehen werden, womöglich als Motivator für berufliche Weiterbildung, aber vielleicht motivieren sich manche Personen zu mehr Leistung, um ihr (hohes) Gehalt zu rechtfertigen, oder eine Gehaltserhöhung anzustreben.

```{r}
pairs(data, main = "Scatterplot Matrix of our Data")
```

```{r}
# Lineares Modell, wo wir den vermeintlichen Confounder (effort) nicht beachten:
model_no_confounder <- lm(wage ~ education, data = data)
summary(model_no_confounder)

# Lineares Modell, wo wir den vermeintlichen Confounder (effort) miteinbeziehen:
model_with_confounder <- lm(wage ~ education + effort, data = data)
summary(model_with_confounder)
```

Wenn wir unsere Summaries betrachten können wir sehen, dass im ersten Modell der Variable `educaction` sehr hohe Signifikanz zugeschrieben wird, obwohl sie eigentlich nicht direkt mit `wage` zusammenhängt. Erst wenn wir den Confounder, `effort`, miteinbeziehen, sehen wir, dass `education` nicht mehr signifikant ist. Jetzt simulieren wir noch einmal neue Daten, mit einem neuen Confouder (`education`). Es ist zu beachten, dass es sich hier um künstlich erzeugte Daten ohne reale Grundlage handelt, sodass wir über die tatsächliche Kausalität in der realen Welt keine Aussage treffen können und wollen. Es geht lediglich darum, dass wir die Konzepte verstehen.

```{r}
# Seed setzen um die Ergebnisse reproduzieren zu können
set.seed(34567)

# Anzahl der Datenpunkte festlegen
n <- 1000 

# Simulieren der Variable `education_new`
education_new <- 5  + rnorm(n, mean = 0, sd = 2)

# Simulaieren der Variable `effort_new` (Confounder), als Funktion unserer Variable `effort`
effort_new <- 2 * education_new + rnorm(n, mean = 0, sd = 2)

# Simulieren der Variable `wage`, welche durch effort beeinflusst wird, und dementsprechend auch mit education korreliert sein sollte (obwohl beide keine direkte Kausalität haben)
wage_new <- 10  +  2 * education_new + rnorm(n, mean = 0, sd = 5)

# Dataframe erstellen für unsere Daten
data_new <- data.frame(education_new, effort_new, wage_new)

# Summary unserer simulierten Daten ansehen
summary(data_new)

# Scatterplot ansehen, um die Korrelationen zu visualisieren
pairs(data_new, main = "Scatterplot Matrix of Adjusted Data")

# Lineares Modell, wo wir den Confounder (education) nicht beachten:
model_no_confounder_new <- lm(wage_new ~ effort_new, data = data_new)
summary(model_no_confounder_new)

# Lineares Modell, wo wir den Confounder (education) miteinbeziehen:
model_with_confounder_new <- lm(wage_new ~ effort_new + education_new, data = data_new)
summary(model_with_confounder_new)
```

Wir sehen also, dass wir den Confounder auch anders aufbauen können. Wichtig ist, dass wir genau hinschauen, wie korrelierte Konstrukte zusammenhängen und wie wir sie in unseren Modellen berücksichtigen. Es gilt die Phrase: *"Correlation does not imply causation*. (zu Deutsch: *"Korrelation impliziert keine Kausalität"*).

## Kausale Graphen

Hier möchten wir die Zusammenhänge zwischen den angesprochenen Punkten diskutieren.

-   Kriminalität und Anzahl der Kirchen könnten korrelieren, da große Städte/Siedlungen, welche bereits langer Zeit eine gewisse Größe haben, auch über einen gewissen Reichtum, eine gewisse wirtschaftliche Kraft verfügen. Dies macht sie attraktiv für kriminelle Vereinigungen, aber auch für große Religionsgemeinschaften.

-   Bewegung und Fitness können angetrieben werden durch einen gesunden Lebenstil. Wer einen gesunden Lebensstil pflegt, der bewegt sich viel, der versucht einen hohen Fitnesslevel zu halten, um sich seine Gesundheit möglichst lange zu erhalten. Nicht unbedingt ein Confounder, da viel Bewegung mit Sicherheit einen positven Einfluss auf die Fitness eines Menschen hat!

-   Bio-Lebensmittel und eine Autismus-Diagnose können mit Self-Care erklärt werden. Wer viel Wert auf seine Gesundheit legt, kauft sich eher die gesünderen, aber teureren Lebensmittel, um sich selbst etwas Gutes zu tun. Genauso werden mögliche anderweitige gesundheitliche Einschränkungen und Probleme frühzeitig abgeklärt, und bis zur eindeutigen Diagnose verfolgt, um idealen Umgang damit zu gewährleisten.

-   Sitzgurte und das Überleben bei Autounfällen können mit einem Sicherheitsbedürfnis erklärt werden. Menschen, welche keinen großen Wert auf Sicherheit legen, sehen wohl kaum die Notwendigkeit für Sitzgurte. Ebenso wird die Gefahr von schnellem Fahrem wohl von dieser Personengruppe besonders unterschätzt. Nichtsdestotroz haben Sitzgurte natürlich einen positiven Effekt auf die Überlebenschancen bei Autounfällen, da sie den Körper im Auto halten und somit Verletzungen durch das Herausschleudern verhindern.

## Kausale Effekte

```{r}
# Kausale Effekte an Hand von Beispieldaten anschauen
cities_df <- data.frame(
  city = c("Bielefeld", "Berlin", "Budapest", "Barcelona", "Bologna", "Bremen", "Bordeaux", "Brüssel"),
  unemployment_no_intervention = c(5.2, 6.3, 4.3, 8.1, 5.2, 4, 7.5, 3.4),
  unemployment_intervention = c(4.2, 5.3, 3.3, 7.1, 4.2, 3, 6.5, 2.4)
)

# Neue Spalte für den kausalen Effekt hinzufügen
cities_df$causal_effect <- cities_df$unemployment_intervention - cities_df$unemployment_no_intervention

# Mittelwert davon berechnen 
mean_causal_effect <- mean(cities_df$causal_effect)

# Test: Wert sollte exakt -1 sein
print(mean_causal_effect)
```

Wir sehen, dass der kausale Effekt, in unserem künstlichen Beispiel, exakt -1 beträgt. Das bedeutet, dass die Intervention in den Städten genau einen Prozentpunkt weniger Arbeitslosigkeit verursacht hat. Diese Beobachtung ist im echten Leben natürlich nicht in dieser Form machbar, da wir nur ein Bielefeld haben, und dort eine Intervention veranstalten können, oder eben nicht. Und keine zwei identischen Städte miteinander vergleichen können, wie bei einem Videospiel wo wir vom selben Speicherpunkt verschiedene Routen ausprobieren und die beste aussuchen können.

```{r}
# Seed setzen für Replizierbarkeit
set.seed(2345)
# nicht set.seed(8) verwenden

# Zufällige Anzahl an Treatments generieren
sample_amount <- sample(1:8 , 1)
sample_amount
nas_to_assign <- sample(1:8, sample_amount)
nas_to_assign

# NAs (Treatment vorhanden oder nicht) zuweisen
cities_df$unemployment_intervention[nas_to_assign] <- NA
cities_df$unemployment_no_intervention[!(1:8 %in% nas_to_assign)] <- NA

# Basierend darauf möchten wir jetzt erneut den kausalen Effekt berechnen
ate <- mean(cities_df$unemployment_intervention, na.rm = TRUE) - mean(cities_df$unemployment_no_intervention, na.rm = TRUE)
print(ate)
```

In diesem zufälligen Beispiel an Zuweisungen erhalten wir einen kausalen Effekt, der nicht exakt -1 ist. Das liegt daran, dass wir die NAs zufällig zugewiesen haben. In der Realität ist es natürlich nicht möglich, dass die Zuweisung von Interventionen zufällig erfolgt. In der Regel wird dies durch ein Experiment oder eine gezielte Zuweisung durchgeführt. Mit einer anderen Anzahl an NAs und einer anderen Zuweisung von diesen, erhalten wir immer wieder andere Ergebnisse, dementsprechend sind diese immer mit Vorsicht zu genießen. Zudem sehen wir, dass der kausale Effekt in meinem Beispiel mehr als doppelt so stark geschätzt wird, als er tatsächlich ist (da wir ihn im Vorfeld selbst definiert haben). Dies liegt nicht zuletzt an der sehr kleinen Stichprobe.

*Durch `set.seed(8)` werden sogar exakt 8 NAs generiert, was dazu führt, dass wir gar kein Treatment beobachten können. Gerne selbst einmal ausprobieren!*

```{r}
# Wir erstellen noch einmal unseren Dataframe, da wir ihn zuvor verändert habe
cities_df <- data.frame(
  city = c("Bielefeld", "Berlin", "Budapest", "Barcelona", "Bologna", "Bremen", "Bordeaux", "Brüssel"),
  unemployment_no_intervention = c(5.2, 6.3, 4.3, 8.1, 5.2, 4, 7.5, 3.4),
  unemployment_intervention = c(4.2, 5.3, 3.3, 7.1, 4.2, 3, 6.5, 2.4)
)

# Einträge mit einer Arbeitslosigkeit von mehr als 5%, wo wir als "perfekte Politiker" intervenieren möchten
cities_above_5 <- c(1,2,4,5,7)

# Intervention darauf basierend zuweisen
cities_df$unemployment_no_intervention[cities_above_5] <- NA
cities_df$unemployment_intervention[!(1:8 %in% cities_above_5)] <- NA

# Kausale Effekte, basierend auf dieser Zuordnung, berechnen
ate <- mean(cities_df$unemployment_intervention, na.rm = TRUE) - mean(cities_df$unemployment_no_intervention, na.rm = TRUE)
print(ate)
```

In diesem Beispiel erhalten wir nun einen Effekt von 1,56, also schätzen wir gar einen Anstieg der Arbeitslosigkeit als kausalen Effekt des Treatments. Dies ist nicht übereinstimmend mit der Realität, und lässt uns sehen, dass wir bei der Beurteilung von kausalen Effekten immer sehr vorsichtig sein müssen. Eine mögliche Lösung, um solche Schwierigkeiten zu umgehen, ist der *differences-in-differences*-Ansatz, den wir in der nächsten Übung näher untersuchen werden.

## Weitere Städte, künstliche Erweiterung des Datensatzes

```{r}
# Seed setzen für Replizierbarkeit
set.seed(26)

# Wir generieren mehr Städte, ich nenne sie A bis Z, mit Arbeitslosigkeit gestreut um 5%
additional_cities <- LETTERS[1:26]
additional_cities_df <- data.frame(
  city = additional_cities,
  unemployment_no_intervention = rnorm(26, mean = 5, sd = 1)
)

# Wir ordnen diesen Städten jetzt den Interventionswert -1 zu
additional_cities_df$unemployment_intervention <- additional_cities_df$unemployment_no_intervention - 1

# Und berechnen diesbezüglich wieder den kausalen Effekt, den wir bereits kennen
additional_cities_df$causal_effect <- additional_cities_df$unemployment_intervention - additional_cities_df$unemployment_no_intervention

# Test auf erfolgreiche Zuweisung des Effekts
mean_causal_effect <- mean(additional_cities_df$causal_effect)
print(mean_causal_effect)

# Wir weisen wieder zufällig NAs zu
sample_amount <- sample(1:26 , 1)
nas_to_assign <- sample(1:26, sample_amount)

# Und ordnen diese NAs wieder zu
additional_cities_df$unemployment_intervention[nas_to_assign] <- NA
additional_cities_df$unemployment_no_intervention[!(1:8 %in% nas_to_assign)] <- NA

# Und berechnen anschließend wieder unseren kausalen Effekt
ate <- mean(additional_cities_df$unemployment_intervention, na.rm = TRUE) - mean(additional_cities_df$unemployment_no_intervention, na.rm = TRUE)
print(ate)
```

Hier sehen wir jetzt einen kausalen Effekt von -0.3228017. Dieser ist auch ein ganzes Stück entfernt von unserem wahren Wert, jedoch scheint er, bei einer einmaligen Simulation, schon besser zu passen, als er es in unserer kleineren Stichprobe tat. Dies zeigt, dass größere Stichproben und mehr Daten uns helfen können, bessere Schätzungen zu erhalten.

## Bonus: Spurious Correlations

Die Website von Tyler Vigen ist eine fantastische Quelle für viele Korrelationen, welche keinen kausalen Zusammenhang aufweisen: https://tylervigen.com/spurious-correlations Hier findet ihr viele interessante Korrelationen, vielleicht findet ihr ja auch eine, die euch besonders überrascht, oder einen spannenden Fun-Fact für die nächste Party. Ich persönlich bin großer Fan der Scheidungsrate, welche hochgradig mit dem Margarine-Preis korreliert, oder die Scheidungsrate im Vereinigten Königreich, welche sehr stark mit der Veröffentlichungsrate von Disney Filmen korreliert!
