diff --git a/Module/Modul_01_KI.Rmd b/Module/Modul_01_KI.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..899a6603dc57478e560dcd54cd86947aedcb532a --- /dev/null +++ b/Module/Modul_01_KI.Rmd @@ -0,0 +1,365 @@ +--- +title: "Modul 01: An der Weggabelung: Einen Weg gehen – und einen nicht" +output: + learnr::tutorial: + language: + de: js/tutorial_de.json + progressive: true + css: "css/style.css" +runtime: shiny_prerendered +--- + +<a href="https://ki-campus.org/"> +<img border="0" alt="KICampusLogo" src="images/KIcampusLogo.png" width="100" height="30" style="float: right"> +</a> + +```{r setup, include=FALSE} +library(learnr) +library(mosaic) +library(tidyr) +library(knitr) +library(ggthemes) + +theme.fom <- theme_classic(22*1.04) +theme.fom <- theme.fom +theme_set( + theme.fom +) + +# deutsche Version von random_praise +source("random-praise_de/translation_random-praise_de.R") + + +# Daten simulieren +set.seed(1896) +n <- 10 + +Schulung <- tibble(finteresse = rnorm(n)) %>% + rowwise() %>% + mutate(pteilnahme = pnorm((finteresse+rnorm(1)))) %>% + mutate(teilnahme = sample(c("Ja", "Nein"), + size = 1, prob = c(pteilnahme, 1-pteilnahme))) %>% + mutate(gehalt0 = 2000 * (1 + pnorm((finteresse + rnorm(1)))/10)) %>% + mutate(gehalt1 = gehalt0 * (0.95 + rbeta(1,1,10))) %>% + mutate(across(where(is.numeric), ~ round(.x, -2))) %>% + mutate(effekt = gehalt1 - gehalt0) %>% + mutate(gehalt = case_when(teilnahme == "Ja" ~ gehalt1, + teilnahme == "Nein" ~ gehalt0)) %>% + ungroup() %>% + mutate(i=row_number()) %>% + select(i, teilnahme, gehalt0, gehalt1, effekt, gehalt) +``` + +## Lernziele + +In diesem Modul lernen Sie: + +- was ein **potenzielles Ergebnis (Potential Outcome)** ist; + +- was ein **Counterfactual** ist; + +- wie **kausale Effekte** definiert werden können; + +- warum die Bestimmung von kausalen Effekten so herausfordernd ist. + +## Individueller kausaler Effekt + +Stellen Sie sich folgende Situation vor: Am Ende Ihrer Ausbildungszeit wird Ihnen die Teilnahme an einer freiwilligen Schulung zum Thema Gehaltsverhandlungen angeboten. + +Würden Sie teilnehmen? + +Für Ihre Entscheidung ist vermutlich relevant, ob Sie davon ausgehen, dass die Teilnahme Ihr zukünftiges Gehalt tatsächlich verbessern wird. + +Wie würden Sie für sich diesen **individuellen kausalen Effekt** der Teilnahme an der Schulung auf Ihr Gehalt definieren, d. h., was *bringt* Ihnen die Schulung finanziell? + +*Denken Sie bitte kurz darüber nach und klicken Sie erst dann auf `Weiter`* + +## + +Eine mögliche Idee wäre es, einfach die Differenz des Gehaltes vor und nach der Schulung zu bilden: *Gehalt nach der Schulung minus Gehalt vor der Schulung*. +Hier ergibt sich aber ein Problem, denn es ist natürlich gut möglich, dass unabhängig von der Schulung Ihr Gehalt mit der Zeit angestiegen wäre. + +(Eine ganz ähnliche Situation ergibt sich, wenn man zum Beispiel rausfinden möchte, ob ein bestimmtes Medikament gegen eine Krankheit hilft: Einige Erkrankungen werden von alleine mit der Zeit besser und es wäre ein Fehler, diese Verbesserung spezifischen Maßnahmen zuzuschreiben. Daher spielen Kontrollgruppen in klinischen Studien eine so zentrale Rolle.) + + +Eine andere Möglichkeit ist es, diesen Effekt als + +$$\text{Gehalt mit Schulung} - \text{Gehalt ohne Schulung} $$ + +zu definieren. + +Wenn Sie vor der Entscheidung stehen: *Nehme ich an der Schulung teil?* gibt es für Ihr Gehalt zwei **potenzielle Ergebnisse (englisch: Potential Outcomes)**: + +- <blue> Gehalt </blue> ohne <green> Schulung </green>: $\color{blue}{Y}^{\color{green}{X=0}}$ + +- <blue> Gehalt </blue> mit <green> Schulung </green>: $\color{blue}{Y}^{\color{green}{X=1}}$ + +$\color{blue}{Y}$ ist die *Wirkung*, das Ergebnis, also hier das <blue> Gehalt </blue>. Das hochgestellte $\color{green}{X}$ soll symbolisieren für welche Wert der *Ursache* das Ergebnis betrachtet wird. Ohne <green> Schulung </green> nimmt $\color{green}{X}$ den Wert 0 an, mit <green> Schulung </green> den Wert 1. + +{width="65%"} + +## + +Der **individuelle kausale Effekt** $\color{orange}{\Delta}_i$ (griechisch: Delta) der Schulung ergibt sich dann als die Differenz zwischen diesen beiden potenziellen Ergebnissen: + +$$\color{orange}{\Delta}_i = \color{blue}{Y}^{\color{green}{X=1}}_i - \color{blue}{Y}^{\color{green}{X=0}}_i$$ + +Wobei + +- $i$ für die einzelne Beobachtung, hier die einzelne Person, steht; + +- $\color{blue}{Y}_i$ für das <blue> Gehalt </blue> von $i$; + +- $\color{green}{X}$ für die Teilnahme an der <green> Schulung</green>; dabei ist $\color{green}{X_i=1}$ wenn $i$ teilnimmt und $\color{green}{X_i=0}$ wenn $i$ nicht teilnimmt. + + +## Ein fiktives Beispiel + +Schauen wir uns einmal eine fiktive Gehaltstabelle mit potenziellen Ergebnissen an: + +- `i`: Nummer der Person; + +- `gehalt1`: $\color{blue}{Y}^{\color{green}{X=1}}$, Gehalt mit Schulung; + +- `gehalt0`: $\color{blue}{Y}^{\color{green}{X=0}}$, Gehalt ohne Schulung. + +```{r gehaltstabelle, echo=FALSE} +Schulung %>% + select(i, gehalt1, gehalt0) %>% + kable() +``` + + +Der individuelle kausale Effekt $\color{orange}{\Delta}_i$ lässt sich dann innerhalb der Datentabelle `Schulung` berechnen als `gehalt1 - gehalt0` (hier in `R`): + +*** + +*Anmerkung:* `R` ist eine freie Software für die Datenanalyse. Sie kann von der Seite [https://cran.r-project.org/](https://cran.r-project.org/) für gängige Betriebssysteme heruntergeladen werden. Ergänzend ist die Nutzung des `RStudio Desktop` empfehlenswert ([https://www.rstudio.com/products/rstudio/download/](https://www.rstudio.com/products/rstudio/download/)). Im Rahmen dieser Module wird außerdem u.a. das Paket `mosaic` ([https://cran.r-project.org/package=mosaic)](https://cran.r-project.org/package=mosaic)) verwendet. + +*** + + +```{r} +# Paket laden +library(mosaic) +# Datentabelle Schulung um neue Variable "effekt" ergänzen +Schulung <- Schulung %>% + mutate(effekt = gehalt1 - gehalt0) +``` + +Und damit: + +```{r gehaltstabelleeffekt, echo=FALSE} +Schulung %>% + select(i, gehalt1, gehalt0, effekt) %>% + kable() +``` + +```{r visualisierung, echo=FALSE} +Schulung_Long <- Schulung %>% + select(i, gehalt0, gehalt1) %>% + pivot_longer(c(gehalt0, gehalt1), values_to = "Gehalt", names_to = "Schulung") %>% + mutate(Schulung = ifelse(Schulung == "gehalt0", "0: Nein", "1: Ja")) + +gf_point(Gehalt ~ Schulung, data = Schulung_Long, + position = "jitter", width = 0.01, height = 0, + color = ~ Schulung, + show.legend = FALSE) %>% + gf_line(Gehalt ~ Schulung, group = ~ i, + color = "blue", alpha = 0.25) + + scale_color_colorblind() +``` + + +```{r ike, echo=FALSE} +question("Können Sie diese individuellen kausalen Effekte in der Realität beobachten?", + answer("Ja"), + answer("Nein", correct = TRUE, message = "Für jede Beobachtung $i$ liegt nur ein Gehaltswert vor: der mit Schulung oder der ohne Schulung, aber niemals beide gleichzeitig, da Personen entweder teilnehmen oder nicht. $\\Delta_i$ kann daher nicht beobachtet werden."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +Sie sehen: häufig sind die individuellen kausalen Effekte positiv – sie können aber auch neutral oder sogar negativ sein. + +## Das fundamentale Problem der kausalen Inferenz + +Das fundamentale Problem der kausalen Inferenz ist, dass wir den individuellen kausalen Effekt $\color{orange}{\Delta}_i = \color{blue}{Y}^{\color{green}{X=1}}_i - \color{blue}{Y}^{\color{green}{X=0}}_i$ **nicht** beobachten können. Es liegt je Beobachtung $i$ immer nur eines der beiden Potential Outcomes vor: Entweder $\color{blue}{Y}^{\color{green}{X=1}}$ (<blue>Gehalt</blue> mit <green>Schulung</green>) **oder** $\color{blue}{Y}^{\color{green}{X=0}}$ (<blue>Gehalt</blue> ohne <green>Schulung</green>). + +- Wenn Person $i$ an der Schulung teilnimmt, liegt uns das Gehalt mit Schulung vor, $\color{blue}{Y}^{\color{green}{X=1}}_i$, und nicht $\color{blue}{Y}^{\color{green}{X=0}}_i$ + +- Wenn Person $i$ nicht an der Schulung teilnimmt, liegt uns das Gehalt ohne Schulung vor, $\color{blue}{Y}^{\color{green}{X=0}}_i$, und nicht $\color{blue}{Y}^{\color{green}{X=1}}_i$ + +Der Wert, der nicht beobachtet wird, wird jeweils als **Counterfactual** bezeichnet; er ist kontrafaktisch in dem Sinne, dass er in der Realität nicht vorliegt. + +Für jemanden, der nicht an der Schulung teilgenommen hat, ist das Counterfactual die Antwort auf die Frage: *Wie hoch wäre mein Gehalt, wenn ich an der Schulung teilgenommen hätte?* Für jemanden der teilgenommen hat, ist das Counterfactual die Antwort auf die Frage: *Wie hoch wäre mein Gehalt, wenn ich nicht an der Schulung teilgenommen hätte?* + +```{r cf, echo=FALSE} +question("Kann das Counterfactual beobachtet werden?", + answer("Ja", message = "Je Beobachtung $i$ liegt nur ein Wert vor: der mit Schulung oder der ohne Schulung, nicht beide gleichzeitig. Das Counterfactual ist das nicht beobachtete der Potential Outcomes."), + answer("Nein", correct = TRUE, message = "Das Counterfactual ist das nicht Beobachtete der Potential Outcomes."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +```{r cfi, echo=FALSE} +question("Person $i$ nimmt an der Schulung teil. Was ist dann das Counterfactual?", + answer("$\\color{blue}{Y}^{\\color{green}{X=0}}_i$", correct = TRUE, message = "Teilnahme an der Schulung bedeutet $X=1$, d. h. für das Counterfactual $X=0$."), + answer("$\\color{blue}{Y}^{\\color{green}{X=1}}_i$"), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + + +## Durchschnittlicher kausaler Effekt + +Mal angenommen, wir würden die individuellen kausalen Effekte $\color{orange}{\Delta}_i$ aber doch kennen (Variable `effekt` in unserem `R`-Beispiel). +Dann könnten wir aus ihnen weitere Größen ableiten, beispielsweise den *durchschnittlichen* kausalen Effekt $\bar{\color{orange}{\Delta}}$, indem wir alle $i$ individuellen kausalen Effekte addieren und diese Summe ($\sum$) durch die Anzahl der Beobachtungen ($n$) dividieren: + +$$\bar{\color{orange}{\Delta}}=\frac{\sum_{i=1}^n \color{orange}{\Delta}_i}{n}=\frac{\sum_{i=1}^n(\color{blue}{Y}^{\color{green}{X=1}}_i - \color{blue}{Y}^{\color{green}{X=0}}_i)}{n} =\frac{\sum_{i=1}^n\color{blue}{Y}^{\color{green}{X=1}}_i - \sum_{i=1}^n\color{blue}{Y}^{\color{green}{X=0}}_i}{n}=\overline{\color{blue}{Y}}^{\color{green}{X=1}}-\overline{\color{blue}{Y}}^{\color{green}{X=0}}.$$ + +Die `R`-Funktion, die diesen arithmetischen Mittelwert berechnet, lautet `mean()`. + +Klicken Sie auf `Ausführen`, um den durchschnittlichen kausalen Effekt in unserem fiktiven Beispiel zu berechnen, in dem beide Potential Outcomes vorliegen. + +```{r ate, exercise=TRUE} +mean( ~ effekt, data = Schulung) +``` + + +*** + +*Anmerkung:* In `mosaic` ist die `R` Syntax vereinheitlicht: + +```{r mosaic1, eval=FALSE} +analyse(y ~ x, data = Daten) +``` + +Analysiere die Variable `y` in Abhängigkeit der Variable `x` aus der Datentabelle `Daten`. Welche Funktion `analyse()` zur Anwendung kommt, hängt vom Ziel unser Analyse ab. + +Sollte es, wie im vorliegenden Fall, nur eine Variable geben, die zusammengefasst werden soll, kann auch kurz geschrieben werden: + +```{r mosaic2, eval=FALSE} +analyse( ~ y, data = Daten) +``` + +*** + +Beachten Sie: Der durchschnittliche kausale Effekt ist positiv, auf Individualebene kann er aber auch negativ sein. $\bar{\color{orange}{\Delta}}$ ist eine aggegierte Datenzusammenfassung. + +## + +Das fundamentale Problem der kausalen Inferenz ist, dass nur eines der Potential Outcomes vorliegt und das nicht vorliegende ein Counterfactual ist. Daher kennen wir in der Praxis weder den individuellen noch den durchschnittlichen kausalen Effekt. Letzterer liegt in unserem Beispiel bei + + +$$\bar{\color{orange}{\Delta}}=\frac{\sum_{i=1}^n \color{orange}{\Delta}_i}{n}=`r mean(~ effekt, data = Schulung)`.$$ + +## Fehlende Werte + +In der Praxis kennen wir zwar nicht beide Potential Outcomes, aber wir wissen innerhalb einer Beobachtungsgruppe, wer an der Schulung teilgenommen hat und wer nicht. Daraus ergibt sich, welches der beiden Potential Outcomes beobachtet ist und welches uns fehlt (das Counterfactual). + +In der Praxis sähe unsere fiktive Gehaltstabelle also anders aus -- fehlende Werte werden in `R` als `NA` (engl.: not available, nicht verfügbar) dargestellt. + +```{r teilnahme, echo=FALSE} +Schulung %>% + select(i, teilnahme, gehalt0, gehalt1) %>% + mutate(gehalt0 = ifelse(teilnahme=="Ja", NA, gehalt0)) %>% + mutate(gehalt1 = ifelse(teilnahme=="Nein", NA, gehalt1)) %>% + kable() +``` + +In der Regel strukturiert man die Daten so, dass nur eine Gehaltsvariable -- das beobachtete `gehalt` -- sowie eine Variable zur `teilnahme` existiert. + +```{r gehalt, echo=FALSE} +Schulung %>% + select(i, teilnahme, gehalt) %>% + kable() +``` + +```{r bias, echo=FALSE} +question("Die Teilnahme an der Schulung war freiwillig. Können Sie davon ausgehen, dass, unabhängig von der Schulung, Teilnehmende und Nichtteilehmende ein ähnliches erstes Gehalt haben würden?", + answer("Ja"), + answer("Nein", correct = TRUE, message = "Teilnehmende und Nichtteilnehmende könnten sich in vielerlei Hinsicht unterscheiden. Um nur ein Beispiel zu nennen: Personen, denen ihr Gehalt besonders wichtig ist, werden eher an der Schulung teilnehmen. Diese Personen werden aber vielleicht auch ohne Schulung anders in Gehaltsverhandlungen auftreten."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## Schätzung des kausalen Effektes + +Anhand der tatsächlich beobachteten Daten können wir zwei Durchschnittsgehälter berechnen: Das Durchschnittsgehalt derjenigen, die teilgenommen haben, und das Durchschnittsgehalt derjenigen, die nicht teilgenommen haben. + +```{r gehaltteilnahme} +mean(gehalt ~ teilnahme, data = Schulung) +``` + +- $\bar{\color{blue}{y}}^{\color{green}{x=1}} = `r round(mean(gehalt ~ teilnahme, data = Schulung)[1],2)`$ + +- $\bar{\color{blue}{y}}^{\color{green}{x=0}} = `r round(mean(gehalt ~ teilnahme, data = Schulung)[2],2)`$ + +*** + +*Anmerkung*: + +```{r pseudo, eval=FALSE} +mean(gehalt ~ teilnahme, data = Schulung) +``` + +Bedeutet aus `R mosaic` *übersetzt*: + +Berechne den arithmetischen Mittelwert (Funktion `mean()`) der Variable `gehalt` ($y$) in Abhängigkeit der Variable `teilnahme` ($x$). Die dazugehörigen Daten sind in der Datentabelle `Schulung`. + +*** + +Nun könnte man versuchen, den durchschnittlichen kausalen Effekt mithilfe dieser beobachteten Werte zu schätzen: + +$$\bar{\color{blue}{y}}^{\color{green}{x=1}} - \bar{\color{blue}{y}}^{\color{green}{x=0}} = `r round(mean(gehalt ~ teilnahme, data = Schulung)[1],2)` - `r round(mean(gehalt ~ teilnahme, data = Schulung)[2],2)` = `r round(-diffmean(gehalt ~ teilnahme, data = Schulung),2)`$$ + +Dieser Wert weicht aber substanziell vom wahren durchschnittlichen kausalen Effekt ab, den wir zuvor mithilfe der Potential Outcomes berechnet hatten: $\bar{\color{orange}{\Delta}} =`r round(mean(~ effekt, data = Schulung),2)`$. +Bei dieser Abweichung handelt es sich um eine systematische Verzerrung, die auch als **Bias** bezeichnet wird. + + +Der naive Vergleich der Mittelwerte überschätzt hier den wahren durchschnittlichen Effekt. In unserem fiktiven Beispiel liegt das daran, dass Personen mit einem höherem Gehaltsinteresse eher an der Schulung teilgenommen haben als die mit einem niedrigeren Interesse. + +Erstere hätten aber so oder so, also unabhängig von der Schulung, ein höheres Gehalt erhalten. Hier sind unterschiedliche inhaltliche Erklärungen denkbar (z.B. ein höheres Interesse am Gehalt und damit auch ein anderes Auftreten in Gehaltsverhandlungen). + +Kontrollieren Sie diese Aussage, indem Sie den Code so abändern, dass Sie die Mittelwerte der Potential Outcomes berechnen. Diese befinden sich im gleichen Datensatz und tragen die Namen `gehalt0` und `gehalt1`: + +*Tipp*: Einen Lösungshinweis erhalten Sie über den `Hinweise`-Button über dem R Code. Anschließend `Nächster Tipp` und Sie sehen die Lösung. + +```{r po, exercise = TRUE} +mean(gehalt ~ teilnahme, data = Schulung) +``` + +```{r po-solution} +cat("Potential Outcomes: Durchschnittliches Gehalt ohne Teilnahme:\n") +cat("Für die, die teilnehmen ('Ja') das Counterfactual.\n") +mean(gehalt0 ~ teilnahme, data = Schulung) +cat("Potential Outcomes: Durchschnittliches Gehalt mit Teilnahme:\n") +cat("Für die, die nicht teilnehmen ('Nein') das Counterfactual.\n") +mean(gehalt1 ~ teilnahme, data = Schulung) +``` + +```{r po-hint} +"gehalt0 bzw. gehalt1 sind die Variablennamen. Ändern Sie die Variable gehalt entsprechend." +``` + + +## + +Das fundamentale Problem der kausalen Inferenz ist universell. In vielen Situationen kann es dazu führen, dass die Daten uns in die Irre führen: Vielleicht vermuten wir einen kausalen Effekt wo es nicht wirklich einen gibt, oder wir erkennen real existierende Effekte nicht. + +Die Gefahr solcher Fehlschlüsse verringert sich aber, wenn wir uns darüber Gedanken machen, wie unsere Daten überhaupt entstanden sind. In unserem fiktiven Beispiel kann man die zusätzliche Information heranziehen, dass Personen sich frei auswählen konnten, ob sie teilnehmen oder nicht. Dann erkennt man schnell, dass der naive Mittelwertvergleich kein angemessener Weg ist, den durchschnittlichen kausalen Effekt zu schätzen. + +In den folgenden Modulen werden Sie verschiedene datengenerierende Mechanismen kennenlernen und erfahren, wie diese kausale Schlüsse beeinflussen. + +## KI-Campus + +[Zurück zum Kurs](https://learn.ki-campus.org/courses/7c8012d9-8729-4462-9ad0-be7d71118f37/launch) + diff --git a/Module/Modul_02_KI.Rmd b/Module/Modul_02_KI.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..0a9404bd2b3cacab4a49c646ca2033272e01cddd --- /dev/null +++ b/Module/Modul_02_KI.Rmd @@ -0,0 +1,446 @@ +--- +title: "Modul 02: Ein Pfeil zeigt die Richtung" +output: + learnr::tutorial: + language: + de: js/tutorial_de.json + progressive: true + css: "css/style.css" +runtime: shiny_prerendered +--- + +<a href="https://ki-campus.org/"> +<img border="0" alt="KICampusLogo" src="images/KIcampusLogo.png" width="100" height="30" style="float: right"> +</a> + +```{r setup, include=FALSE} +library(learnr) +library(knitr) +library(ggplot2) +library(dplyr) +library(tidyr) +library(emojifont) +library(openintro) + +theme.fom <- theme_classic(22*1.04) +theme.fom <- theme.fom +theme_set( + theme.fom +) + +# deutsche Version von random_praise +source("random-praise_de/translation_random-praise_de.R") + + +library(ggdag) + +# DAG, ohne Fehlerterm +co <- data.frame(x=c(0,1), y=c(0,0), name=c("X", "Y")) +DAG1 <- dagify(Y~ X, + coords = co) %>% + ggdag() + + geom_dag_point(colour = c("#0F710B", "#0000FF")) + + geom_dag_text(size = 8) + + theme_dag_blank() + + geom_dag_edges(arrow_directed = grid::arrow(length = grid::unit(15, "pt"), type = "closed")) + + geom_text(label = "X - Tablette\nY - Schmerzrückgang", + hjust = 1, vjust = 2, + x = 1, y = 0, size = 7, color = "darkgrey") + +# Beispiel rutschige Straße +co <- data.frame(x = c(0,1,1,2,4), y = c(0.5,0,1,0.5,0.5), name = c("JZ", "RE", "WS","NA","RU")) +DAG_Str <- dagify(WS ~ JZ, + RE ~ JZ, + NA ~ RE, + NA ~ WS, + RU ~ NA, + coords = co) %>% + ggdag() + + geom_dag_point(colour = "#301a87") + + geom_dag_text(size = 5) + + theme_dag_blank() + + geom_dag_edges(arrow_directed = grid::arrow(length = grid::unit(15, "pt"), type = "closed")) + + geom_text(label = "JZ - Jahreszeit\nRE - Regen\nWS - Wassersprenger\nNA - Nass\nRU - Rutschig", + hjust = 1, vjust = 1, + x = 4, y = 1, size = 5, color = "darkgrey") + +# DAG 2, mit Fehlerterm +co <- data.frame(x=c(0,1,0,1), y=c(0,0,1,1), name=c("X", "Y", "U_X", "U_Y")) +DAG2 <- dagify(Y~ X, + X ~ U_X, + Y ~ U_Y, + coords = co) %>% + ggdag() + + geom_dag_point(colour = c( "darkgrey", "darkgrey","#0F710B", "#0000FF")) + + geom_dag_text(size = 5) + + theme_dag_blank() + + geom_dag_edges(arrow_directed = grid::arrow(length = grid::unit(15, "pt"), type = "closed")) + + geom_text(label = "X - Tablette\nY - Schmerzrückgang", + hjust = 1, vjust = 2, + x = 1, y = 0, size = 7, color = "darkgrey") + +# Funktionen für Beispiel + +U_X <- function() sample(c("Ja", "Nein"),1) +f_Y <- function(x) ifelse(x == "Ja", sample(c("Ja", "Nein"), 1, prob = c(0.8,0.2)), sample(c("Ja", "Nein"), 1, prob = c(0.4,0.6))) + +# Verteilung Beispiel +d <- crossing(x = 1:10, + y = 1:10) %>% + mutate(tablette = c(rep("Ja",50), rep("Nein", 50)), + heilung = c(rep(fontawesome('fa-check'), 50 * 0.8), + rep(fontawesome('fa-close'), 50 * 0.2), + rep(fontawesome('fa-check'), 50 * 0.4), + rep(fontawesome('fa-close'), 50 * 0.6))) + +pd <- ggplot(d, aes(x = x, y = y, color = tablette)) + + geom_tile(color = "white", size = .5, aes(fill = tablette), alpha = .2) + + theme_void() + + geom_text(family='fontawesome-webfont', size = 8, aes(label = heilung)) + + scale_color_manual(values = c("#0F710B", "grey80"), + name = "") + + scale_fill_manual( values = c("#0F710B", "grey80")) + + theme(legend.position = "none") + + labs(title = "Schmerzrückgang") + + guides(guide = "none") + + annotate(geom="text", x=3, y=5.5, label="Tablette genommen", + color="black", size = 10) + + annotate(geom="text", x=8, y=5.5, label="Tablette nicht genommen", + color="black", size = 10) + +``` + +## Lernziele + +In diesem Modul lernen Sie: + +- was unter Ursache und Wirkung verstanden werden kann; + +- die Grundlagen von kausalen Graphen: was ein Pfeil aussagt; + +- was Eltern und Kinder sind; + +- was unter einem Kausalen Modell verstanden werden kann; + +- den Unterschied zwischen Beobachten und Handeln im Kontext kausaler Inferenz. + + +## Ursache und Wirkung + +Seit Urzeiten machen Menschen sich Gedanken über Ursache und Wirkung. Nicht nur in der Philosophie, sondern auch ganz praktisch, im täglichen Leben: + +- Wenn ich die Tablette nehme, gehen die Schmerzen dann weg? + +- Führt Werbung zu mehr Umsatz? + +- Lohnt es sich finanziell, an einer Fortbildung teilzunehmen? + +Dabei können wir entweder die Tablette nehmen – oder nicht; die Schmerzen können weggehen, oder nicht. Unternehmen können den Werbeetat erhöhen oder verringern; der Umsatz kann um beliebige Beträge steigen oder sinken. Sie nehmen an der Fortbildung teil oder nicht; Ihr Gehalt kann steigen – oder (leider) nicht. + +Hier können also unterschiedliche Werte vorliegen, beispielsweise Ja oder Nein (z.B. Einnahme von Tabletten, Schmerzrückgang) oder $0$ € oder $1000$ € (z.B. Umsatzänderung, Gehaltsanstieg). + +Diese Werte können mit unterschiedlichen *Wahrscheinlichkeiten* auftreten, welche mit $Pr$ abgekürzt werden (englisch für probability, Wahrscheinlichkeit). $Pr(\text{Tablette})$ bezeichnet also die Wahrscheinlichkeit, dass von einer Person eine Tablette genommen wird, $Pr(\text{Schmerzrückgang})$ die Wahrscheinlichkeit, dass die Schmerzen zurückgehen. + + +```{r ursache, echo=FALSE} +question("Angenommen durch die Einnahme einer Tablette gehen die Schmerzen weg. Wie würden Sie hier Ursache und Wirkung zuordnen?", + answer("Die Einnahme der Tablette ist die Ursache, der Schmerzrückgang die Wirkung.", correct = TRUE, message = "Die Tablette wurde zuerst eingenommen, danach folgte der Schmerzrückgang."), + answer("Der Schmerzrückgang ist die Ursache, die Einnahme der Tablette die Wirkung."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## Tablette und Schmerzrückgang + +<!-- Quelle: https://github.com/TabeaG/Uebungsheft-Apps/blob/master/EinfuehrungWkeitInferenz/02_EinfuehrungWkeitInferenz.Rmd --> + +<span style="font-size: 13px; font-weight: bold; margin-top: 20px;"> +Schauen wir mal, ob die Tablette hilft! +</span> + +<img src="images/Pillen.jpg" alt="Pillenpackung" width="50%" height="50%"> +<!-- style="padding-left:50px;" --> +<span style="font-size: 10px;"><br> +Quelle: [https://pixabay.com/illustrations/jar-pills-medicine-bottle-2338584/](https://pixabay.com/illustrations/jar-pills-medicine-bottle-2338584/) +</span> + +<span style="font-size: 13px; font-weight: bold; margin-top: 20px;"> +Nehmen Sie die Tablette? <br> </span> +<span style="font-size: 13px; "> +Klicken Sie einen der Buttons. Versuchen Sie es ruhig mehrmals! +</span> + +```{r, context="render", echo=FALSE} +actionButton("Tablette", "Tablette nehmen", class="btn action-button", style="color: #FFF; background-color: #301a87; border-color: #301a87; order-radius: 10px; border-width: 2px") +``` +```{r, context="render", echo=FALSE} +actionButton("kTablette", "Tablette nicht nehmen", class="btn action-button", style="color: #FFF; background-color: #301a87; border-color: #301a87; order-radius: 10px; border-width: 2px") +``` + + +```{r, context="render", echo=FALSE} +htmlOutput("ergebnis") +``` + +```{r, context="server"} +values <- reactiveValues() +values$text <- "" +values$versuch <- 0 + +p.tablette <- observeEvent(input$Tablette, { + values$versuch <- values$versuch + 1 + heilung <- sample(c("Ja", "Nein"), 1, prob = c(0.8,0.2)) + ergebnis <- ifelse(heilung == "Ja", paste0("<span style='color: green'>", values$versuch, ". Versuch: </span> Sie haben die Tablette genommen und die Schmerzen sind zurückgegangen!"), paste0("<span style='color: green'>", values$versuch, ". Versuch: </span> Sie haben die Tablette genommen und die Schmerzen sind leider nicht zurückgegangen!")) + +output$ergebnis <- renderText({ + ergebnis + }) + +}) +p.ktablette <- observeEvent(input$kTablette, { + values$versuch <- values$versuch + 1 + heilung <- sample(c("Ja", "Nein"), 1, prob = c(0.4,0.6)) + ergebnis <- ifelse(heilung == "Ja", paste0("<span style='color: green'>", values$versuch, ". Versuch: </span> Sie haben die Tablette nicht genommen und die Schmerzen sind trotzdem zurückgegangen!"), paste0("<span style='color: green'>", values$versuch, ". Versuch: </span> Sie haben die Tablette nicht genommen und die Schmerzen sind leider auch nicht zurückgegangen!")) + +output$ergebnis <- renderText({ + ergebnis + }) + +}) +``` + +<br> + + +## + +Auf einer abstrakteren Ebene können die untersuchten Eigenschaften von oben als *Variablen* aufgefasst werden, also z. B. + +- $X$: Tabletteneinnahme Ja oder Nein. + +- $Y$: Schmerzrückgang Ja oder Nein. + +Die sogenannte *Verteilung* der Variablen beschreibt die Wahrscheinlichkeit, mit der die jeweiligen Werte auftreten. + +Eine Variable $X$ heißt hier **Ursache** von $Y$, wenn der Wert der **Wirkung** $Y$ von $X$ verändert wird, also wenn $Y$ von $X$ abhängt. + +Wenn Sie eben mehrfach die Tablette genommen haben – oder nicht genommen haben – dann konnten Sie beobachten, dass die Tablette häufig zu einer Schmerzreduktion führte, aber nicht immer. Und manchmal sind die Schmerzen zurückgegangen, obwohl Sie keine Tablette genommen haben. Die (hinterlegten) Wahrscheinlichkeiten dabei waren: + +- $Pr(\text{Schmerzrückgang, wenn Tablette eingenommen})=0.8=80\%$<br> + und damit: + $Pr(\text{Kein Schmerzrückgang, wenn Tablette eingenommen})=1-0.8=0.2=20\%$ + +- $Pr(\text{Schmerzrückgang, wenn keine Tablette eingenommen})=0.4=40\%$ <br> + und damit: + $Pr(\text{Kein Schmerzrückgang, wenn keine Tablette eingenommen})=1-0.4=0.6=60\%$ + +Als Wahrscheinlichkeitsbaum dargestellt, wobei wir annehmen, dass die Hälfte der Personen eine Tablette nimmt: + +```{r baum1, echo=FALSE, fig.align='center', out.width='80%'} +treeDiag(c("Tabletteneinnahme?","Schmerzrückgang?"), + c(0.5,0.5), + list(c(0.8,0.2), + c(0.4,0.6)), + c("Ja", "Nein"), + c("Ja","Nein"), + showSol = FALSE) +``` + + +## Kausales Diagramm + +Man könnte auch sagen, dass die Verteilung von $Y$ (Schmerzrückgang) auf $X$ (Tabletteneinnahme) *hört*. Dieser Umstand lässt sich auch graphisch darstellen: + +```{r DAG1, echo=FALSE, fig.align='center', out.width='60%'} +plot(DAG1) +``` + +In einem solchen **Graphen** sind die Variablen <green> Tabletteneinnahme </green> und <blue> Schmerzrückgang </blue> die sog. **Knoten**. Der **Pfeil** $\rightarrow$ zwischen $\color{green}{X}$ und $\color{blue}{Y}$ ist eine sogenannte gerichtete **Kante** und stellt die kausale Abhängigkeit dar. + +$\color{green}{X} \rightarrow \color{blue}{Y}$ bedeutet aber auch, dass der Wert von $\color{green}{X}$ nicht kausal vom Wert von $\color{blue}{Y}$ abhängt. Ein möglicher <blue> Schmerzrückgang </blue> ändert nicht rückwirkend die <green> Tabletteneinnahme </green>: $$\color{green}{\text{Tabletteneinnahme}} \not\leftarrow \color{blue}{\text{Schmerzrückgang}}.$$ + +<br> + +<img src="images/LichtSchalter.jpg" alt="Lichtschalter" width="50%" height="50%"> +<!-- style="padding-left:50px;" --> +<span style="font-size: 10px;"><br> +Quelle: [https://pixabay.com/illustrations/switch-lightbulb-idea-inspiration-4539115/](Quelle: https://pixabay.com/illustrations/switch-lightbulb-idea-inspiration-4539115/) +</span> + +```{r modell, echo=FALSE} +question("Welches kausale Diagramm beschreibt den Zusammenhang zwischen Lichtschalter und Glühlampe?", + answer("$\\text{Glühlampe} \\rightarrow \\text{Lichtschalter}$"), + answer("$\\text{Lichtschalter} \\rightarrow \\text{Glühlampe}$", correct = TRUE, message = "Lichtschalter an oder aus ist die Ursache für die Wirkung, ob die Glühlampe an oder aus ist. Bei kaputter Leitung oder Lampe ist diese nicht an, obwohl der Schalter an ist. Aber ohne Rückkopplung geht der Schalter nicht aus, wenn die Lampe aufgrund eines Schadens nicht an ist."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## Kinder und Eltern + +Manche glauben ja, dass Kinder auf Ihre Eltern hören. Das schöne an abstrakten, gedanklichen Welten ist, dass das dort realisiert werden kann. + +Variablen (Knoten), auf die eine Pfeilspitze zeigt, werden **Kinder** derjenigen Variablen genannt, von welchen die Pfeile ausgehen. Diese Variablen werden entsprechend **Eltern** genannt: $\text{Eltern} \rightarrow \text{Kinder}$. Im Beispiel von oben ist <blue> Schmerzrückgang </blue> ein Kind von <green> Tabletteneinnahme </green> – und dementsprechend <green> Tabletteneinnahme </green> Eltern von <blue> Schmerzrückgang</blue>. In kausalen Graphen höre Kinder also auf ihre Eltern. + +Ein Beispiel für ein kausales Diagramm welches beschreibt, wie eine Straße rutschig werden kann. Die Wahrscheinlichkeit von Regen hängt ab von der Jahreszeit. Die Jahreszeit beeinflusst aber auch, ob ein Wassersprenger zum Einsatz kommt. Sowohl Regen als auch Wassersprenger führen dazu, dass die Straße nass wird. Ist die Straße nass, kann es rutschig werden: + +```{r DAG_Str, echo=FALSE, fig.align='center', out.width='85%'} +plot(DAG_Str) +``` + +Quelle: [Mohan und Pearl (2012)](https://ftp.cs.ucla.edu/pub/stat_ser/uai12-mohan-pearl.pdf) + +```{r eltern, echo=FALSE} +question("Welche Variable ist bzw. welche Variablen sind Eltern von *Nass* (NA)?", + answer("Keine."), + answer("Jahreszeit (JZ)."), + answer("Wassersprenger (WS) und Regen (RE).", correct = TRUE, message = "Nass hängt ab von Wassersprenger und Regen."), + answer("Rutschig (RU)."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +```{r kinder, echo=FALSE} +question("Welche Variable ist bzw. welche Variablen sind Kinder von *Nass* (NA)?", + answer("Keine."), + answer("Jahreszeit (JZ)."), + answer("Wassersprenger (WS) und Regen (RE)."), + answer("Rutschig (RU).", correct = TRUE , message = "Rutschig hängt ab von Nass."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## Kausale Modelle + +Das **kausale Modell** des simplen Graphen $\color{green}{X} \rightarrow \color{blue}{Y}$ besteht aus zwei Zuweisungen: + +- $\color{green}{X} = U_{\color{green}{X}}$ +- $\color{blue}{Y} = f_{\color{blue}{Y}}(\color{green}{X},U_{\color{blue}{Y}})$ + +Dabei sind $U_{\color{green}{X}}$ und $U_{\color{blue}{Y}}$ unbekannte Ursachen (in der Statistik häufig auch Rest genannt, engl.: error) von $\color{green}{X}$ und $\color{blue}{Y}$, und $f_{\color{blue}{Y}}(\color{green}{X},U_{\color{blue}{Y}})$ die Funktion, der Mechanismus, durch den $\color{blue}{Y}$ auf Basis von $\color{green}{X},U_{\color{blue}{Y}}$ zu seinem Wert kommt. + +Im Beispiel +$$\color{green}{\text{Tabletteneinnahme}} \rightarrow \color{blue}{\text{Schmerzrückgang}}$$ +beinhaltet $U_{\color{green}{\text{Tabletteneinnahme}}}$ die unbekannten, vielleicht zufälligen Gründe, die zur Entscheidung führen, ob bei Schmerzen eine Tablette genommen wird oder nicht, und $U_{\color{blue}{\text{Schmerzrückgang}}}$ die unbekannten, vielleicht zufälligen Gründe, die den Schmerzrückgang mit oder ohne Tabletteneinahme zusätzlich beschreiben. + +Wir gehen an dieser Stelle davon aus, dass $U_{\color{green}{X}}$ und $U_{\color{blue}{Y}}$ unabhängig voneinander sind. + +Diese sogenannten Fehler könnten in den Graphen mit aufgenommen werden, werden aber häufig aus Gründen der Übersichtlichkeit weggelassen. + +```{r DAG2, echo=FALSE, fig.align='center', out.width='60%'} +plot(DAG2) +``` + + +Angenommen, Sie werfen eine Münze (`ux()`), ob Sie die Tablette nehmen oder nicht, und es gilt für den Schmerzrückgang (`fy()`): + +- $Pr(\text{Schmerzrückgang, wenn Tablette eingenommen})=0.8$ + +- $Pr(\text{Kein Schmerzrückgang, wenn Tablette eingenommen})=1-0.8=0.2$ + +- $Pr(\text{Schmerzrückgang, wenn keine Tablette eingenommen})=0.4$ + +- $Pr(\text{Kein Schmerzrückgang, wenn keine Tablette eingenommen})=1-0.4=0.6$ + +Simulieren Sie diesen Fall mehrfach über `Ausführen` und beobachten Sie, welche Werte die beiden Variablen annehmen: + +```{r sim, exercise=TRUE} +x <- U_X() +cat("Tabletteneinnahme? ", x, "\n") +y <- f_Y(x) +cat("Schmerzrückgang? ", y, "\n") +``` + +```{r sim-hint} +# Hier der R Code der zugrundeliegenden Funktionen: +U_X <- function() sample(c("Ja", "Nein"),1) + +f_Y <- function(x) ifelse(x == "Ja", + sample(c("Ja", "Nein"), 1, prob = c(0.8, 0.2)), + sample(c("Ja", "Nein"), 1, prob = c(0.4, 0.6))) +``` + + +## Beobachtung + +Wenn $100$ Menschen eine Münze werfen, ob sie die Tablette einnehmen oder nicht, erwarten wir im Mittelwert, dass $50$ von Ihnen die Tablette nehmen (grün hinterlegt) und von diesen $50 \times 0.8 = 40$ eine Schmerzreduktion erfahren (<i class="fa fa-check" aria-hidden="true"></i>) und die anderen $50-40=10$ nicht (<i class="fa fa-close" aria-hidden="true"></i>). Von den $50$ ohne Tabletteneinnahme (grau hinterlegt) erfahren $50 \times 0.4 = 20$ eine Schmerzreduktion (<i class="fa fa-check" aria-hidden="true"></i>) und die anderen $50-20=30$ nicht (<i class="fa fa-close" aria-hidden="true"></i>): + +```{r pd, echo=FALSE, fig.align='center', out.width='85%'} +plot(pd) +``` + +Insgesamt erwarten wir im Mittelwert, dass bei $40 + 20 = 60$ von $100$ Personen eine Verbesserung eintrifft, wenn $U_{\color{green}{\text{Tabletteneinnahme}}}$ zufällig Ja oder Nein ist und $Pr(\color{green}{\text{Tabletteneinnahme}})=0.5$ ist. Wir **beobachten** nur, welchen Wert unsere Ursache $\color{green}{X}$ annimmt. + +```{r handeln, echo=FALSE} +question("Was passiert, wenn wir **intervenieren**, d. h., die Tabletteneinnahme ist nicht zufällig, sondern wir legen fest, dass alle die Tablette einnehmen müssen?", + answer("Die Anzahl der Menschen mit Schmerzreduktion ändert sich nicht."), + answer("Die Anzahl der Menschen mit Schmerzreduktion erhöht sich.", correct = TRUE, message = "Durch die Intervention gilt nicht mehr $Pr(\\color{green}{\\text{Tabletteneinnahme}})=0.5$ sondern $Pr(\\color{green}{\\text{Tabletteneinnahme}})=1$. Und da die Tablette in $80\\%$ der Fälle hilft, erwarten wir im Mittelwert eine Verbesserung bei $100 \\times 0.8 = 80$ von $100$ Personen."), + answer("Die Anzahl der Menschen mit Schmerzreduktion reduziert sich."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## Interventionen + +Bei einer **Intervention** handeln wir und greifen ein. Im kausalen Modell gilt nicht mehr: + +$$\color{green}{X} = U_{\color{green}{X}}$$ +sondern zum Beispiel, wenn wir dafür sorgen, dass alle die Tablette nehmen: + +$$\color{green}{X} = 1$$ + +mit $\color{green}{X} = \cases{1: \quad \text{Tablette wird eingenommen} \\ 0: \quad \text{Tablette wird nicht eingeommen}}$. + +Um den Unterschied zwischen Beobachtung und Intervention auch formal darzustellen, wird für eine Intervention ein eigener Operator verwendet: $do(\cdot)$ (englisch: to do sth., etwas machen). Wenn wir die Tabletteneinnahme *erzwingen*, kann dies durch $do(\color{green}{X} = 1)$ dargestellt werden. + +```{r do0, echo=FALSE} +question("Welche Darstellung beschreibt die Intervention, die dazu führt, dass keine Tablette genommen wird?", + answer("$do(\\color{green}{X} = 0)$", correct = TRUE, message = "$do(\\cdot)$ zeigt die Handlung, $\\color{green}{X} = 0$ symbolisiert keine Tabletteneinnahme."), + answer("$do(\\color{green}{X} = 1)$"), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## Umgedrehte Kausalität + +Wenn die angenommene Ursache in Wirklichkeit die Wirkung ist, und umgekehrt die Wirkung in Wirklichkeit die Ursache, haben wir das Problem der **Umgedrehten Kausalität**. Wir vermuten $A \rightarrow B$, aber in Wirklichkeit gilt $B \rightarrow A$. + +Die Unterscheidung zwischen Ursache und Wirkung erfolgt hier aus inhaltlichen, theoretischen Überlegungen. Dabei können z.B. zeitliche Überlegungen helfen (die Ursache erfolgt vor der Wirkung), aber insbesondere auch Experimente (siehe Modul 8). Beides ist auch Bestandteil der [Bradford-Hill-Kriterien](https://journals.sagepub.com/doi/pdf/10.1177/003591576505800503) für Kausalität: + +- Stärke: Eine Beziehung ist eher kausal, wenn der Zusammenhang groß (z. B. hohe Korrelation) und statistisch signifikant ist. +- Konsistenz: Eine Beziehung ist eher kausal, wenn sie wiederholt bestätigt werden kann. +- Spezifität: Eine Beziehung ist eher kausal, wenn es keine andere Erklärung gibt. +- Zeitlichkeit: Eine Beziehung ist eher kausal, wenn die Wirkung nach der Ursache auftritt. +- Gradient: Eine Beziehung ist eher kausal, wenn ein größerer Wert in der Ursache zu einem größeren Wert in der Wirkung führt. +- Plausibilität: Eine Beziehung ist eher kausal, wenn es einen inhaltlich plausiblen Mechanismus zwischen Ursache und Wirkung gibt. +- Kohärenz: Eine Beziehung ist eher kausal, wenn sie mit bekannten Fakten und Theorien vereinbar ist. +- Experiment: Eine Beziehung ist eher kausal, wenn sie experimentell verifiziert werden kann. +- Analogie: Eine Beziehung ist eher kausal, wenn es nachgewiesene Beziehungen zwischen ähnlichen Ursachen und Wirkungen gibt. + +## Ausblick + +Kausale Inferenz hilft die Unterschiede in den Verteilungen der Wirkung $\color{blue}{Y}$ zu untersuchen, je nachdem ob $\color{green}{X}$ beobachtet wurde – oder der Wert durch eine Handlung festgelegt wird ($do(\color{green}{X})$). + +Diese *Kausale Leiter* ist Teil des folgenden Moduls 3. + +<img src="images/Leiter.png" alt="Lichtschalter" width="50%" height="50%"> +<!-- style="padding-left:50px;" --> +<span style="font-size: 10px;"><br> +Quelle: [https://pixabay.com/vectors/good-girls-cloud-star-ladder-2204244/](Quelle: https://pixabay.com/vectors/good-girls-cloud-star-ladder-2204244/) +</span> + +## KI-Campus + +[Zurück zum Kurs](https://learn.ki-campus.org/courses/7c8012d9-8729-4462-9ad0-be7d71118f37/launch) + diff --git a/Module/Modul_03_KI.Rmd b/Module/Modul_03_KI.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..e872556b66e26415a16b92d632ca2028fcc893ec --- /dev/null +++ b/Module/Modul_03_KI.Rmd @@ -0,0 +1,206 @@ +--- +title: "Modul 03: Daten analysieren - mit welchem Ziel?" +output: + learnr::tutorial: + language: + de: js/tutorial_de.json + progressive: true + css: "css/style.css" +runtime: shiny_prerendered +--- + +<a href="https://ki-campus.org/"> +<img border="0" alt="KICampusLogo" src="images/KIcampusLogo.png" width="100" height="30" style="float: right"> +</a> + +```{r setup, include=FALSE} +library(learnr) +library(knitr) +library(ggplot2) +library(dplyr) +library(tidyr) +library(emojifont) + +theme.fom <- theme_classic(22*1.04) +theme.fom <- theme.fom +theme_set( + theme.fom +) + +# deutsche Version von random_praise +source("random-praise_de/translation_random-praise_de.R") + + +library(ggdag) +# DAG +co <- data.frame(x=c(0,1,2), y=c(0,0,0), name=c("X", "Z", "Y")) +DAG_Chain <- dagify(Z ~ X, + Y ~ Z, + coords = co) %>% + ggdag() + + geom_dag_point(colour = c("#0F710B", "#DA70D6", "#0000FF")) + + geom_dag_text(size = 8) + + theme_dag_blank() + + geom_dag_edges(arrow_directed = grid::arrow(length = grid::unit(15, "pt"), type = "closed")) + + geom_text(label = "X - Lernen\nZ - Wissen\nY - Verstehen", + hjust = 1, vjust = 2, + x = 2, y = 0, size = 7, color = "darkgrey") + +f_Z <- function(x) 5*x+rnorm(length(x)) +f_Y <- function(z) 3*z+rnorm(length(z)) + +# Daten und Funktion +set.seed(1896) +n <- 1000 +SimData <- tibble(x = rnorm(n)) %>% + mutate(z = f_Z(x)) %>% + mutate(y = f_Y(z)) +``` + +## Lernziele + +In diesem Modul lernen Sie: + +- zwischen Beschreibung, Vorhersage und Kausaler Inferenz zu unterscheiden; + +- warum diese Unterscheidung wichtig ist und + +- was die Kausale Leiter ist. + +## Data Literacy + +In der [Data-Literacy-Charta](https://www.stifterverband.org/charta-data-literacy) steht über **Data Literacy**: + +> Data Literacy umfasst die Fähigkeiten, Daten auf kritische Art und Weise zu sammeln, zu managen, zu bewerten und anzuwenden. Wenn Daten Entscheidungsprozesse unterstützen sollen, braucht es kompetente Antworten auf vier grundlegende Fragen: +- Was will ich mit Daten machen? +- Was kann ich mit Daten machen? +- Was darf ich mit Daten machen? +- Was soll ich mit Daten machen? + +In diesem Modul behandeln wir die Frage: ***Was will ich mich mit Daten machen?*** Welches Ziel verfolge ich mit der Datenanalyse? Nutze ich die Daten um ein Phänomen zu beschreiben? Oder nutze ich die Daten um etwas vorherzusagen? Geht es am Ende um kausale Inferenz? Je nach Ziel der Datenanalyse sind unterschiedliche Methoden angemessen. + +Die folgenden Beispiele stammen aus [Hernán et al. (2019)](https://doi.org/10.1080/09332480.2019.1579578). + +## Beschreibung + +Häufig werden Daten genutzt mit dem Ziel, ein Phänomen zu beschreiben. Ein Beispiel im Gesundheitswesen: + +:::{.box} +Wie können Frauen mit Schlaganfall im Alter von 60 bis 80 Jahren charakterisiert und gruppiert werden? +::: + +Um zum Beispiel zu untersuchen, wie hoch der Anteil der Raucherinnen in dieser Gruppe ist, lassen sich graphische Verfahren nutzen (z.B. simple Balkendiagramme); statistische Kennzahlen (z.B. Prozentsatz der Raucherinnen); je nach Fragestellung und Datenbasis auch Verfahren der Inferenzstatistik (p‑Werte, Konfidenzintervalle, Bayes-Statistik). + +Aber auch Verfahren wie Clusteranalyse oder Hauptkomponentenanalyse können hier verwendet werden, um die Gruppe genauer zu charakterisieren. + +```{r beschreibung, echo=FALSE} +question("Führen solche Datenanalysen automatisch zu einer korrekten Beschreibungen des zu untersuchenden Phänomens?", + answer("Ja"), + answer("Nein", correct = TRUE, message = "Daten sind in der Regel nur ein Teil der komplexen und dynamischen Realität. Beispielsweise könnten die Daten mit Messfehler behaftet sein, wenn beispielsweise das Rauchverhalten in der Vergangenheit nicht korrekt erinnert oder berichtet wird. Auch nicht-repräsentative Stichproben können ein Problem sein, wenn zum Beispiel gerade gesundheitsbewusste Frauen eher an Erhebungen teilnehmen. Weiterhin können fehlende Werte zu verzerrte Ergebnissen führen, wenn beispielsweise bestimmte Frauen auf einige der Fragen die Antwort verweigern. Auch bei der reinen Beschreibung können also Daten in die Irre führen, und wir müssen uns Gedanken darüber machen, wie die Daten entstanden sind. Mehr dazu lernen Sie in Modul 6 im Interview mit Richard McElreath."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## Vorhersage + +Ein weiteres Ziel der Datenanalyse kann die Vorhersage sein: + +:::{.box} +Wie hoch ist die Wahrscheinlichkeit, dass eine Frau mit bestimmten Eigenschaften im nächsten Jahr einen Schlaganfall erleidet? +::: + +Es gibt also ein konkretes Ereignis, das auf Basis anderer Eigenschaften vorhergesagt werden soll. +Viele Verfahren der künstlichen Intelligenz und des maschinellen Lernens versuchen diese Aufgabe zu lösen. +Gebräuchliche Verfahren sind hier Regressionsverfahren, aber auch künstliche neuronale Netze kommen zur Anwendung. +Eine solche Vorhersage ist häufig Bestandteil Algorithmischer Entscheidungssysteme. + +*** + +*Anmerkung*: Dies beinhaltet besondere ethische Verantwortung. Siehe dazu u. a. den KI-Campus Kurs [Daten- und Algorithmenethik](https://ki-campus.org/courses/daethik2020). + +*** + +Abstrakt geht es darum, den Wert einer Zielvariable $\color{blue}{Y}$ (hier: Schlaganfall ja oder nein) auf Basis von vorliegenden Daten anderer Variablen $\color{green}{X}$ (hier z. B. Rauchverhalten, aber auch Medikamenteneinnahme) zu modellieren ($\color{blue}{Y} = f(\color{green}{X})$). +Das so geschätzte Modell kann dann genutzt werden, um Werte von $\color{blue}{Y}$ vorherzusagen. + +Üben wir die Übertragung anhand eines anderen Beispiels: + +```{r vorhersage, echo=FALSE} +question("Ein Unternehmen möchte anhand der vorhandenen Daten diejenigen Kund:innen ermitteln, von denen es vermutet, dass diese sich für ein neues Angebot des Unternehmens interessieren. Handelt es sich hier um eine Datenanwendung mit dem Ziel der Vorhersage?", + answer("Ja", correct = TRUE, message = "Hier wird auf Basis der im Unternehmen vorhandenen Information über den Kunden (*bestimmte Eigenschaften*) eine Wahrscheinlichkeit ermittelt, dass die Kundin das Produkt erwirbt. Kund:innen mit einer hohen Wahrscheinlichkeit können dann z. B. angeschrieben werden."), + answer("Nein"), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## Kausale Inferenz + +In den Anwendungen "Beschreibung" und "Vorhersage" wurden die Daten zunächst *nur* beobachtet. +Es erfolgt also keine Intervention, selbst wenn im nächsten Schritt die Vorhersage als Grundlage für konkrete Handlungen genutzt wird. + +In der kausalen Inferenz interessieren uns hingegen die Folgen von (hypothetischen) Interventionen. + +Eine Fragestellung der kausalen Inferenz lautet: + +:::{.box} +Kann die Gabe von cholesterinsenkenden Medikamenten das durchschnittliche Risiko eines Schlaganfalls bei Frauen mit bestimmten Eigenschaften reduzieren? +::: + +Grundlegende Überlegungen und Verfahren, die helfen können, solche Fragen zu beantworten, lernen Sie im Rahmen dieses Kurses. + + +## Beschreibung, Vorhersage oder kausale Inferenz? + +Zur Wiederholung noch eine Übung im anderen Kontext: + +```{r anwendung, echo=FALSE} +question("Im Rahmen des Kundenbeziehungsmangements ist Kundenabwanderung ein wichtiges Thema. Was ist das Ziel der Datenanwendung bei der Fragestellung: *Welche Kund:innen hatten in der Vergangenheit eine hohe Abwanderungsrate?*", + answer("Beschreibung", correct = TRUE, message = "Auf Basis der vorhandenen Daten werden die abgewanderten Kund:innen beschrieben. Beispiel siehe [Bojinov et al. (2020)](https://hdsr.mitpress.mit.edu/pub/wjhth9tr/release/1)"), + answer("Vorhersage"), + answer("Kausale Inferenz"), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## Kausale Leiter + +Neben dieser Unterscheidung zwischen den Analysezielen Beschreibung, Vorhersage und kausale Inferenz unterscheidet [Judea Pearl](https://doi.org/10.1145/3241036) zwischen 3 Stufen der kausalen Modellierung, die Sie bereits im Interview mit Stephan Poppe kennengelernt haben und die wir im weitern Verlauf weiter vertiefen werden: + +1. **Assoziation**: $Pr(y|x)$ – Beobachtung: *Was ist*? Wie wahrscheinlich ist $Y=y$, wenn ich $X=x$ beobachte? + +2. **Intervention**: $Pr(y|do(x))$ – Tun: *Was wäre*? Wie wahrscheinlich ist $Y=y$, wenn ich $X=x$ setze, d.h. manipuliere? + +3. **Counterfactuals**: $Pr(y_x|x',y')$ – Vorstellung: *Was wäre gewesen*? Wir haben $X=x'$ und als Folge $Y=y'$ beobachtet. Wie wahrscheinlich ist dann $Y=y$, wenn ich $X=x$ gesetzt hätte? (Mehr dazu in Modul 9) + + +Die Stufe 1, Assoziation, ist relevant für die Analyseziele Beschreibung und Vorhersage. +(In Modul 8 werden Sie mehr darüber erfahren, wie sich Beschreibung und Vorhersage in ihren Anforderungen an die Daten unterscheiden.) +Bei den Stufen 2 und 3 befinden wir uns bereits bei dem Analyseziel Kausale Inferenz. + +*** + +*Anmerkung*: $Pr(y|x)$ ist das Symbol für die bedingte Wahrscheinlichkeit (englisch: *Pr*obability) für $y$ gegeben $x$. Dies ist die Wahrscheinlichkeit für $y$, wenn $x$ eingetreten ist. +Diese unterscheidet sich i.d.R. von der unbedingten Wahrscheinlichkeit $Pr(y)$. + +*** + +```{r do, echo=FALSE} +question("Sind die Wahrscheinlichkeiten für $y$ bei Assoziation $Pr(y|x)$ und Intervention $Pr(y|do(x))$ immer identisch?", + answer("Ja"), + answer("Nein", correct = TRUE, message = "Ein simples Beispiel: Die Wahrscheinlichkeit, dass jemand gesund ist ($y$), der eine Schwimmbrille hat ($x$), ist relativ hoch (Assoziation, z.B. 70% der Schwimmbrillenbesitzer*innen sind gesund). Aber eine Intervention, bei der wir Personen Schwimmbrillen schenken (Intervention, $do(x)$), würde nicht dazu führen, dass 70% der Personen gesund sind. Lied dazu: [Monty Harper: Correlation Does Not Imply Causation](https://www.causeweb.org/cause/resources/fun/songs/correlation-does-not-imply-causation)"), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## KI-Campus + +[Zurück zum Kurs](https://learn.ki-campus.org/courses/7c8012d9-8729-4462-9ad0-be7d71118f37/launch) + diff --git a/Module/Modul_04_KI.Rmd b/Module/Modul_04_KI.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..a933957815c25251f309c3b29895edaeabca29b3 --- /dev/null +++ b/Module/Modul_04_KI.Rmd @@ -0,0 +1,385 @@ +--- +title: "Modul 04: Es steht was zwischen uns" +output: + learnr::tutorial: + language: + de: js/tutorial_de.json + progressive: true + css: "css/style.css" +runtime: shiny_prerendered +--- + +<a href="https://ki-campus.org/"> +<img border="0" alt="KICampusLogo" src="images/KIcampusLogo.png" width="100" height="30" style="float: right"> +</a> + +```{r setup, include=FALSE} +library(learnr) +library(knitr) +library(ggplot2) +library(dplyr) +library(tidyr) +library(emojifont) + +theme.fom <- theme_classic(22*1.04) +theme.fom <- theme.fom +theme_set( + theme.fom +) + +# deutsche Version von random_praise +source("random-praise_de/translation_random-praise_de.R") + + +library(ggdag) +# DAG +co <- data.frame(x=c(0,1,2), y=c(0,0,0), name=c("X", "Z", "Y")) +DAG_Chain <- dagify(Z ~ X, + Y ~ Z, + coords = co) %>% + ggdag() + + geom_dag_point(colour = c("#0F710B", "#DA70D6", "#0000FF")) + + geom_dag_text(size = 8) + + theme_dag_blank() + + geom_dag_edges(arrow_directed = grid::arrow(length = grid::unit(15, "pt"), type = "closed")) + + geom_text(label = "X - Lernen\nZ - Wissen\nY - Verstehen", + hjust = 1, vjust = 2, + x = 2, y = 0, size = 7, color = "darkgrey") + + +library(mosaic) + +U_X <- function(n = 1) runif(n, min = 1, max = 10) +f_Z <- function(x) 5*x + rnorm(length(x)) +f_Y <- function(z) 3*z + rnorm(length(z)) + +# Daten und Funktion +set.seed(1992) +n <- 100 +SimData <- tibble(x = U_X(n)) %>% + mutate(z = f_Z(x)) %>% + mutate(y = f_Y(z)) + +# Ergebnisse +ModellA <- lm(y ~ x, data = SimData) +``` + +## Lernziele + +In diesem Modul lernen Sie: + +- was eine kausale Kette ist; + +- was ein Mediator ist; + +- dass es manchmal besser ist, bestimmte Variablen in der Analyse nicht zu berücksichtigen. + +## Eins führt zum anderen + +Auch komplexe kausale Diagramme bestehen aus relativ einfachen Grundelementen. Eines davon ist die sog. **Kette** (engl.: chain). + +Zur Erinnerung: Der kausale Fluss folgt den Pfeilen. $$A \rightarrow B$$ sagt aus, dass $B$ auf $A$ *hört*. Im Modul zwei: Wenn es regenet, ($A$), wird die Straße nass ($B$). + +Bei einer Kette kommt einfach eine dritte Variable dazu: $$A \rightarrow B \rightarrow C.$$ +Zum Beispiel: wenn es regenet, ($A$) wird die Straße nass ($B$) und es wird rutschig ($C$). + + +## Lernen und Verstehen + +Das folgende Beispiel ist fiktiv – und eine sehr starke Vereinfachung. Außerdem wird die wichtige Frage, wie die Variablen jeweils gemessen werden, nicht behandelt. + +*** + +*Anmerkung*: Siehe hierzu z. B. "Welche Information steckt in Daten?" aus dem KI-Campus Kurs [Stadt | Land | DatenFluss](https://ki-campus.org/datenfluss). + +*** + +Angenommen, <green>Lernen</green> ($\color{green}{X}$) führt zu <violet>Wissen</violet> ($\color{violet}{Z}$), d. h., durch Lernen erwerben Sie Wissen. Außerdem führt <violet>Wissen</violet> ($\color{violet}{Z}$) zu <blue>Verstehen</blue> ($\color{blue}{Y}$), d. h., über Ihr Wissen kommen Sie zum Verstehen. + +Wenn dieses stark vereinfachte Modell stimmt, dann lässt sich diese Annahme in einem kausalen Diagramm darstellen: + +```{r DAG_Chain, echo=FALSE, fig.align='center', out.width='85%'} +plot(DAG_Chain) +``` + +## + +Das strukturelle kausale Modell besteht aus folgenden Zuweisungen: + +\begin{eqnarray*} +\color{green}{X} &=& U_{\color{green}{X}}\\ +\color{violet}{Z} &=& f_{\color{violet}{Z}}(\color{green}{X}, U_{\color{violet}{Z}})\\ +\color{blue}{Y} &=& f_{\color{blue}{Y}}(\color{violet}{Z},U_{\color{blue}{Y}}). +\end{eqnarray*} + +Der Wert von <green>Lernen</green> ($\color{green}{X}$) kommt außerhalb des Modells zu Stande ($U_{\color{green}{X}}$). Der Wert von <violet>Wissen</violet> ($\color{violet}{Z}$) hängt ab vom Wert von <green>Lernen</green> ($\color{green}{X}$) – und weiteren Faktoren ($U_{\color{violet}{Z}}$). Letzlich hängt <blue>Verstehen</blue> ($\color{blue}{Y}$) von <violet>Wissen</violet> ($\color{violet}{Z}$) ab – und $U_{\color{blue}{Y}}$. Hier machen wir wieder die (zugegebenermaßen unrealistische) Annahme, dass die zufälligen Einflüsse $U_{\color{green}{X}}, U_{\color{violet}{Z}}, U_{\color{blue}{Y}}$ voneinander unabhängig sind. + +```{r kind, echo=FALSE} +question("In der Sprache der Diagramme: Ist Verstehen ($Y$) ein Kind von Lernen ($X$)?", + answer("Ja"), + answer("Nein", correct = TRUE, message = "Verstehen ist ein Kind von Wissen ($Z$). Wissen ist wiederum ein Kind von Lernen. Damit ist Verstehen kein Kind von Lernen, aber ein Nachkomme. Verstehen *hört* unmittelbar nur auf Wissen, d. h., der Wert von Verstehen hängt direkt nur von Wissen ab."), + allow_retry = TRUE, + correct = "Prima, Richtig!", + incorrect = "Leider falsch. Vielleicht schauen Sie noch einmal im Modul 2 nach." + ) +``` + +## Mediator + +In Fällen wie diesen: $$\color{green}{X} \rightarrow \color{violet}{Z} \rightarrow \color{blue}{Y}$$ wird die Variable in der Mitte – hier $\color{violet}{Z}$ – **Mediator** genannt. + +```{r mediator, echo=FALSE} +question("Angenommen eine Beförderung hängt diskriminierenderweise ab vom Geschlecht der Kandidat:in und das Gehalt wiederum von der Beförderung. Welche Variable ist hier ein Mediator?", + answer("Geschlecht"), + answer("Beförderung", correct = TRUE, message = "Das beschriebene Kausalmodell lautet $\\text{Geschlecht} \\rightarrow \\text{Beförderung} \\rightarrow \\text{Gehalt}$."), + answer("Gehalt", message = "Das beschriebene Kausalmodell lautet $\\text{Geschlecht} \\rightarrow \\text{Beförderung} \\rightarrow \\text{Gehalt}$."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +Um den kausalen Effekt der Ursache ($\color{green}{X}$) auf die Wirkung ($\color{blue}{Y}$) zu untersuchen, müssen wir den Wert des Mediators ($\color{violet}{Z}$) nicht kennen. Wenn wir also zum Beispiel wissen wollen, wie sich das <green>Geschlechts</green> insgesamt auf das <blue>Gehalt</blue> auswirkt, brauchen wir keine Informationen über <violet>Beförderungen</violet>. + +Tatsächlich kann sogar die Berücksichtigung des Mediators dazu führen, dass der kausale Effekt verzerrt wird. Das werden wir im Folgenden mithilfe einer Simulation genauer betrachten. + +*** + +*Anmerkung*: Im Kontext von Mediation wird zwischen *totalen*, *direkten* und *indirekten* Effekte unterscheiden. Im Beispiel interessiert uns der gesamte Effekt von Geschlecht, der totale Effekt. + +Würde uns stattdessen interessieren, inwiefern Geschlecht unabhängig von Beförderung einen Effekt auf das Gehalt hat, so wäre das Analyseziel der direkte Effekt. Und wenn uns interessieren würde, inwiefern die Effekte des Geschlechts über Beförderungen vermittelt würden, so wäre das Analyseziel der indirekte Effekt. + +*** + + +## Simulierte Daten + +Zurück zum Zusammenhang von Lernen, Wissen und Verstehen. +In `R` sind Simulationen für das Modell + +\begin{eqnarray*} +\color{green}{X} &=& U_{\color{green}{X}}\\ +\color{violet}{Z} &=& f_{\color{violet}{Z}}(\color{green}{X}, U_{\color{violet}{Z}})\\ +\color{blue}{Y} &=& f_{\color{blue}{Y}}(\color{violet}{Z},U_{\color{blue}{Y}}). +\end{eqnarray*} + +hinterlegt. + +Zur Erinnerung (siehe auch Modul 2), $U$ bezeichnet jeweils unbekannte Ursachen; $f$ die Funktionen, anhand derer den Variablen Werte zugewiesen werden. + +Simulieren Sie Beobachtungen in dem Sie mehrfach auf `Ausführen` klicken und versuchen Sie zu erkennen, wie die Variablen miteinander zusammenhängen: + +```{r sim, exercise=TRUE} +x <- U_X() +cat("Wert x (Lernen):", x, "\n") +z <- f_Z(x) +cat("Wert z (Wissen):", z, "\n") +y <- f_Y(z) +cat("Wert y (Verstehen):", y, "\n") +``` + +```{r beobachtung, echo=FALSE} +question("Was passiert, wenn Sie höhere Werte von Lernen (`x`) beobachten?", + answer("Bei höheren Werten von Lernen (`x`) treten in der Regel auch höhere Werte von Verstehen (`y`) auf.", correct = TRUE, message = "Es lässt sich ein positiver Zusammenhang zwischen $X$ und $Y$ beobachten."), + answer("Bei höheren Werten von Lernen (`x`) treten in der Regel niedrigere Werte von Verstehen (`y`) auf."), + answer("Der Wert von Verstehen (`y`) scheint in keinem Zusammenhang mit dem Wert von Lernen (`x`) zu stehen."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## Intervention + +Statt nur zu beobachten ($\color{green}{X} = U_{\color{green}{X}}$) können wir auch eine Intervention simulieren, in der wir Werte festlegen ($do(\color{green}{X}=x)$). + +Im Code-Beispiel ist $do(\color{green}{X}=1)$. Drücken Sie zunächst ein paar Mal auf `Ausführen` um zu gucken, wie die Werte von Verstehen ($\color{blue}{Y}$) im Falls von $do(\color{green}{X}=1)$ aussehen. Ändern Sie anschließend den Code so, dass Sie $do(\color{green}{X}=10)$ simulieren können. Was passiert? + +```{r simdo, exercise=TRUE} + # Hier der Befehl fuer do(X=1) +x <- 1 +cat("Wert x (Lernen):", x, "\n") +z <- f_Z(x) +cat("Wert z (Wissen):", z, "\n") +y <- f_Y(z) +cat("Wert y (Verstehen):", y, "\n") +``` + +```{r simdo-solution} + # do(X=10) +x <- 10 +cat("Wert x (Lernen):", x, "\n") +z <- f_Z(x) +cat("Wert z (Wissen):", z, "\n") +y <- f_Y(z) +cat("Wert y (Verstehen):", y, "\n") +``` + +Für die Erläuterung bitte auf `Weiter` klicken. + +## + +Während die Werte für $\color{blue}{Y}$ bei $do(\color{green}{X}=1)$ um die $\color{blue}{15}$ schwanken, liegen sie bei $do(\color{green}{X}=10)$ um die $\color{blue}{150}$. Wir sehen also, dass eine Veränderung von $\color{green}{X}$ tatsächlich zu einer Veränderung von $\color{blue}{Y}$ führt. Dieser kausale Zusammenhang wird durch $\color{violet}{Wissen}$ vermittelt: Mehr Lernen führt zu mehr Wissen führt zu mehr Verstehen. + + +```{r intervention, echo=FALSE} +question("Überlegen Sie: Was wird passieren mit dem Zusammenhang zwischen Lernen (`x`) und Verstehen (`y`), wenn wir Wissen kennen, also z.B. `z <- 15`?", + answer("Bei höheren Werten von Lernen (`x`) treten weiterhin in der Regel auch höhere Werte von Verstehen (`y`) auf.",), + answer("Bei höheren Werten von Lernen (`x`) treten jetzt in der Regel niedrigere Werte von Verstehen (`y`) auf.",), + answer("Bei festem Wissen (`z`) steht der Wert von Verstehen (`y`) in keinem Zusammenhang mit dem Wert von Lernen (`x`).", correct = TRUE, message = "Durch Kenntnis von `z` wird die kausale Kette von $X$ nach $Y$ unterbrochen. Wir hatten ja schon vorab gesagt, dass Verstehen nur direkt auf Wissen hört. Wenn sich Wissen nicht ändert, ändert sich hier also auch nicht das Verstehen. Das können Sie auch gleich noch mal in der Simulation testen."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## + +Probieren Sie dies durch Klick auf `Ausführen` ruhig aus: + +```{r sim2, exercise=TRUE} +x <- U_X() +cat("Wert x (Lernen):", x, "\n") +z <- 15 +cat("Wert z (Wissen):", z, "\n") +y <- f_Y(z) +cat("Wert y (Verstehen):", y, "\n") +``` + +Der bekannte Wert von `z` wird in Zeile 3 unabhängig vom Wert von `x` auf $15$ gesetzt. +Jetzt schwanken `x` und `y` zwar noch zufällig, sind aber unabhängig voneinander. + +## Kausales Modell + +Die zugrunde liegenden Gleichungen des soeben simulierten kausalen Modells lauten: + +\begin{eqnarray*} +\color{green}{X} &=& U_{\color{green}{X}}, \quad U_{\color{green}{X}} \sim \mathcal{G}(1,\,10), \\ +\color{violet}{Z} &=& 5 \cdot \color{green}{X} + U_{\color{violet}{Z}}, \quad U_{\color{violet}{Z}} \sim \mathcal{N}(0,\,1), \\ +\color{blue}{Y} &=& 3 \cdot \color{violet}{Z} + U_{\color{blue}{Y}}, \quad U_{\color{blue}{Y}} \sim \mathcal{N}(0,\,1). +\end{eqnarray*} + +Dabei steht $\mathcal{G}(1,\,10)$ für eine *Gleichverteilung* auf den Bereich von $1$ bis $10$ und $\mathcal{N}(0,\,1)$ für eine *Normalverteilung* mit den Parametern $\mu=0$ und $\sigma=1$, also eine Standardnormalverteilung. Die konkreten Funktionen und Parameter sind hier willkürlich gewählt. + +Einsetzen von $f_{\color{violet}{Z}}$ in $f_{\color{blue}{Y}}$ ergibt +$\color{blue}{Y} = 3 \cdot (5 \cdot \color{green}{X} + U_{\color{violet}{Z}}) + U_{\color{blue}{Y}}=15 \cdot \color{green}{X} + 5 \cdot U_{\color{violet}{Z}} + U_{\color{blue}{Y}}.$ + +Für $n=100$ simulierten Beobachtungen lautet der dazugehörige `R`-Code: + +```{r RSim, eval = FALSE} +## Vorbereitungen +library(mosaic) # Paket laden +set.seed(1896) # Zufallszahlengenerator setzen (für Reproduzierbarkeit) + +## Funktionen +U_X <- function(n = 1) runif(n, min = 1, max = 10) +f_Z <- function(x) 5 * x + rnorm(length(x)) +f_Y <- function(z) 3 * z + rnorm(length(z)) + +## Datentabelle +n <- 100 # Anzahl Beobachtungen +SimData <- tibble(x = U_X(n)) %>% + mutate(z = f_Z(x)) %>% + mutate(y = f_Y(z) +``` + +## Lineare Regression, Versuch 1 + +Natürlich wissen Sie in den meisten Anwendungsfällen nicht, welches System an Gleichungen Ihren Daten zugrundeliegen. +Stattdessen sammeln Sie Daten und untersuchen dann die Zusammenhänge, um Rückschlüsse über das zugrundeliegende System zu schließen. +Ein Verfahren, um Zusammenhänge zwischen Variablen $\color{green}{X}$ und $\color{blue}{Y}$ anhand von beobachteten Daten zu schätzen, ist die **Lineare Regression**. + +*** + +*Anmerkung*: Siehe hierzu z. B. "Maschinelles Lernen" aus dem KI-Campus Kurs [The Elements of AI](https://ki-campus.org/courses/elementsofai). + +*** + +Dabei wird angenommen, dass der Zusammenhang zwischen der zu erklärenden Variable $\color{blue}{Y}$ und den weiteren Variablen im Modell linear ist, d. h., es reicht *nur* die jeweiligen Steigungen zu schätzen, um den Zusammenhang zu beschreiben. So sieht es aus, wenn wir in unseren simulierten Daten den Zusammenhang zwischen Lernen und Verstehen berechnen: + +```{r streu, out.width='80%', fig.align='center', echo = FALSE} +gf_point(y ~ x, data = SimData) %>% # Streudiagramm + gf_lm() %>% # Regressionsgerade + gf_labs(x = "x: Lernen", y = "y: Verstehen") # Achsenbeschriftung +``` + +In `R` kann eine lineare Regression über die Funktion `lm()` berechnet werden. + +Ohne den Mediator <violet> Wissen </violet> ergibt sich folgendes Modell: + +```{r lmoz} +# Regression Rechnen +ModellA <- lm(y ~ x, data = SimData) +# Ergebnis +ModellA +``` + +D. h.: + +$$\widehat{\color{blue}{\text{Verstehen}}} = `r round(coef(ModellA)[1],2)` + `r round(coef(ModellA)[2],2)` \times \color{green}{\text{Lernen}}$$ + +Gemäß dieses Modells liegt der (totale) kausale Effekt von <green>Lernen</green> auf <blue>Verstehen</blue> bei $`r round(coef(ModellA)[2],2)`$: Wird <green> Lernen</green> um eine Einheit erhöht, erhöht sich der Mittelwert von <blue> Verstehen </blue> um $`r round(coef(ModellA)[2],2)`$ Einheiten. + +Das deckt sich mir den Ergebnissen unserer simulierten Intervention: Während die Werte für $\color{blue}{Y}$ bei $do(\color{green}{X}=1)$ um die $\color{blue}{15}$ schwankten, lagen sie bei $do(\color{green}{X}=10)$ um die $\color{blue}{150}$. Die Ergebnisse der linearen Regression entsprechen tatsächlich dem kausalen Effekt von Interesse. + + +*** + +*Anmerkung*: Der Fokus dieses Kurses liegt auf der Identifizierung von kausalen Effekten, nicht auf Schätzverfahren oder statistischer Inferenz. +Wenn Sie damit vertraut sind, können Sie über `summary()` auch die *übliche* Regressionstabelle inkl. Standardfehler, p-Werten usw. erhalten: + +```{r summary, exercise = TRUE} +# Regression Rechnen +ModellA <- lm(y ~ x, data = SimData) +# Ergebnis +summary(ModellA) +``` + +*** + +## Lineare Regression, Versuch 2 + +Aber was passiert, wenn der Mediator <violet> Wissen</violet>, $\color{violet}{Z}$, mit in das Modell aufgenommen wird? +Jetzt ändert sich das Ergebnis der linearen Regression: + +```{r lmmz} +# Regression Rechnen +ModellB <- lm(y ~ x + z, data = SimData) +# Ergebnis +ModellB +``` + +D. h.: + +$$\widehat{\color{blue}{\text{Verstehen}}} = `r round(coef(ModellB)[1],2)` + `r round(coef(ModellB)[2],2)` \times \color{green}{\text{Lernen}} + `r round(coef(ModellB)[3],2)` \times \color{violet}{\text{Wissen}}$$ +Wenn <violet>Wissen</violet> Teil des Modell ist, wir also das <violet>Wissen</violet> berücksichtigen, um den kausalen Effekt von <green>Lernen</green> auf <blue>Verstehen</blue> zu bestimmen, dann sagt unser Modell jetzt: Wird <green> Lernen</green> um eine Einheit erhöht, erhöht sich der Mittelwert von <blue> Verstehen </blue> um $`r round(coef(ModellB)[2],2)`$ Einheiten – ein viel kleinerer Wert als ohne die Berücksichtigung ($`r round(coef(ModellA)[2],2)`$). + +```{r adjustierung, echo=FALSE} +question("Welcher Wert beschreibt den (totalen) kausalen Effekt von Lernen (`x`) auf Verstehen (`y`) richtig? Also: Um wie viel Einheiten wird sich der Wert von Verstehen im Mittelwert ändern, wenn eine Einheit mehr gelernt wird?", + answer("Der Wert aus dem Modell ohne Wissen (`ModellA`), d. h. $14.86$.", correct = TRUE, message = "Wie wir in der simulierten Intervention beobachtet hatten, ist dies der richtige Wert. Das Modell, das zusätzlich den Mediator enthält, berücksichtigt diesen Wert und unterbricht damit die kausale Kette von $X$ nach $Y$."), + answer("Der Wert aus dem Modell mit Wissen (`ModellB`), d. h. $0.86$."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + + +*** + +*Anmerkung*: Die geschätzten Werte in der Regression entprechen aufgrund von zufälligen Rauschen nicht den wahren Werten die wir für die Simulation verwendet haben. + +*** + +## Zusammenfassung + +:::{.box} +Um den (totalen) kausalen Effekt von $X$ auf $Y$ in einer Kette $$X \rightarrow Z \rightarrow Y$$ zu bestimmen, sollte ein Mediator $Z$ **nicht** berücksichtigt werden. Bei fixiertem $Z$ (z.B., wenn die Variable in einer Regression aufgenommen wird) wird der kausale Zusammenhang zwischen $X$ und $Y$ unterbrochen. +::: + +## KI-Campus + +[Zurück zum Kurs](https://learn.ki-campus.org/courses/7c8012d9-8729-4462-9ad0-be7d71118f37/launch) + + + diff --git a/Module/Modul_05_KI.Rmd b/Module/Modul_05_KI.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..e0a5be6f70b3b09f3a7217f40c0a6da82b2088fd --- /dev/null +++ b/Module/Modul_05_KI.Rmd @@ -0,0 +1,367 @@ +--- +title: "Modul 05: Von Störchen und Geburten" +output: + learnr::tutorial: + language: + de: js/tutorial_de.json + progressive: true + css: "css/style.css" +runtime: shiny_prerendered +--- + +<a href="https://ki-campus.org/"> +<img border="0" alt="KICampusLogo" src="images/KIcampusLogo.png" width="100" height="30" style="float: right"> +</a> + +```{r setup, include=FALSE} +library(learnr) +library(knitr) +library(ggplot2) +library(dplyr) +library(tidyr) +library(emojifont) + +theme.fom <- theme_classic(22*1.04) +theme.fom <- theme.fom +theme_set( + theme.fom +) + +# deutsche Version von random_praise +source("random-praise_de/translation_random-praise_de.R") + + +library(ggdag) +# DAG +co <- data.frame(x=c(0,1), y=c(0,0), name=c("X", "Y")) +DAG_SG <- dagify(Y ~ X, + coords = co) %>% + ggdag() + + geom_dag_point(colour = c("#0F710B", "#0000FF")) + + geom_dag_text(size = 8) + + theme_dag_blank() + + geom_dag_edges(arrow_directed = grid::arrow(length = grid::unit(15, "pt"), type = "closed")) + + geom_text(label = "X - Störche\nY - Geburten", + hjust = 1, vjust = 2, + x = 1, y = 0, size = 7, color = "darkgrey") + +co <- data.frame(x=c(0,1,2), y=c(0,1,0), name=c("X", "Z", "Y")) +DAG_Fork <- dagify(X ~ Z, + Y ~ Z, + coords = co) %>% + ggdag() + + geom_dag_point(colour = c( "#DA70D6", "#0F710B", "#0000FF")) + + geom_dag_text(size = 8) + + theme_dag_blank() + + geom_dag_edges(arrow_directed = grid::arrow(length = grid::unit(15, "pt"), type = "closed")) + + geom_text(label = "X - Störche\nZ - Fläche\nY - Geburten", + hjust = 1, vjust = 1, + x = 2, y = 1, size = 7, color = "darkgrey") + + +library(mosaic) + +StoercheGeburten <- tibble( + land = c("Albanien", "Österreich", "Belgien", "Bulgarien", "Dänemark", "Frankreich", "Deutschland", "Griechenland", "Holland", "Ungarn", "Italien", "Polen", "Portugal", "Rumänien", "Spanien", "Schweiz", "Türkei"), + flaeche = c(28750, 83860, 30520, 111000, 43100, 544000, 357000, 132000, 41900, 93000, 301280, 312680, 92390, 237500, 504750, 41290, 779450), + stoerche = c(100, 300, 1, 5000, 9, 140, 3300, 2500, 4, 5000, 5, 30000, 1500, 5000, 8000, 150, 25000), + geburten = c(83, 87, 118, 117, 59, 774, 901, 106, 188, 124, 551, 610, 120, 367, 439, 82, 1576)*1000 +) + +lm_oA <- lm(geburten ~ stoerche, data = StoercheGeburten) +lm_mA <- lm(geburten ~ stoerche + flaeche, data = StoercheGeburten) +``` + +## Lernziele + +In diesem Modul lernen Sie: + +- was eine kausale Gabel ist; + +- was ein Confounder ist; + +- dass gemeinsame Ursachen häufig zu Verwirrung führen. + + +## Herzlichen Glückwunsch! + +Ein häufiges Motiv auf Glückwunschkarten zur Geburt eines Kindes ist ein Storch. + +<img src="images/Storch.png" alt="Storch mit Baby" width="50%" height="50%"> +<!-- style="padding-left:50px;" --> +<span style="font-size: 10px;"><br> +Quelle: [https://pixabay.com/de/vectors/baby-vogel-lieferung-weiblich-1299514/](https://pixabay.com/de/vectors/baby-vogel-lieferung-weiblich-1299514/) +</span> + +Aber in der Schule haben wir gelernt, dass Störche gar nicht die Kinder bringen. + +Oder etwa doch? + +## Die Datenlage + +Robert Matthews hat sich Anfang des Jahrtausend die Mühe gemacht Daten für die Fragestellung zu sammeln ([Quelle](https://doi.org/10.1111/1467-9639.00013)): + +```{r scatter, echo=FALSE, fig.align='center', out.width='85%'} +gf_point(geburten ~ stoerche, data = StoercheGeburten, size = 2, alpha = 0.7) %>% + gf_lm() %>% + gf_lims(x=c(0,35000), y=c(0,2000000)) %>% + gf_text(geburten ~ stoerche, + label = ~land, + hjust = 0, vjust = 2, alpha = 0.8, size = 7, + check_overlap = TRUE) %>% + gf_labs(x="Anzahl Störche (Paare)", y="Geburten", caption="Datenquelle: Robert Matthews") +``` + + +Sie sehen: Es gibt Länder mit vielen Störchen – und gleichzeitig mit vielen Geburten. Und Länder mit vergleichsweise wenigen Störchen – und gleichzeitig wenigen Geburten. + +```{r zusammenhang, echo=FALSE} +question("Wie ist der Zusammenhang zwischen der Anzahl der Störche und der Anzahl der Geburten über die $17$ abgebildeten Länder?", + answer("Es gibt einen positiven Zusammenhang zwischen der Anzahl Störche ($x$) und der Anzahl Geburten ($y$).", correct = TRUE, message = "In Ländern mit relativ vielen Geburten gibt es tendenziell auch relativ viele Störche. Dies ist auch an der eingezeichneten Regressionsgerade zu erkennen, die von links unten nach rechts oben verläuft."), + answer("Es gibt keinen erkennbaren Zusammenhang zwischen der Anzahl Störche ($x$) und der Anzahl Geburten ($y$)."), + answer("Es gibt einen negativen Zusammenhang zwischen der Anzahl Störche ($x$) und der Anzahl Geburten ($y$)."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## Korrelation + +Der Korrelationskoeffizient zwischen der <green>Anzahl Störche</green> ($\color{green}{x}$) und der <blue>Anzahl Geburten</blue> ($\color{blue}{y}$) liegt hier bei + +$$r_{\color{green}{x},\color{blue}{y}} = `r round(cor(geburten ~ stoerche, data = StoercheGeburten),2)`.$$ + +Der Korrelationskoeffizient liegt immer zwischen $-1$ und $+1$. Bei negativen Zusammenhängen (z.B. zwischen Preis und Absatzmenge) wird er kleiner als Null; bei positiven Zusammenhängen (z.B. zwischen Einkommen und Ausgaben) wird er größer als Null. + + +$r_{\color{green}{x},\color{blue}{y}} = `r round(cor(geburten ~ stoerche, data = StoercheGeburten),2)`$ ist also ein relativ großer, positiver Zusammenhang. + +Gilt also doch folgender Graph? + +```{r DAG_SG, echo=FALSE, fig.align='center', out.width='85%'} +plot(DAG_SG) +``` + +```{r pfeil, echo=FALSE} +message <- "Der Pfeil sagt, dass der Wert der Variable an der Pfeilspitze abhängt vom Wert der Variable am Pfeilende – und nicht umgekehrt. Siehe Modul 2." +question("Welche kausale Annahme ist in dem Diagram dargestellt?", + answer("Störche sind die Ursachen, Geburten die Wirkung.", correct = TRUE, message = message), + answer("Störche sind die Wirkung, Geburten die Ursache."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +```{r korrelation, echo=FALSE} +message <- "Der Korrelationskoeffizient ist symmetrisch, d.h., $r_{x,y} = r_{y,x}$." +question("Der Korrelationskoeffizient zwischen der Anzahl Störche und der Anzahl Geburten liegt bei $r_{\\color{green}{x},\\color{blue}{y}} = +0.62$. Wissen Sie, was dann für den Korrelationskoeffizient zwischen der Anzahl Geburten und der Anzahl Störche gilt?", + answer("$r_{\\color{blue}{y}, \\color{green}{x}} = -0.62$."), + answer("$r_{\\color{blue}{y}, \\color{green}{x}} = 1/0.62 = 0.62^{-1}$."), + answer("$r_{\\color{blue}{y}, \\color{green}{x}} = +0.62$.", correct = TRUE, message = paste(message, "Vielleicht bringen also die Kinder die Störche?")), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +*** + +*Ergänzung*: Mit einem p-Wert von $0.008$ wird eine Korrelation wie die gefundene *signifikant* genannt – zum üblichen Signifikanzniveau $\alpha = 5\%$. +Das heißt, die Wahrscheinlichkeit in einer zufälligen Stichprobe einen mindestens so großen Korrelationskoeffizient wie den beobachteten von $|r_{\color{green}{x},\color{blue}{y}}| = `r round(cor(geburten ~ stoerche, data = StoercheGeburten),2)`$ zu erhalten, ist, wenn in der Grundgesamtheit keine Korrelation vorliegt ($H_0: \rho =0$), klein. + +Um beliebte Fehlinterpretation des p-Wertes auszuschließen: Das bedeutet nicht, dass die Wahrscheinlichkeit dafür, dass kein Zusammenhang vorliegt, bei $0.008$ liegt. Es bedeutet auch nicht, dass die Wahrscheinlichkeit dafür, dass Störche nicht die Ursache der Geburten sind, bei $0.008$ liegt. + +*** + + +## Andere Erklärungen + +Überlegen wir uns mögliche Alternativerklärungen. +Wie sieht eigentlich der Zusammenhang zwischen der Fläche des Landes und der Anzahl Geburten aus? + +```{r scatterflaeche, echo=FALSE, fig.align='center', out.width='85%', warning=FALSE} +gf_point(geburten ~ flaeche, data = StoercheGeburten, size = 2, alpha = 0.7) %>% + gf_lm() %>% + gf_lims(x=c(0,900000), y=c(0,2000000)) %>% + gf_text(geburten ~ flaeche, + label = ~land, + hjust = 0, vjust = 2, alpha = 0.8, size = 7, + check_overlap = TRUE) %>% + gf_labs(x=parse(text = paste0("'Fläche in '",'~ km^2')), y="Geburten", caption="Datenquelle: Robert Matthews") +``` + +Anscheinend gibt es auch einen Zusammenhang zwischen der Größe eines Landes und der Anzahl Geburten. + +## + +Aber nicht nur die Anzahl der Geburten steht mit der Fläche im Zusammenhang, sondern auch die Anzahl der Störche: + +```{r scatterstoerche, echo=FALSE, fig.align='center', out.width='85%', warning=FALSE} +gf_point(stoerche ~ flaeche, data = StoercheGeburten, size = 2, alpha = 0.7) %>% + gf_lm() %>% + gf_lims(x=c(0,900000), y=c(0,35000)) %>% + gf_text(stoerche ~ flaeche, + label = ~land, + hjust = 0, vjust = 2, alpha = 0.8, size = 7, + check_overlap = TRUE) %>% + gf_labs(x=parse(text = paste0("'Fläche in '",'~ km^2')), y="Anzahl Störche (Paare)", caption="Datenquelle: Robert Matthews") +``` + +## Confounder + +Hieraus ergibt sich eine mögliche Alternatvierklärung. +Die Größe eines Landes, die <violet>Fläche</violet> ($\color{violet}{Z}$), ist eine gemeinsame Ursache für die <green>Anzahl Störche</green> ($\color{green}{X}$) und die <blue>Anzahl Geburten</blue> ($\color{blue}{Y}$). +Das kausale Diagramm sieht dann wie folgt aus: + +```{r DAG_Fork, echo=FALSE, fig.align='center', out.width='85%'} +plot(DAG_Fork) +``` + +Die <green>Anzahl Störche</green> ($\color{green}{X}$) und die <blue>Anzahl Geburten</blue> ($\color{blue}{Y}$) korrelieren in den Daten deswegen, weil beide eine gemeinsame Ursache, die <violet>Fläche</violet> ($\color{violet}{Z}$) haben. +Eine solche gemeinsame Ursache wird **Confounder** genannt. + +(Natürlich gibt es potentiell noch zahlreiche weitere gemeinsame Ursachen der <green>Anzahl Störche</green> ($\color{green}{X}$) und der <blue>Anzahl Geburten</blue> ($\color{blue}{Y}$).) + +```{r confounder, echo=FALSE} +question("Hängt der Wert von Fläche ($\\color{violet}{Z}$) kausal von der Anzahl Störche ($\\color{green}{X}$) ab?", + answer("Ja"), + answer("Nein", correct = TRUE, message = "Das beschriebene Kausalmodell lautet $\\text{Anzahl Störche} \\leftarrow \\text{Fläche}$. Die Anzahl Störche *hört* auf die Fläche, aber die Fläche **hört nicht** auf die Anzahl Störche. Mehr Störche können die Fläche nicht ändern, die Fläche aber die Anzahl Störche."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## Gabel + +Auch komplexe kausale Diagramme bestehen aus relativ einfachen Grundelementen. Neben der Kette aus Modul 4 kommt jetzt die **Gabel** (engl.: fork): + +$$\color{green}{X} \leftarrow \color{violet}{Z} \rightarrow \color{blue}{Y}$$ +Sowohl der Wert von $\color{green}{X}$ als auch der Wert von $\color{blue}{Y}$ hängen kausal ab von $\color{violet}{Z}$, das strukturelle kausale Modell sieht wie folgt aus: +\begin{eqnarray*} +\color{violet}{Z} &=& U_{\color{violet}{Z}},\\ +\color{green}{X} &=& f_{\color{blue}{X}}(\color{violet}{Z},U_{\color{green}{X}}),\\ +\color{blue}{Y} &=& f_{\color{blue}{Y}}(\color{violet}{Z},U_{\color{blue}{Y}}). +\end{eqnarray*} + + +Wird der Wert von $\color{violet}{Z}$ geändert ($do(z)$), ändern sich die Werte von $\color{green}{X}$ und $\color{blue}{Y}$. + +```{r fork, echo=FALSE} +message <- "Änderungen werden in Pfeilrichtung weitergegeben, eine Intervention von $\\color{green}{X}$ ändert *nicht* den Wert von $\\color{violet}{Z}$ – und als Folge auch nicht den von $\\color{blue}{Y}$." +question("Ändert sich in der Kette der Wert von $\\color{blue}{Y}$, wenn eine Intervention auf $\\color{green}{X}$ erfolgt ($do(x)$)? ", + answer("Ja"), + answer("Nein", correct = TRUE, message = message), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## Vergleich Kette und Gabel + +Der kausale Pfad bei einer **Kette** von $\color{green}{X}$ nach $\color{blue}{Y}$ sieht wie folgt aus: +$$\color{green}{X} \rightarrow \color{violet}{Z} \rightarrow \color{blue}{Y}$$ +$\color{violet}{Z}$ *hört* auf $\color{green}{X}$ und $\color{blue}{Y}$ auf $\color{violet}{Z}$. +Wird $\color{green}{X}$ geändert ($do(\color{green}{X}=\color{green}{x})$), ändert sich die Verteilung von $\color{violet}{Z}$ und damit auch die von $\color{blue}{Y}$. + +Bei einer **Gabel** gibt es hingegen **keinen** kausalen Pfad von $\color{green}{X}$ nach $\color{blue}{Y}$: +$$\color{green}{X} \leftarrow \color{violet}{Z} \rightarrow \color{blue}{Y}$$ +Zwar *hört* immer noch $\color{blue}{Y}$ auf $\color{violet}{Z}$, $\color{violet}{Z}$ aber nicht mehr auf $\color{green}{X}$, sondern umgekehrt, $\color{green}{X}$ hört auf $\color{violet}{Z}$. +Wird $\color{green}{X}$ geändert ($do(\color{green}{X}=\color{green}{x})$), ändert sich die Verteilung von $\color{violet}{Z}$ nicht, und damit auch nicht die von $\color{blue}{Y}$. + + +## Adjustierung + +Was ist zu tun, um einen möglichen (totalen) kausalen Effekt von $\color{green}{X}$ auf $\color{blue}{Y}$ in einer Gabel ($\color{green}{X} \leftarrow \color{violet}{Z} \rightarrow \color{blue}{Y}$) zu bestimmen? + +Der Wert des Confounders $\color{violet}{Z}$ muss berücksichtigt werden. Im Beispiel der <green>Störche</green> und <blue>Geburten</blue> sollten also z.B. nur Länder mit gleicher <violet>Fläche</violet> verglichen werden. +Einen möglichen Weg, so etwas umzusetzen, haben Sie schon kennengelernt: lineare Regression. In einem linearen Regressionsmodell sollte anstelle des Modells `y ~ x` das Modell `y ~ x + z` verwendet werden. + +Die Variable <violet>Fläche</violet> heißt in der vorliegenden Datentabelle `flaeche`. Ändern Sie den Code entsprechend und gucken Sie, ob und wie sich der geschätzte Zusammenhang von `stoerche` und `geburten` im Modell ändert. + +```{r lm, exercise=TRUE} +lm(geburten ~ stoerche, data = StoercheGeburten) +``` + +```{r lm-solution} +lm(geburten ~ stoerche + flaeche, data = StoercheGeburten) +``` + +## + +Während ohne Berücksichtigung der <violet>Fläche</violet> die geschätzte Steigung der <blue>Anzahl Geburten</blue> in Richtung der <green>Anzahl Störche</green> bei $`r round(coef(lm_oA)[2],4)`$ liegt, liegt der Wert nach Berücksichtung der Fläche nur noch bei $`r round(coef(lm_mA)[2],4)`$. +Der im linearen Modell der Stichprobe geschätze Effekt ist also viel kleiner, und vermutlich näher an dem realen kausalen Effekt von Störchen auf Geburten. + +Tatsächlich ist schon in diesem Modell der Effekt nicht mehr statistisch signifikant verschieden von 0. +Der beobachtete Mini-Zusammenhang kann also auch nur Zufallsschwankungen widerspiegeln. +Und natürlich könnte es darüber hinaus noch weitere Konfundierende geben. + + +## Zusammenfassung + +:::{.box} +Um den (totalen) kausalen Effekt von $X$ auf $Y$ in einer Gabel $$X \leftarrow Z \rightarrow Y$$ zu bestimmen, muss der Confounder $Z$ berücksichtigt werden. +Wird $Z$ nicht berücksichtigt, bleibt die Gabel offen und ein nicht-kausaler Zusammenhang zwischen $X$ und $Y$ fließt in die Analyse ein. +Die Berücksichtigung kann beispielsweise erfolgen durch einen stratifizierten Vergleich oder durch Aufnahme der Variable in ein lineares Modell. +Wird so korrekt adjustiert, dann ist die Gabel geschlossen und beeinträchtigt nicht mehr die Interpretierbarkeit der Analyse. +::: + + + +## Ausblick: Ach du liebe Zeit + +Wird die gemeinsame Entwicklung von zwei Variablen über die Zeit betrachtet, so erzeugt die *liebe Zeit* häufig hohe Korrelationen. So z.B. zwischen der Scheidungsrate in Maine und dem Pro-Kopf-Verbrauch von Magarine: + +<img src="images/tv-sc.png" alt="Korrelation Scheidungsrate und Magarine" width="100%" height="100%"> +<!-- style="padding-left:50px;" --> +<span style="font-size: 10px;"><br> +Quelle: [Tyler Vigen: Spurious Correlations](https://tylervigen.com/spurious-correlations) +</span> + +Grund für die hohe Korrelation ist einfach nur, dass beides, sowohl die Scheidungsrate als auch der Konsum von Magarine, im Laufe der Zeit zurückgegangen ist. Weder führten die weniger Scheidungen zu weniger Magarinekonsum, noch der Rückgang des Magarinekonsums zu weniger Scheidungen. + +Eine einfache Simulation eines *Random Walks mit Drift* verdeutlicht das Phänomen. Hier haben beide Variablen einen Trend – aber ansonsten haben sie nichts miteinander zu tun, also weder ist `x1` die Ursache von `x2` noch umgekehrt. + +*Hinweis*: Der Zufallszahlengenerator ist nicht gesetzt, d.h. kein `set.seed()`. Daher ergeben sich aufgrund zufälliger Variation (*Rauschen*) unterschiedliche Ergebnisse beim wiederholten `Ausführen`. + +```{r rw, exercise=TRUE, exercise.lines=30} +# Anzahl Zeitpunkte +n <- 100 +zeitpunkte <- 1:n +# Drift +d1 <- 0.1 +d2 <- 0.2 +# Vektoren bereitstellen +x1 <- numeric(n) +x2 <- numeric(n) +# Startwerte (Zeitpunkt 1) +x1[1] <- 0 +x2[1] <- 0 +# Simulation Random Walk mit Drift über Schleife +# Neue Beobachtung = Vorherige Beobachtung + Drift + Zufall +for (i in 2:n) +{ + x1[i] <- x1[(i-1)] + d1 + rnorm(1, mean = 0, sd = 1) + x2[i] <- x2[(i-1)] + d2 + rnorm(1, mean = 0, sd = 1) +} +# Datentabelle +RandomWalk <- data.frame( + zeitpunkte = zeitpunkte, + x1 = x1, + x2 = x2 +) +# Abbildung +gf_line(x1 ~ zeitpunkte, color = "orange", data = RandomWalk) %>% + gf_line(x2 ~ zeitpunkte, color = "purple", data = RandomWalk) %>% + gf_labs(y = "Entwicklung") +# Korrelation (inkl. Test) +cor.test(x1 ~ x2, data = RandomWalk) +``` + + +## KI-Campus + +[Zurück zum Kurs](https://learn.ki-campus.org/courses/7c8012d9-8729-4462-9ad0-be7d71118f37/launch) diff --git a/Module/Modul_06_KI.Rmd b/Module/Modul_06_KI.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..9a7df76312257beb91b4dbbbd5ab9dfcb2439e68 --- /dev/null +++ b/Module/Modul_06_KI.Rmd @@ -0,0 +1,267 @@ +--- +title: "Modul 06: Nett oder schön? – Warum nicht beides?" +output: + learnr::tutorial: + language: + de: js/tutorial_de.json + progressive: true + css: "css/style.css" +runtime: shiny_prerendered +--- + +<a href="https://ki-campus.org/"> +<img border="0" alt="KICampusLogo" src="images/KIcampusLogo.png" width="100" height="30" style="float: right"> +</a> + +```{r setup, include=FALSE} +library(learnr) +library(knitr) +library(ggplot2) +library(dplyr) +library(tidyr) +library(emojifont) +library(ggthemes) + +theme.fom <- theme_classic(22*1.04) +theme.fom <- theme.fom +theme_set( + theme.fom +) + +# deutsche Version von random_praise +source("random-praise_de/translation_random-praise_de.R") + + +library(ggdag) +# DAG +co <- data.frame(x=c(2,1,0), y=c(1,0,1), name=c("Y","Z","X")) + +DAG_Collider <- dagify(Z ~ Y, + Z ~ X, coords = co) %>% + ggdag() + + geom_dag_point(colour = c("#0F710B","#0000FF", "#DA70D6")) + + geom_dag_text(size = 8) + + theme_dag_blank() + + geom_dag_edges(arrow_directed = grid::arrow(length = grid::unit(15, "pt"), type = "closed")) + + geom_text(label = "Y - Aussehen\nX - Nettigkeit\nZ - Date", + hjust = 0.5, vjust = 1, + x = 1, y = 1, size = 7, color = "darkgrey") + + +library(mosaic) + +# Daten und Funktion +set.seed(1896) +n <- 100 + +SimData <- tibble(x = rnorm(n), y = rnorm(n), u_z = rbinom(n, size = 1, prob = 0.05)) %>% + mutate(z = (x > 1) | (y > 1)) %>% + mutate(z = (1-u_z) * z + u_z * (1-z)) %>% + mutate(z = ifelse(z, "Ja", "Nein")) +``` + +## Lernziele + +In diesem Modul lernen Sie: + +- was eine umgedrehte Gabel ist; + +- was ein Collider ist; + +- dass wir manchmal ungewollt selber Zusammenhänge schaffen wo eigentlich keine sind. + +## Aller guten Dinge sind drei + +Auch komplexe kausale Diagramme bestehen aus relativ einfachen Grundelementen. Neben der Kette und der Gabel gibt es noch als Drittes die **umgedrehte Gabel** (engl.: inverted fork). + +Zur Erinnerung: $$A \rightarrow B$$ sagt aus, dass $B$ auf $A$ *hört*, aber nicht umgekehrt. + +## Dating + +Wieder stark vereinfacht: Nehmen wir an, dass Nettigkeit und Aussehen eine Rolle dafür spielen, ob wir mit jemandem auf ein Date gehen. + +Würden Sie jemanden daten, der weder nett ist noch gut aussieht? Vielleicht, aber wahrscheinlich eher nicht. + + +Angenommen <green>Nettigkeit</green> ($\color{green}{X}$) führt zu <violet>Date</violet> ($\color{violet}{Z}$). Außerdem führt (gutes) <blue>Aussehen</blue> ($\color{blue}{Y}$) zu einem <violet>Date</violet> ($\color{violet}{Z}$). + +Sie daten also jemanden, der nett ist *und/oder* gut aussieht. + +Dieses angenommene Modell lässt sich als kausales Diagramm wie folgt darstellen: + +```{r DAG_Collider, echo=FALSE, fig.align='center', out.width='85%'} +plot(DAG_Collider) +``` + +## + +Das strukturelle kausale Modell besteht aus folgenden Zuweisungen: + +\begin{eqnarray*} +\color{green}{X} &=& U_{\color{green}{X}}\\ +\color{blau}{Y} &=& U_{\color{blue}{Y}}\\ +\color{violet}{Z} &=& f_{\color{violet}{Z}}(\color{green}{X}, \color{blue}{Y}, U_{\color{violet}{Z}}) +\end{eqnarray*} + + +```{r abhaengigkleit, echo=FALSE} +message <- "Nach Konstruktion sind $X$ und $Y$ unabhängig voneinander. Kein kausaler Pfad führt von $X$ zu $Y$ – oder umgekehrt." +question("Hängt Aussehen ($Y$) in diesem Beispiel von Nettigkeit ($X$) ab?", + answer("Ja"), + answer("Nein", correct = TRUE, message = message), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## Collider + +In Fällen wie diesen: $$\color{green}{X} \rightarrow \color{violet}{Z} \leftarrow \color{blue}{Y}$$ wird die Variable in der Mitte – hier $\color{violet}{Z}$ – **Collider** genannt. $\color{violet}{Z}$ ist eine Wirkung von $\color{green}{X}$ und $\color{blue}{Y}$. + +```{r collider, echo=FALSE} +message <- "Wenn es kein Glück oder Pech ($U_Z$) war, dann sieht die nicht-nette Person eher gut aus. Es gibt ja einen Grund dafür, dass Sie sie überhaupt gedatet haben. Wenn es nicht die Nettigkeit war, dann wohl das Aussehen." +question("Angenommen Sie haben jemanden gedatet ($Z$), der nicht besonders nett ($X$) ist. Wissen Sie dann etwas über das Aussehen ($Y$)?", + answer("Ja", correct = TRUE, message = message), + answer("Nein"), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## Vergleich Gabel und umgedrehte Gabel + +Zur Erinnerung, bei einer **Gabel** gibt es einen nicht-kausalen Pfad von $\color{green}{X}$ nach $\color{blue}{Y}$: +$$\color{green}{X} \leftarrow \color{violet}{Z} \rightarrow \color{blue}{Y}$$ + +Angenommen: Im Sommer wird bei <violet>Sonnenschein</violet> sowohl mehr <green>Eis</green> als auch mehr <blue>Sonnencreme</blue> verkauft. +<green>Eis</green> und <blue>Sonnencreme</blue> sind nicht unabhängig: Wenn ich weiß, dass viel <green>Eis</green> verkauft wurde, kann ich davon ausgehen, dass auch viel <blue>Sonnencreme</blue> verkauft wurde. Vermutlich führte <violet>Sonnenschein</violet> zu hohem <green>Eisverkauf</green> und so auch zu hohem <blue>Sonnencremeverkauf</blue>. Der Zusammenhang wird beobachtet, wenn keine weiteren Variablen berücksichtigt werden -- man nennt ihn auch *unbedingt*, *marginal.* + +Über die Information <green>Eis</green> kann man über <violet>Sonnenschein</violet> etwas über <blue>Sonnencreme</blue> lernen. +Wenn ich weiß, dass <violet>Sonnenschein</violet> ist, enhält die Information, dass viel <green>Eis</green> verkauft wurde, keine zusätzliche Information über <blue>Sonnencreme</blue>. *Bedingt* <violet>Sonnenschein</violet>, das heißt wenn ich weiß, dass die Sonne scheint, sind <green>Eis</green> und <blue>Sonnencreme</blue> unabhängig. + +Zusammengefasst: Bei einer Gabel gibt es einen unbedingten Zusammenhang zwischen $\color{green}{X}$ nach $\color{blue}{Y}$; gegeben $\color{violet}{Z}$ -- also bedingt -- gibt es aber keine Zusammenhang. + +Bei einer **umgedrehten Gabel** gibt es keinen Zusammenhang von $\color{green}{X}$ und $\color{blue}{Y}$: +$$\color{green}{X} \rightarrow \color{violet}{Z} \leftarrow \color{blue}{Y}$$ +Angenommen: Sowohl am <green>Wochenende</green> als auch im <blue>Urlaub</blue> kann mensch <violet>ausschlafen</violet>. +Gehen wir davon aus, dass im Urlaub genau so oft Wochenende wie sonst gibt. <green>Wochenende</green> und <blue>Urlaub</blue> sind (*unbedingt*, *marginal*) unabhängig: +Aus der Information <green>Wochenende</green> lerne ich nichts über <blue>Urlaub</blue>. +Wenn ich weiß, dass ich <violet>ausschlafen</violet> kann, weiß ich, dass entweder <green>Wochenende</green> oder <blue>Urlaub</blue> (oder beides) ist. Bei <violet>Ausschlafen</violet> lerne ich aus der Information <blue>kein Urlaub</blue>, dass wahrscheinlich <green>Wochenende</green> ist. +Einen Grund muss mein Ausschlafen ja haben. +*Bedingt*, gegeben, <violet>Ausschlafen</violet> sind <green>Wochenende</green> und <blue>Urlaub</blue> damit nicht mehr unabhängig. + +Die umgedrehte Gabel verhält sich damit gerarde umgedreht wie die normale Gabel. +Es gibt keinen unbedingten Zusammenhang, aber bedingt gibt es einen Zusammenhang. + + +## Modell und Simulierte Daten + +Betrachten wir das folgende strukturelle kausale Modell: + +\begin{eqnarray*} +\color{green}{X} &=& U_{\color{green}{X}}, \quad U_{\color{green}{X}} \sim \mathcal{N}(0,\,1), \\ +\color{blue}{Y} &=& U_{\color{blue}{Y}}, \quad U_{\color{blue}{Y}} \sim \mathcal{N}(0,\,1), \\ +\tilde{\color{violet}{Z}} &=&\begin{cases} 1 & \text{wenn } \{ \color{green}{X} > 1 \,\vee\, \color{blue}{Y} > 1\} \\ 0 & \text{sonst} \end{cases}, \\ +\color{violet}{Z} &=& (1-U_{\color{violet}{Z}}) \cdot \tilde{\color{violet}{Z}} + U_{\color{violet}{Z}} \cdot (1- \tilde{\color{violet}{Z}}), \quad U_{\color{violet}{Z}} \sim \mathcal{B}(0.05), +\end{eqnarray*} + +$\mathcal{N}(0,\,1)$ steht für eine eine Standardnormalverteilung, $\mathcal{B}(0.05)$ für eine Bernoulliverteilung mit $\pi=0.05$. $\tilde{\color{violet}{Z}}$ ist dabei eine Hilfsvariable, die den Wert $1$ annimmt, wenn $\color{green}{X}$ oder $\color{blue}{Y}$ größer als $1$ ist. Ansonsten ist $\tilde{\color{violet}{Z}}=0$. Ob $\color{violet}{Z}$ dann wirklich $0$ (kein Date) oder $1$ (Date) ist hängt dann auch noch ein Wenig vom zufälligen Glück ab. + +$\vee$ ist das logische *oder* (`|` in `R`). + + + +Folgender `R` Code simuliert diesen datengenerierenden Prozess: + +```{r sim, eval=FALSE} +library(mosaic) # Paket laden +set.seed(1896) # Zufallszahlengenerator setzen +n <- 100 # Anzahl Beobachtungen + +SimData <- tibble(x = rnorm(n), # X + y = rnorm(n), # Y + u_z = rbinom(n, size = 1, prob = 0.05)) %>% # U_z + mutate(z = (x > 1) | (y > 1)) %>% # Z~ + mutate(z = (1-u_z) * z + u_z * (1-z)) %>% # Z + mutate(z = ifelse(z, "Ja", "Nein")) +``` + +Sowohl die mathematische Darstellung als auch der `R` Code sind hier anspruchsvoll. +Worauf es in diesem Modul aber ankommt, sind die Daten, die dabei rauskommen: + +```{r scatter, echo=FALSE, fig.align='center', out.width='85%'} +gf_point(y ~ x, data = SimData, color = ~z) + + scale_color_colorblind() + + xlab("x (Nettigkeit)") + + ylab("y (Aussehen)") +``` + +## Zusammenhänge + +Diese Daten beschreiben die zuvor beschriebene Dating-Situation. Die Farbe der Punkte verrät uns, ob wir jemanden gedatet haben ($\color{violet}{Z}$). +$\color{green}{X}$ ist die Nettigkeit und $\color{blue}{Y}$ das Aussehen. + +Wenn wir, getrennt nach <violet>Date</violet> ($\color{violet}{Z}$), eine lineare Regression von <blue>Aussehen</blue> ($\color{blue}{Y}$) auf <green>Nettigkeit</green> ($\color{green}{X}$) bestimmen, so sehen die Ergebnisse wie folgt aus: + +```{r scatterlm, echo=FALSE, fig.align='center', out.width='85%'} +gf_point(y ~ x, data = SimData, color = ~z) %>% + gf_lm() + + scale_color_colorblind() + + xlab("x (Nettigkeit)") + + ylab("y (Aussehen)") +``` + +```{r corb, echo=FALSE} +message <- "Die Regressionsgerade geht von links oben nach rechts unten. Dies zeigt eine negative Korrelation an. Tendenziell sind die Dates, die hübsch sind, nicht besonders nett – und umgekehrt." +question("Für die, die Sie gedatet haben (`z = Ja`): Sehen Sie einen Zusammenhang zwischen Nettigkeit `x` und Aussehen `y`?", + answer("Ja", correct = TRUE, message = message), + answer("Nein"), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## + +Wenn wir <violet>Date</violet> ($\color{violet}{Z}$) berücksichtigen, sehen wir also einen Zusammenhang zwischen <blue>Aussehen</blue> ($\color{blue}{Y}$) und <green>Nettigkeit</green> ($\color{green}{X}$). Dabei haben wir unsere Daten so simuliert, dass die beiden Variablen voneinander unabhängig sind. + +Wenn wir uns hingegen den Zusammenhang zwischen $\color{green}{X}$ und $\color{blue}{Y}$ ohne Berücksichtigung von $\color{violet}{Z}$ angucken, erkennen wir, dass die Variablen eigentlich unabhängig sind: + +```{r scatterlmub, echo=FALSE, fig.align='center', out.width='85%'} +gf_point(y ~ x, data = SimData) %>% + gf_lm() +``` + +*** + +*Anmerkung:* Dass die Gerade hier nicht ganz parallel zur x-Achse verläuft liegt an zufälliger Variation. Auch wenn es im datengenerierenden Prozess keine Korrelation zwischen den Variablen gibt ($\rho=0$), kann es in einer (simulierten) Stichprobe eine geben ($r\neq0$). + +*** + +Häufig lesen wir den Satz: + +> Ich traue keiner Statistik, die ich nicht selbst gefälscht habe. + +Wenn wir als Stichprobe für die Analyse eines möglichen Zusammenhangs zwischen Aussehen und Nettigkeit unsere Dates heranziehen, sollten wir besser sagen: + +> Ich traue auch keiner Statistik, die ich selbst gefälscht habe. + +Natürlich sind unsere Dates nicht *gefälscht*, aber wir haben eine selbst gewählte Stichprobe als Grundlage. +Diese liefert ein verzerrtes Ergebnis mit Zusammenhängen an Stellen, an denen es eigentlich keine gibt. + +## Zusammenfassung + +:::{.box} +Um den (totalen) kausalen Effekt von $X$ auf $Y$ in einer umgedrehten Gabel $$X \rightarrow Z \leftarrow Y$$ zu bestimmen, darf der Collider $Z$ nicht berücksichtigt werden. (Dies gilt auch für alle Nachfahren von $Z$.) +Wird $Z$ berücksichtigt, wird ein scheinbarer Zusammenhang zwischen $X$ und $Y$ erzeugt und fließt in die Analyse ein. +Beispielsweise sollte man in einem linearen Modell nicht $Z$ als erklärende Variable aufnehmen. +Man sollte auch nicht die Daten anhand von $Z$ in Gruppen einteilen, die man dann separat analysiert -- auch das verzerrt Zusammenhänge. +::: + + +## KI-Campus + +[Zurück zum Kurs](https://learn.ki-campus.org/courses/7c8012d9-8729-4462-9ad0-be7d71118f37/launch) diff --git a/Module/Modul_07_KI.Rmd b/Module/Modul_07_KI.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..2f34992ba1a962b1298d058fed49427a76556a9a --- /dev/null +++ b/Module/Modul_07_KI.Rmd @@ -0,0 +1,276 @@ +--- +title: "Modul 07: Warum Raumteilung keine gute Investition ist" +output: + learnr::tutorial: + language: + de: js/tutorial_de.json + progressive: true + css: "css/style.css" +runtime: shiny_prerendered +--- + +<a href="https://ki-campus.org/"> +<img border="0" alt="KICampusLogo" src="images/KIcampusLogo.png" width="100" height="30" style="float: right"> +</a> + +```{r setup, include=FALSE} +library(learnr) +library(knitr) +library(ggplot2) +library(dplyr) +library(tidyr) +library(emojifont) +library(ggthemes) + +theme.fom <- theme_classic(22*1.04) +theme.fom <- theme.fom +theme_set( + theme.fom +) + +# deutsche Version von random_praise +source("random-praise_de/translation_random-praise_de.R") + + +library(ggdag) +# DAG +co <- data.frame(x=c(0,1,2), y=c(0,1,0), name=c("X", "Z", "Y")) +DAG_Fork <- dagify(X ~ Z, + Y ~ Z, + Y ~ X, + coords = co) %>% + ggdag() + + geom_dag_point(colour = c("#0F710B", "#DA70D6","#0000FF")) + + geom_dag_text(size = 8) + + theme_dag_blank() + + geom_dag_edges(arrow_directed = grid::arrow(length = grid::unit(15, "pt"), type = "closed")) + + geom_text(label = "X - Zimmer\nZ - Fläche\nY - Preis", + hjust = 1, vjust = 1, + x = 2, y = 1, size = 7, color = "darkgrey") + + +library(mosaic) +data("SaratogaHouses") + +erglm1 <- lm(price ~ rooms, data = SaratogaHouses) +erglm2 <- lm(price ~ rooms + livingArea, data = SaratogaHouses) + +options(scipen = 999) +``` + +## Lernziele + +In diesem Modul lernen Sie: + +- dass aus einer Beobachtung nicht immer eine Handlung abgeleitet werden kann. + +## Immobilienpreis + +Von was hängt der Wert einer Immobilie ab? + +<img src="images/Grundriss.jpg" alt="Grundriss" width="50%" height="50%"> +<!-- style="padding-left:50px;" --> +<span style="font-size: 10px;"><br> +Quelle: [https://pixabay.com/de/photos/bauplan-grundriss-architektenplan-354233/](https://pixabay.com/de/photos/bauplan-grundriss-architektenplan-354233/) +</span> + + +Ein Faktor, der besonders leicht zu bestimmen ist, ist die Anzahl der Zimmer. +Dieses Kriterium wird in den USA auch häufig zur Vermarktung verwendet. + +Im `R` Paket `mosaicData` gibt es einen Immobiliendatensatz: `SaratogaHouses`. +Er enthält Daten zu Häusern in Saratoga County, New York, USA, im Jahr 2006. + +Schauen wir uns dort den Zusammenhang zwischen Anzahl Zimmer (`rooms`) und Preis (`price`) einmal an: + +```{r desi} +# Vorbereitungen: Paket und Daten laden +library(mosaic) +data(SaratogaHouses) + +# Streudiagramm +gf_point(price ~ rooms, data = SaratogaHouses) %>% + gf_lm() # Regressionsgerade ergänzt +``` + +Wir sehen: Je mehr Zimmer, desto höher der Preis im Mittel. + +## Lineare Regression - 1. Versuch + +Gehen wir von einem linearen Zusammenhang zwischen <green>Anzahl Zimmer</green> (`rooms`), $\color{green}{x}$, und <blue>Preis</blue> (`price`), $\color{blue}{y}$, aus: + +$$\color{blue}{y}_i = \beta_0 + \beta_1 \cdot \color{green}{x}_i + \epsilon_i$$ +Dabei ist $\beta_1$ die Steigung, die den (linearen) Zusammenhang beschreibt, $\beta_0$ der $y$-Achsenabschnitt. + +Geschätzt werden können die Koeffizienten $\beta_0, \beta_1$ mit Hilfe der Daten: + +```{r lm1} +erglm1 <- lm(price ~ rooms, data = SaratogaHouses) +erglm1 +``` + +Also: + +$$\hat{\color{blue}{y}}_i = `r round(coef(erglm1))[1]` + `r round(coef(erglm1))[2]` \cdot \color{green}{x}_i $$ + +```{r Steigung, echo=FALSE} +message <- "Die anhand der Stichprobe im linearen Modell geschätzte Steigung liegt bei $\\hat{\\beta}_1= 22573$. Bei $\\hat{\\beta}_0=53016$ handelt es sich um den geschätzten Y-Achsenabschnitt, also der Mittelwert des Preises bei $x=0$ Räumen." +question("Im linearen Modell der Stichprobe: Um wie viel erhöht sich im Mittel der Preis pro Raum?", + answer("53016"), + answer("22573", correct = TRUE, message = message), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## + +Angenommen, ein Haus hat gemäß Grundriss 4 abgetrennte Räume, also <green>Anzahl Zimmer</green> (`rooms`), $\color{green}{x}=\color{green}{4}$. + +Damit liegt der geschätzte Mittelwert des Preise bei + +$$\hat{\color{blue}{y}} = `r round(coef(erglm1))[1]` + `r round(coef(erglm1))[2]` \cdot \color{green}{4}= \color{blue}{`r round(coef(erglm1))[1]+ round(coef(erglm1))[2]*4`}.$$ + +## + +<img src="images/idee.png" alt="Idee" width="50%" height="50%"> +<!-- style="padding-left:50px;" --> +<span style="font-size: 10px;"><br> +Quelle: [https://pixabay.com/de/vectors/idee-erfindung-erfinder-denken-152213/](Quelle: https://pixabay.com/de/vectors/idee-erfindung-erfinder-denken-152213/) +</span> + +Nun könnte man einen scheinbar genialen Einfall haben: Man teilt das Wohnzimmer einfach auf. +Aus Eins mach Zwei, aus $4$ Zimmern werden $5$, $do(\color{green}{x}=\color{green}{5})$. +Dann gilt gemäß des Modells: + +$$\hat{\color{blue}{y}} = `r round(coef(erglm1))[1]` + `r round(coef(erglm1))[2]` \cdot \color{green}{5}= \color{blue}{`r round(coef(erglm1))[1]+ round(coef(erglm1))[2]*5`}.$$ + +```{r Wertsteigerung, echo=FALSE} +message <- "Das geschätzte lineare Modell der Stichprobe bezieht sich auf die Beobachtungsdaten ($X=x$), d. h., die Steigung beschreibt die beobachtete Änderung des Mittelwertes, nicht den Effekt einer Handlung $do(X=x)$ (vgl. Modul 2)." +question("Erhöht eine solche Raumteilung den Preis der Immobilie im Mittel um $22573$?", + answer("Ja"), + answer("Nein", correct = TRUE, message = message), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## Wiederholung: Elemente Kausaler Diagramme + +In den Module 4, 5 und 6 haben Sie die Grundelemente kausaler Diagramme kennengelernt: + + +| Pfad | $\color{green}{X} \rightarrow \color{violet}{Z} \rightarrow \color{blue}{Y}$ | $\color{green}{X} \leftarrow \color{violet}{Z} \rightarrow \color{blue}{Y}$ | $\color{green}{X} \rightarrow \color{violet}{Z} \leftarrow \color{blue}{Y}$ +| :--------------------------|:--------------------------------|:--------------------------------|:-----------------------------| +| Name | Kette | Gabel | Umgedrehte Gabel +| Verbindung $\color{green}{X}$ und $\color{blue}{Y}$ | Kausal | Nicht kausal | Keine +| Rolle von $\color{violet}{Z}$ | Mediator | Confounder | Collider +| Adjustierung $\color{violet}{Z}$ | Unterbricht kausalen Pfad | Unterbricht nicht-kausalen Pfad | Öffnet nicht-kausalen Pfad + +Wie können wir nun aus Beobachtungsdaten kausale Effekte schätzen? + +**Die Grundidee**: Um die Änderung von $\color{blue}{y}$ zu schätzen, wenn $\color{green}{x}$ verändert wird, sollten alle nicht-kausale Pfade (*Gabeln*) unterbrochen werden. +Gleichzeitig sollten kausale Pfade(*Ketten*) nicht unterbrochen werden. +Zudem sollten keine nicht-kausalen Pfade (*umgedrehte Gabeln*) aufgemacht werden. +Während also in einer Gabel für $\color{violet}{Z}$ adjustiert werden sollte, sollte dies in einer Kette oder umgedrehten Gabel nicht passieren. + +<br> +<br> + +Für den Zusammenhang zwischen <green>Anzahl Zimmer</green> und <blue>Preis</blue>: +Überlegen Sie, welcher *Confounder* hier vorliegen könnte? + +*Denken Sie bitte kurz darüber nach und klicken Sie erst dann auf `Nächstes Thema`* + +## + +<violet>Wohnfläche</violet> könnte eine gemeinsame Ursache von <green>Anzahl Zimmer</green> und <blue>Preis</blue> sein. +Größere Häuser haben in der Regel mehr Zimmer und kosten auch mehr. + +```{r DAG_Fork, echo=FALSE, fig.align='center', out.width='85%'} +plot(DAG_Fork) +``` + +In diesem simplen Graphen können wir uns jetzt auf spezifische Aspekte konzentrieren. + +```{r graph2, echo=FALSE} +message <- "Neben dem direkten Effekt über $X \\rightarrow Y$ gibt es auch den nicht-kausalen $X \\leftarrow Z \\rightarrow Y$. Hier ist die **Fläche** ein **Confounder**." +question("Angenommen, uns interessiert der Zusammenhang zwischen der Anzahl der Zimmer und dem Preis, unter Berücksichtigung der Fläche. +Welcher Struktur enstpricht der Teilgraph?", + answer("Kette"), + answer("Gabel", correct = TRUE, message = message), + answer("Umgedrehte Gabel"), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + + +```{r graph1, echo=FALSE} +message <- "Neben dem direkten Effekt über $Z \\rightarrow Y$ gibt es auch den indirekten $Z \\rightarrow X \\rightarrow Y$. Hierbei ist die **Anzahl Räume** ein **Mediator**." +question("Angenommen, uns interessiert der Zusammenhang zwischen Fläche und Preis, der über die Anzahl Räume vermittelt wird. Welcher Struktur enstpricht der Teilgraph?", + answer("Kette", correct = TRUE, message = message), + answer("Gabel"), + answer("Umgedrehte Gabel"), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + + +## Lineare Regression - 2. Versuch + +Wenn die Wohnfläche ein Confounder ist, so sollten wir für diese Variable adjustieren, um den kausalen Effekt der Anzahl der Zimmer zu schätzen. + + +<violet>Wohnfläche</violet> liegt in der Datentabelle als Variable `livingArea` vor. Ergänzen Sie das Modell entsprechend. + +```{r lm, exercise=TRUE, eval=FALSE} +lm(price ~ rooms, data = SaratogaHouses) +``` + +```{r lm-solution} +lm(price ~ rooms + livingArea, data = SaratogaHouses) +``` + +Was fällt Ihnen auf? + +## + +```{r lms} +# Modell ohne Wohnfläche +lm(price ~ rooms, data = SaratogaHouses) +# Modell mit Wohnfläche +lm(price ~ rooms + livingArea, data = SaratogaHouses) +``` + +Gegeben die <violet>Wohnfläche</violet> ist der Effekt der <green>Anzahl Räume</green> auf den <blue>Preis</blue> viel kleiner. Statt einer geschätzten Steigung von $\hat{\beta}_1=`r round(coef(erglm1))[2]`$ im Modell *ohne* Berücksichtigung der <violet>Wohnfläche</violet> haben wir *mit* Berücksichtigung nur noch eine Steigung von $\hat{\beta}_1=`r round(coef(erglm2))[2]`$. + +Auch wenn dies immer noch ein stark vereinfachtes Modell ist: Der geschätzte kausale Effekt der Anzahl Räume auf den Preis ist im Modell mit der Wohnfläche (`price ~ rooms + livingArea`) realistischer als der ohne (`price ~ rooms`). +Natürlich kann es zusätzlich noch weitere Confounder geben, die berücksichtigt werden sollten. + +## + +```{r DAG_Fork2, echo=FALSE, fig.align='center', out.width='85%'} +plot(DAG_Fork) +``` + +```{r adjustierung, echo=FALSE} +message <- "Welche Variablen ins Modell aufgenommen werden sollen, hängt davon ab, welcher kausale Effekt bestimmt werden soll. Hier würde das Modell `price ~ livingArea + rooms` den (indirekten) kausalen Pfad von Fläche über Zimmer zu Preis unterbrechen. Das korrekte Modell wäre daher `price ~ livingArea`." +question("Angenommen, wir wollen die erwartete Änderung des Preises, wenn die Fläche erhöht wird, analysieren. Sollte dann für die Anzahl Zimmer adjustiert werden?", + answer("Ja", message = "Welche Variablen ins Modell aufgenommen werden sollen, hängt davon ab welcher kausale Effekt bestimmt werden soll."), + answer("Nein",correct = TRUE, message = message), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + + +## KI-Campus + +[Zurück zum Kurs](https://learn.ki-campus.org/courses/7c8012d9-8729-4462-9ad0-be7d71118f37/launch) diff --git a/Module/Modul_08_KI.Rmd b/Module/Modul_08_KI.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..0c8c6e0458043edb4822d6889c4c95955271330e --- /dev/null +++ b/Module/Modul_08_KI.Rmd @@ -0,0 +1,608 @@ +--- +title: "Modul 08: Magie durch Zufall" +output: + learnr::tutorial: + language: + de: js/tutorial_de.json + progressive: true + css: "css/style.css" +runtime: shiny_prerendered +--- + +<a href="https://ki-campus.org/"> +<img border="0" alt="KICampusLogo" src="images/KIcampusLogo.png" width="100" height="30" style="float: right"> +</a> + +```{r setup, include=FALSE} +library(learnr) +library(knitr) +library(ggplot2) +library(dplyr) +library(tidyr) +library(emojifont) +library(ggthemes) +library(ggdag) + +theme.fom <- theme_classic(22*1.04) +theme.fom <- theme.fom +theme_set( + theme.fom +) + +# deutsche Version von random_praise +source("random-praise_de/translation_random-praise_de.R") + +# DAGs +co <- data.frame(x=c(0,1,2), y=c(0,1,0), name=c("X", "Z", "Y")) +DAG_Modell <- dagify(X ~ Z, + Y ~ Z, + Y ~ X, + coords = co) %>% + ggdag() + + geom_dag_point(colour = c("#0F710B", "#DA70D6", "#0000FF")) + + geom_dag_text(size = 7) + + theme_dag_blank() + + geom_dag_edges(arrow_directed = grid::arrow(length = grid::unit(15, "pt"), type = "closed")) + + geom_text(label = "X - Stillen\nY - Übergewicht\nZ - Akademikerin", + hjust = 1, vjust = 1, + x = 2, y = 1, size = 6, color = "darkgrey") + +co <- data.frame(x=c(0,1,2,0), y=c(0,1,0,1), name=c("X", "Z", "Y", "S")) +DAG_ModellG <- dagify(X ~ Z, + Y ~ Z, + Y ~ X, + S ~ Z, + coords = co) %>% + ggdag() + + geom_dag_point(colour = c("#0F710B", "#DA70D6", "#0000FF", "Black")) + + geom_dag_text(size = 4) + + theme_dag_blank() + + geom_dag_edges(arrow_directed = grid::arrow(length = grid::unit(15, "pt"), type = "closed")) + + geom_text(label = "X - Stillen\nY - Übergewicht\nZ - Akademikerin\nS - Stichprobe", + hjust = 1, vjust = 1, + x = 2, y = 1, size = 3.5, color = "darkgrey") + +co <- data.frame(x=c(0,1,2,0,-1), y=c(0,1,0,1,1), name=c("X", "Z", "Y", "S", "D")) +DAG_ModellS <- dagify(X ~ Z, + Y ~ Z, + Y ~ X, + S ~ D, + coords = co) %>% + ggdag() + + geom_dag_point(colour = c( "#808000", "#0F710B", "#DA70D6","Black","#0000FF")) + + geom_dag_text(size = 4) + + theme_dag_blank() + + geom_dag_edges(arrow_directed = grid::arrow(length = grid::unit(15, "pt"), type = "closed")) + + geom_text(label = "X - Stillen\nY - Übergewicht\nZ - Akademikerin\nS - Stichprobe\nD - Zufall", + hjust = 1, vjust = 1, + x = 2, y = 1, size = 3.5, color = "darkgrey") + +co <- data.frame(x=c(0,1,2,0), y=c(0,1,0,1), name=c("X", "Z", "Y", "D")) +DAG_ModellE <- dagify(X ~ D, + Y ~ Z, + Y ~ X, + coords = co) %>% + ggdag() + + geom_dag_point(colour = c( "#808000","#0F710B", "#DA70D6", "#0000FF")) + + geom_dag_text(size = 4) + + theme_dag_blank() + + geom_dag_edges(arrow_directed = grid::arrow(length = grid::unit(15, "pt"), type = "closed")) + + geom_text(label = "X - Stillen\nY - Übergewicht\nZ - Akademikerin\nD - Zufall", + hjust = 1, vjust = 1, + x = 2, y = 1, size = 3.5, color = "darkgrey") +library(mosaic) + +options(scipen = 999) +``` + +## Lernziele + +In diesem Modul lernen Sie: + +- die unterschiedlichen Anforderungen von Beschreibung und Vorhersage; + +- welche Vorteile eine zufällig gezogene Stichprobe hat; + +- welche Vorteile eine zufällige Zuordnung im Rahmen eines Experiments hat. + + +## Weniger Übergewicht durch Stillen? + +Eine <red>fiktive</red> Studie präsentiert Ihnen dieses Ergebnis: + +```{r, out.width="90%", echo = FALSE} +akademikerin <- c(rep(0, 70), rep(1, 30)) +set.seed(1954) +stillen <- numeric(100) +puebergewicht <- numeric(100) +uebergewicht <- numeric(100) +for(i in 1:100) + { + stillen[i] <- ifelse(akademikerin[i], + sample(c(0,1),1, prob = c(0.1, 0.9)), + sample(c(0,1),1, prob = c(0.4, 0.6))) + puebergewicht[i] <- ifelse(akademikerin[i], 0.3, 0.5) + puebergewicht[i] <- puebergewicht[i] - ifelse(stillen[i], 0.2, 0) + uebergewicht[i] <- sample(c(0,1),1, prob = c(1-puebergewicht[i], puebergewicht[i])) +} + +d <- crossing(x = 1:10, + y = 1:10) %>% + mutate(Übergewicht = uebergewicht, + akademikerin = akademikerin, + stillen = stillen) + +d2 <- d %>% + mutate(Übergewicht = ifelse(Übergewicht, "Ja", "Nein")) %>% + mutate(stillen = ifelse(stillen, "Stillen: Ja", "Stillen: Nein")) %>% + mutate(akademikerin = ifelse(akademikerin, "Ja", "Nein")) + + +gf_bar(~ Übergewicht | stillen , data = d2, + fill = ~ Übergewicht) + + scale_fill_manual(values = c("#A9BCF5", "#0B2161")) + + labs(title = "Studienergebnis", y="Häufigkeit") + + theme(legend.position = "bottom", plot.title = element_text(hjust = 0.5)) +``` + +Was Sie sehen: Kinder von Frauen, die mindestens 4 Monate voll <green>stillen</green> haben seltener im Alter von 6 Jahren <blue>Übergewicht</blue> als Kinder von Frauen, die nicht mindestens 4 Monate voll stillen – in dieser fiktiven Studie. + +Dies ist die Ebene **Beschreibung** (siehe Modul 3).<br> +Um die Ebenen ***Vorhersage*** und ***Kausale Inferenz*** zu erreichen brauchen wir mehr. +Einen hilfreichen Kniff dafür kennen Statistiker:innen und Wissenschaftler:innen schon lange. + +## + +Erstellen wir zunächst ein stark vereinfachtes Modell, in dem wir die folgenden kausalen Zusammenhänge annehmen: + + +- <blue>Übergewicht</blue> des Kindes im Alter von 6 Jahren hängt eventuell ab vom vollständigen <green>Stillen</green> durch die Mutter bis zum 4. Monat (<purple>Ja</purple>, <orange>Nein</orange>). + +- <blue>Übergewicht</blue> hängt eventuell zusätzlich ab vom Bildungsgrad der Mutter, hier gemessen daran, ob die Mutter einen Hochschulabschluss hat und somit <violet>Akademikerin</violet> ist. + +- <green>Stillen</green> (<purple>Ja</purple>, <orange>Nein</orange>) hängt eventuell davon ab, ob die Mutter <violet>Akademikerin</violet> ist. + +Das kausale Diagramm sieht dann wie folgt aus: + +```{r DAG_Modell, echo=FALSE, fig.align='center', out.width='90%', fig.asp = .7} +plot(DAG_Modell) +``` + +```{r graph1, echo=FALSE} +message <- "Beim Teilgraph Stillen $\\leftarrow$ Akademikerin $\\rightarrow$ Übergewicht handelt es sich um eine Gabel." +question("Welche Rolle spielt hier die Variable Akademikerin zwischen Stillen und Übergewicht?", + answer("Mediator"), + answer("Confounder", correct = TRUE, message = message), + answer("Collider"), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +So weit, so gut. +Für die Arbeit mit realen Daten müssen wir aber noch zusätzlich etwas berücksichtigen: Wir haben natürlich nicht Daten für alle Frauen mit Kindern, sondern nur für eine Stichprobe. + + +## Population und Stichprobe + +Angenommen in einer Population die uns interessiert sind 30% Akademikerinnen (<i class="fa fa-graduation-cap" aria-hidden="true"></i>). +Eine relevante Population könnte zum Beispiel alle Mütter in einem bestimmten Land zu einem bestimmten Zeitpunkt sein. + +Mindestens 4 Monate voll <green>stillen</green> ist farblich durch <purple>Ja (lila)</purple> und <orange>Nein (orange)</orange> gekennzeichnet: + +```{r population, fig.showtext=TRUE, out.width="90%", echo = FALSE, fig.asp = .7, fig.align="center"} +set.seed(1954) +stipro <- rep(1,100) +akademikerin <- c(rep(0, 70), rep(1, 30)) +set.seed(1954) +stillen <- numeric(100) +for(i in 1:100) stillen[i] <- ifelse(akademikerin[i], + sample(c(0,1),1, prob = c(0.1, 0.9)), + sample(c(0,1),1, prob = c(0.4, 0.6))) + +akademikerin <- fontawesome(ifelse(akademikerin , "fa-graduation-cap", "fa-female")) +stillen <- ifelse(stillen, "#7A378B", "#FF8811") + +d <- crossing(x = 1:10, + y = 1:10) %>% + mutate(stipro = stipro, + akademikerin = akademikerin, + stillen = stillen) %>% + mutate(stichprobe = ifelse(stipro == 1, "Ja","Nein")) + +pdp <- prop( ~ stillen, data = d, success = "#7A378B") + +ppop <- ggplot(d, aes(x = x, y = y)) + + geom_tile(color = "white", size = .5, alpha = .2) + + theme_void() + + geom_text(family='fontawesome-webfont', size = 8, aes(label = akademikerin), colour = stillen) + + labs(title = "Population") + + theme(legend.position = "none", plot.title = element_text(hjust = 0.5)) + + guides(fill = "none") +ppop +``` + +In dieser Ziel-Population liegt der Anteil <purple>gestillt</purple> bei $`r pdp`$. + +## + +In der Regel kennen wir die Werte in der *Population* gar nicht, wir haben nur eine *Stichprobe* zur Verfügung für unsere Analysen. + +<br> + +Nehmen wir an, bei der <u>Datenerhebung</u> gibt es einen Zusammenhang zwischen dem Bildungsgrad der Mutter (<violet>Akademikerin</violet>) und ihrer Teilnahme an der Studie. +Zum Beispiel sieht es in unseren fiktiven Daten so aus, dass Akademikerinnen eine höhere Wahrscheinlichkeit haben, Teil der Stichprobe zu werden: + +```{r, echo=FALSE, fig.align='center', out.width='90%', fig.asp = .7} +plot(DAG_ModellG) +``` + +Ziehen wir jetzt eine mögliche Stichprobe, Frauen die in unseren Daten landen sind farblich hinterlegt: + +```{r gsti, fig.showtext=TRUE, out.width="90%", echo = FALSE, fig.asp = .7, fig.align="center"} +set.seed(1954) +stipro <- c(sample(c(rep(1,10), rep(0,60))),sample(c(rep(1,20), rep(0,10)))) +akademikerin <- c(rep(0, 70), rep(1, 30)) +set.seed(1954) +stillen <- numeric(100) +for(i in 1:100) stillen[i] <- ifelse(akademikerin[i], + sample(c(0,1),1, prob = c(0.1, 0.9)), + sample(c(0,1),1, prob = c(0.4, 0.6))) + +akademikerin <- fontawesome(ifelse(akademikerin , "fa-graduation-cap", "fa-female")) +stillen <- ifelse(stillen, "#7A378B", "#FF8811") + +d <- crossing(x = 1:10, + y = 1:10) %>% + mutate(stipro = stipro, + akademikerin = akademikerin, + stillen = stillen) %>% + mutate(Stichprobe = ifelse(stipro == 1, "Ja","Nein")) + +dd <- d %>% + filter(stipro == 1) +pdgs <- prop( ~ stillen, data = dd, success = "#7A378B") + +pgsti <- ggplot(d, aes(x = x, y = y, color = Stichprobe)) + + geom_tile(color = "white", size = .5, aes(fill = Stichprobe), alpha = .2) + + theme_void() + + geom_text(family='fontawesome-webfont', size = 8, aes(label = akademikerin), colour = stillen) + + scale_fill_manual(values = c("#00998A","grey80")) + + labs(title = "Gelegenheitsstichprobe") + + theme(legend.position = "bottom", plot.title = element_text(hjust = 0.5)) +pgsti +``` + +```{r stipro, echo=FALSE} +message <- "Akademikerinnen sind in der Stichprobe überrepräsentiert." +question("Ist diese Stichprobe *repräsentativ* – können gültige Schlüsse über die Population getroffen werden?", + answer("Ja"), + answer("Nein", correct = TRUE, message = message), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## + +In dieser *Gelegenheitsstichprobe* liegt der Anteil <purple>gestillt</purple> bei $`r round(pdgs,2)`=`r round(pdgs,2)*100`\%$ – und ist damit systematisch zu hoch. + +Wir können zwar das Ergebnis der Stichprobe zur *Beschreibung* dieser verwenden, aber wir können die Ergebnisse weder verallgemeinern noch zur Vorhersage verwenden. + +Wollten wir anhand der Daten zum Beispiel vorhersagen, ob eine zufällig gewählte Frau stillt oder nicht, so läge unsere geschätzte Wahrscheinlich von $Pr(\color{green}{\text{Stillen}} = \color{purple}{\text{Ja}}) = `r round(pdgs,2)`$ zu hoch. + +<br> + +Wir brauchen also *mehr* als nur die Daten der Stichprobe... + +## Zufällige Stichprobe + +Das Problem ist, dass unsere Stichprobe von einer Variable abhängt, <violet>Akademikerin</violet>, und von dieser wiederum hängt die untersuchte Variable <green>Stillen</green> ab. +Akademikerinnen sind hier wahrscheinlicher Teil der Stichprobe, und Akademikerinnen stillen häufiger, also überschätzen wir anhand der Stichprobe den Anteil der Frauen, die mindestens 4 Monate voll stillen. + +Dieses Problem betrifft zahlreiche Umfragen -- oft nehmen Personen mit bestimmten Eigenschaften lieber teil, und diese Eigenschaften wiederum hängen mit unserem Untersuchungsgegenstand zusammen. + +Wie können wir an der Stelle sicherstellen, dass unsere Stichprobe uns nicht hinters Licht führt? + +Hier hilft der Zufall! + +<img src="images/Wuerfel.jpg" alt="Wuerfel" width="50%" height="50%"> +<!-- style="padding-left:50px;" --> +<span style="font-size: 10px;"><br> +Quelle: [https://pixabay.com/de/photos/w%c3%bcrfel-rot-fallen-zufall-635353/](https://pixabay.com/de/photos/w%c3%bcrfel-rot-fallen-zufall-635353/) +</span> + +Durch die zufällige Auswahl der Stichprobe wird die Abhängigkeit der Stichprobenzugehörigkeit von der Variable <violet>Akademikerin</violet> gelöscht. + + +```{r, echo=FALSE, fig.align='center', out.width='90%', fig.asp = .7} +plot(DAG_ModellS) +``` + +Die Stichprobe hängt dann nur noch vom Zufall ab, und dieser ergibt z.B. dieses Ergebnis: + +```{r fig.showtext=TRUE, out.width="90%", echo = FALSE, fig.asp = .7, fig.align="center"} +set.seed(1954) +stipro <- as.factor(sample(c(rep(1,30), rep(0,70)))) +akademikerin <- c(rep(0, 70), rep(1, 30)) +set.seed(1954) +stillen <- numeric(100) +for(i in 1:100) stillen[i] <- ifelse(akademikerin[i], + sample(c(0,1),1, prob = c(0.1, 0.9)), + sample(c(0,1),1, prob = c(0.4, 0.6))) + +akademikerin <- fontawesome(ifelse(akademikerin , "fa-graduation-cap", "fa-female")) +stillen <- ifelse(stillen, "#7A378B", "#FF8811") + +d <- crossing(x = 1:10, + y = 1:10) %>% + mutate(stipro = stipro, + akademikerin = akademikerin, + stillen = stillen) %>% + mutate(Stichprobe = ifelse(stipro == 1, "Ja","Nein")) + +dd <- d %>% + filter(stipro == 1) +pdz <- prop( ~ stillen, data = dd, success = "#7A378B") + +pzsti <- ggplot(d, aes(x = x, y = y, color = Stichprobe)) + + geom_tile(color = "white", size = .5, aes(fill = Stichprobe), alpha = .2) + + theme_void() + + geom_text(family='fontawesome-webfont', size = 8, aes(label = akademikerin), colour = stillen) + + scale_fill_manual(values = c("#00998A", "grey80")) + + labs(title = "Zufällige Stichprobe") + + theme(legend.position = "bottom", plot.title = element_text(hjust = 0.5)) +pzsti +``` + +In dieser zufälligen Stichprobe weicht der Anteil <purple>gestillt</purple> mit $`r round(pdz,2)`=`r round(pdz,2)*10`\5$ nicht mehr systematisch vom *wahren* Anteil in der Ziel-Population ab. + +Alle Abweichungen sind nur noch zufällig -- mal werden wir den wahren Wert überschätzen, mal werden wir ihn unterschätzen. +Und je größer die Stichprobe ist, desto weniger schwankt der Anteil bei wiederholter Stichprobenziehung. + +<br> + +Dank der Zufallsstichprobe können wir somit zuverlässige **Vorhersagen** machen darüber, ob eine zufällig gewählte Frau stillt oder nicht. + +Aber wie sieht es mit dem Analyseziel *Kausaler Inferenz* aus? + + +```{r ki, echo=FALSE} +message <- "Akademikerin ist hier ein Confounder und liegt auf einem nicht-kausalen Pfad von Stillen zu Übergewicht. Damit wäre unsere Schätzung des kausalen Effekts verzerrt." +question("Kann der kausale Effekt von Stillen auf Übergewicht durch einen direkten Vergleich von Kindern deren Mütter stillen vs. nicht stillen geschätzt werden?", + answer("Ja"), + answer("Nein", correct = TRUE, message = message), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## Zufällige Zuordnung + +```{r simbeob, include=FALSE} +akademikerin <- c(rep(0, 70), rep(1, 30)) +set.seed(1954) +stillen <- numeric(100) +puebergewicht <- numeric(100) +uebergewicht <- numeric(100) +for(i in 1:100) + { + stillen[i] <- ifelse(akademikerin[i], + sample(c(0,1),1, prob = c(0.1, 0.9)), + sample(c(0,1),1, prob = c(0.4, 0.6))) +} + +for(i in 1:100) + { + puebergewicht[i] <- ifelse(akademikerin[i], 0.3, 0.5) + puebergewicht[i] <- puebergewicht[i] - ifelse(stillen[i], 0.2, 0) + uebergewicht[i] <- sample(c(0,1),1, prob = c(1-puebergewicht[i], puebergewicht[i])) +} + +akademikerins <- fontawesome(ifelse(akademikerin, "fa-graduation-cap", "fa-female")) +stillens <- ifelse(stillen, "#7A378B", "#FF8811") + +d <- crossing(x = 1:10, + y = 1:10) %>% + mutate(uebergewicht = uebergewicht, + akademikerin = akademikerin, + akademikerins = akademikerins, + stillen = stillen, + stillen = stillen) %>% + mutate(uebergewicht = ifelse(uebergewicht == 1, "Ja","Nein")) +d$Übergewicht <- d$uebergewicht + +d2 <- d %>% + mutate(stillen = ifelse(stillen, "Ja", "Nein")) %>% + mutate(akademikerin = ifelse(akademikerin, "Ja", "Nein")) + +puebergewichtstillen <- d2 %>% + filter(stillen == "Ja") %>% + prop( ~ uebergewicht, success = "Nein", .) %>% + round(., digits = 2) + +puebergewichtkstillen <- d2 %>% + filter(stillen == "Nein") %>% + prop( ~ uebergewicht, success = "Nein", .) %>% + round(., digits = 2) +``` + +Über unsere fiktive Studie wird in den Medien berichtet. Eine mögliche Schlagzeile lautet: + +> Gesunde Wirkung von Stillen bewiesen: `r puebergewichtstillen*100` % der Kinder von Frauen, die mindestens 4 Monate voll stillen, sind im Alter von 6 Jahren nicht übergewichtig. + + +```{r beob1, echo=FALSE} +message <- "Ohne Variation keine Korrelation. Es fehlt die Information, wie viele Kinder, die nicht voll gestillt wurden, Übergewicht haben." +question("Lassen alleine die Daten der Schlagzeile den Schluss zu, dass Stillen mit Übergewicht korreliert ist?", + answer("Ja"), + answer("Nein", correct = TRUE, message = message), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## + +Zu wissen, wie viele <purple>gestillte</purple> Kinder kein Übergewicht entwickelt haben, ist zwar schön, es fehlt aber mindestens noch der Vergleich zu den <orange>nicht-gestillten</orange> Kindern. + +Während in der fiktiven Studie dieser Anteil, wie in der Schlagzeile berichtet, bei <purple>gestillten</purple> Kindern bei $\color{purple}{`r puebergewichtstillen`}$ liegt, liegt er bei <orange>nicht-gestillten</orange> Kindern bei $\color{orange}{`r puebergewichtkstillen`}$. + +Die Daten wurden im Rahmen einer **Beobachtungsstudie** erhoben, das heißt es wurde erfragt, ob die Mütter <green>Stillen</green> (<purple>Ja</purple> oder <orange>Nein</orange>). Und es wurde die Variable <blue>Übergewicht</blue> erhoben. + +Ein Vergleich des Anteils <blue>Übergewicht</blue> je nach <green>Stillen</green> ergibt: + +$$\color{purple}{`r puebergewichtstillen`}-\color{orange}{`r puebergewichtkstillen`}=`r (puebergewichtstillen-puebergewichtkstillen)`.$$ + +```{r beob2, echo=FALSE} +message <- "Akademikerin ist hier ein Confounder und liegt auf einem nicht-kausalen Pfad von Stillen zu Übergewicht." +question("Lassen die Daten der Beobachtungsstudie den Schluss zu, dass der durchschnittliche kausale Effekt von Stillen auf die Wahrscheinlichkeit Übergewicht zu entwickeln bei $0.36$ liegt?", + answer("Ja"), + answer("Nein", correct = TRUE, message = message), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## + +Das angenommene Modell war folgendes: + +```{r DAG_Modell2, echo=FALSE, fig.align='center', out.width='60%', fig.asp = .8} +plot(DAG_Modell) +``` + +Dies führt zu folgender fiktiver Verteilung in der Population: + +```{r fig.showtext=TRUE, out.width="90%", echo = FALSE, fig.asp = .7, fig.align="center"} +pbeob <- ggplot(d, aes(x = x, y = y, color = Übergewicht)) + + geom_tile(color = "white", size = .5, aes(fill = Übergewicht), alpha = .2) + + theme_void() + + geom_text(family='fontawesome-webfont', size = 8, aes(label = akademikerins), colour = stillens) + + scale_fill_manual(values = c("#A9BCF5", "#0B2161")) + + labs(title = "Beobachtungsstudie") + + theme(legend.position = "bottom", plot.title = element_text(hjust = 0.5)) +pbeob +``` + + +Bei <purple>stillen</purple> tritt seltener Übergewicht auf als bei <orange>nicht-stillen</orange>. + +Aber: Akademikerinnen <purple>stillen</purple> häufiger als Nicht-Akademikerinnen – und Kinder von Akademikerinnen entwickeln seltener Übergewicht. + + +## Randomisiertes Experiment + +Unter Annahme des kausalen Modells mit nur einer Konfundierenden (hier: Akademikerin) könnten Sie, wie Sie bereits gelernt haben, einfach für diese Variable adjustieren. +Aber was, wenn Sie die Variable in Ihren Daten gar nicht erhoben haben? +Und, noch viel wichtiger: Natürlich könnte es hier zahlreiche weitere Konfundierende geben. + +Ein klassischer Lösungsansatz zur Bestimmung von durchschnittlichen kausalen Effekten sind **randomisierte Experimente** (engl. randomized controlled trial, RCT). Dabei werden Pfeile, die auf die Variable $\color{green}{X}$ zeigen eliminiert, und die Zuweisung $do(\color{green}{X}=\color{green}{x})$ erfolgt zufällig. + +*Hinweis*: Wäre an dieser Stelle ein randomisiertes Experiment überhaupt ethisch vertretbar und praktisch umsetzbar? +Können wir randomisieren, welche Mütter stillen und welche nicht? +Im Interview mit der Ökonomin Anne Brenøe erfahren Sie mehr zu Designs, mit denen die kausalen Effekte des Stillens in der Praxis untersucht werden können. + + +```{r, echo=FALSE, fig.align='center', out.width='90%', fig.asp = .7} +plot(DAG_ModellE) +``` + +## + +Mit einem möglichen Ergebnis wie folgt: + +```{r fig.showtext=TRUE, out.width="90%", echo = FALSE, fig.asp = .7, fig.align="center"} +akademikerin <- c(rep(0, 70), rep(1, 30)) +set.seed(1954) +stillen <- numeric(100) +puebergewicht <- numeric(100) +uebergewicht <- numeric(100) +for(i in 1:100) + { + stillen[i] <- sample(c(0,1), 1) + puebergewicht[i] <- ifelse(akademikerin[i], 0.3, 0.5) + puebergewicht[i] <- puebergewicht[i] - ifelse(stillen[i], 0.2, 0) + uebergewicht[i] <- sample(c(0,1),1, prob = c(1-puebergewicht[i], puebergewicht[i])) +} + +akademikerins <- fontawesome(ifelse(akademikerin, "fa-graduation-cap", "fa-female")) +stillens <- ifelse(stillen, "#7A378B", "#FF8811") + +d <- crossing(x = 1:10, + y = 1:10) %>% + mutate(uebergewicht = uebergewicht, + akademikerin = akademikerin, + akademikerins = akademikerins, + stillen = stillen, + stillen = stillen) %>% + mutate(Übergewicht = ifelse(uebergewicht == 1, "Ja","Nein")) + +d2 <- d %>% + mutate(stillen = ifelse(stillen, "Ja", "Nein")) %>% + mutate(akademikerin = ifelse(akademikerin, "Ja", "Nein")) + +puebergewichtstillene <- d2 %>% + filter(stillen == "Ja") %>% + prop( ~ Übergewicht, success = "Nein", .) %>% + round(., digits = 2) + +puebergewichtkstillene <- d2 %>% + filter(stillen == "Nein") %>% + prop( ~ Übergewicht, success = "Nein", .) %>% + round(., digits = 2) + +pexp <- ggplot(d, aes(x = x, y = y, color = Übergewicht)) + + geom_tile(color = "white", size = .5, aes(fill = Übergewicht), alpha = .2) + + theme_void() + + geom_text(family='fontawesome-webfont', size = 8, aes(label = akademikerins), colour = stillens) + + scale_fill_manual(values = c("#A9BCF5", "#0B2161")) + + labs(title = "Randomisiertes Experiment") + + theme(legend.position = "bottom", plot.title = element_text(hjust = 0.5)) +pexp + +``` + +Ein Vergleich des Anteils <blue>Übergewicht</blue> je nach <green>Stillen</green> ergibt jetzt als Schätzer für den durchschnittlichen kausalen Effekt: + +$$\color{purple}{`r puebergewichtstillene`}-\color{orange}{`r puebergewichtkstillene`}=`r (puebergewichtstillene -puebergewichtkstillene)`.$$ + +In der <red>fiktiven</red> Beobachtungsstudie war unsere Schätzung verzerrt gewesen aufgrund des Confounders <violet>Akademikerin</violet>. + +In unserem <red>fiktiven</red> Experiment müssen wir uns um diese und andere Drittvariablen keine Sorgen mehr machen, weil sie nicht beeinflussen können, ob Mütter stillen oder nicht. + +Um von der reinen Vorhersage ("Wie wahrscheinlich ist es, dass eine zufällig gewählte Frau stillt?") zur **kausalen Inferenz** zu kommen ("Welchen Effekt hat das Stillen auf das Risiko von Übergewicht?") benötigt es mehr als nur die Daten. +Wir benötigen zusätzlich wissen darüber, wie die Daten entstanden sind – welche zusätzlichen Variablen die Variablen von Interesse beeinflusst haben, oder ob beispielsweise eine zufällige Intervention stattgefunden hat. + +*** + +*Anmerkung*: Aus Gründen der Präzision und der individuellen Unterschiede is es angemessen hier die Variable <violet>Akademikerin</violet> für die Analyse mit zu berücksichtigen. + +## + +Richard McElreath weist in seinem Vortrag [Causal Thinking for Descriptive Research](https://speakerdeck.com/rmcelreath/causal-thinking-for-descriptive-research) zu Recht darauf hin, dass wir *ehrliche Methoden für bescheidene Fragen* einsetzen sollen: + +1. Was soll analysiert werden? + +2. Welche Daten müssen wir dafür idealerweise haben? + +3. Welche Daten liegen tatsächlich vor? + +4. Was ist der Grund für mögliche Abweichungen zwischen (2) und (3)? + +In diesem Modul haben Sie statistische Methoden kennengelernt, wie Sie Datenerhebung, wenn möglich, optimal gestalten können, um in (4) keine Abweichungen festzustellen. Optimalerweise haben wir eine Zufallsstichprobe; optimalerweise gibt es eine zufällige Zuordnung zu experimentellen Gruppen. +Leider gelingt das in der Praxis nicht immer; in manchen Situationen ist es schlicht nicht möglich. + + + +## KI-Campus + +[Zurück zum Kurs](https://learn.ki-campus.org/courses/7c8012d9-8729-4462-9ad0-be7d71118f37/launch) + + + diff --git a/Module/Modul_09_KI.Rmd b/Module/Modul_09_KI.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..bb88fb47b8bb505416803cc480ebaa030ff0177f --- /dev/null +++ b/Module/Modul_09_KI.Rmd @@ -0,0 +1,259 @@ +--- +title: "Modul 09: Was wäre gewesen, wenn?" +output: + learnr::tutorial: + language: + de: js/tutorial_de.json + progressive: true + css: "css/style.css" +runtime: shiny_prerendered +--- + +<a href="https://ki-campus.org/"> +<img border="0" alt="KICampusLogo" src="images/KIcampusLogo.png" width="100" height="30" style="float: right"> +</a> + +```{r setup, include=FALSE} +library(learnr) +library(knitr) +library(ggplot2) +library(dplyr) +library(tidyr) +library(emojifont) + +theme.fom <- theme_classic(22*1.04) +theme.fom <- theme.fom +theme_set( + theme.fom +) + +# deutsche Version von random_praise +source("random-praise_de/translation_random-praise_de.R") + + +library(ggdag) + +# DAG1, ohne Fehlerterm +co <- data.frame(x=c(0,1), y=c(0,0), name=c("X", "Y")) +DAG1 <- dagify(Y~ X, + coords = co) %>% + ggdag() + + geom_dag_point(colour = c("#0F710B", "#0000FF")) + + geom_dag_text(size = 8) + + theme_dag_blank() + + geom_dag_edges(arrow_directed = grid::arrow(length = grid::unit(15, "pt"), type = "closed")) + + geom_text(label = "X - Lernzeit\nY - Klausurpunkte", + hjust = 1, vjust = 2, + x = 1, y = 0, size = 10, color = "darkgrey") + +# DAG 2, mit Fehlerterm +co <- data.frame(x=c(0,1,0,1), y=c(0,0,1,1), name=c("X", "Y", "U_X", "U_Y")) +DAG2 <- dagify(Y~ X, + X ~ U_X, + Y ~ U_Y, + coords = co) %>% + ggdag() + + geom_dag_point(colour = c( "darkgrey", "darkgrey","#0F710B", "#0000FF")) + + geom_dag_text(size = 8) + + theme_dag_blank() + + geom_dag_edges(arrow_directed = grid::arrow(length = grid::unit(15, "pt"), type = "closed")) +``` + +## Lernziele + +In diesem Modul lernen Sie: + +- wie Counterfactuals bestimmt werden können. + + +## Der nicht-gegangene Weg + +Bei der (rückblickenden) Beurteilung von Handlungen fragen wir uns häufig: *Wie wäre es gewesen, wenn ich mich anders entschieden hätte?* + +Zum Beispiel bei der Beurteilung des menschlichen Einflusses auf den Klimawandel: Wie wäre die Erderwärmung, wenn es die Industialisierung nicht gegeben hätte? + +Oder zum Beispiel bei Fragen einer möglichen Diskriminierung: Hätte ich den Kredit bekommen, wenn ich nicht einer ethnischen Minderheit angehören würde? + +## + +Entscheidend ist bei diesen Fragen und Überlegungen: Wir sind den einen Weg gegangen und kennen das Ergebnis. + +Uns interessiert aber auch, wie das Ergebnis gewesen wäre, wenn wir den anderen Weg gegangen wären. + +Wir wollen also das sogenannte **Counterfactual** bestimmen. +Dieser Wert ist kontrafaktisch in dem Sinne, dass er in der Realität nicht vorliegt, da ein anderes der **potenziellen Ergebnisse** vorliegt. + +*** + +*Hinweis*: Siehe auch Modul 1. + +*** + +<center> +<img src="images/Zweiwege.jpg" alt="Weggabel" width="50%" height="50%"> +<!-- style="padding-left:50px;" --> +<span style="font-size: 10px;"><br> +Quelle: [https://pixabay.com/de/photos/wald-pfad-weggabelung-weg-b%c3%a4ume-6607631/](https://pixabay.com/de/photos/wald-pfad-weggabelung-weg-b%c3%a4ume-6607631/) +</span> +</center> + +<br> + +Wir wissen, was passiert ist, nachdem wir links abgebogen sind. +Wir wollen nun wissen, was passiert wäre, wenn wir rechts abgebogen wären – mit dem Wissen des Ergebnisses nach der Abbiegung nach links. + +Dies ist in der kausalen Leiter nach Pearl die höchste Stufe: + +3. **Counterfactuals**: – Vorstellung: *Was wäre gewesen*? + +Wir haben $X=x'$ und als Folge $Y=y'$ beobachtet. Wie wahrscheinlich ist dann $Y=y$, wenn ich $X=x$ gesetzt hätte? Formal: $Pr(y_x|x',y')$ + +*** + +*Hinweis*: Siehe Modul 3 für die kausale Leiter. + +*** + +```{r counterfactual, echo=FALSE} +question("Was ist beim Klimawandel das Counterfactual?", + answer("Die Erderwärmung ohne Industrialisierung.", correct = TRUE, message = "Die Industrialisierung hat stattgefunden, die Erderwärmung in diesem Fall beobachten wir leider gerade."), + answer("Die Erderwärmung mit Industrialisierung."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + + +## Lernen und Klausurerfolg + +Das Phänomen kennen sicherlich viele: Sie lernen für eine Klausur, zum Beispiel insgesamt 10 Stunden. +Sie erreichen in der Klausur eine gute Note, sagen wir mit 50 Punkten. + +*"Hätte ich mehr gelernt, etwa 20 Stunden, dann hätte ich eine sehr gute Note erreicht."* + +Gehen wir – extrem stark vereinfacht – von folgendem kausalen Diagramm aus: + +```{r DAG1, echo=FALSE, fig.align='center', out.width='60%'} +plot(DAG1) +``` + +Dann ist <green>Lernzeit</green> die Ursache $\color{green}{X}$ und <blue>Klausurerfolg</blue> der Effekt $\color{blue}{Y}$. + +**Hinweis**: Für die Berechnung von Counterfactuals müssen Sie das zugrundeliegende kausale Modell kennen -- deswegen steht dieser Schritt auch an der Spitze der kausalen Leiter. In unserem Beispiel hier wird es in Wirklichkeit natürlich viele weitere Faktoren geben und der Effekt der Lernzeit auf den Klausurerfolg ist empirisch nicht leicht zu bestimmen. Wir vereinfachen hier stark, um das Konzept und die Berechnung von Counterfactuals im simplen Fall zu illustrieren. + + +## + +Das **kausale Modell** des Graphen $\color{green}{X} \rightarrow \color{blue}{Y}$ besteht aus zwei Zuweisungen: + +- $\color{green}{X} = U_{\color{green}{X}}$ +- $\color{blue}{Y} = f_{\color{blue}{Y}}(\color{green}{X},U_{\color{blue}{Y}})$ + +Inklusive der externen Faktoren $U_{\color{green}{X}}$ und $U_{\color{blue}{Y}}$ sieht das kausale Diagram wie folgt aus: + +```{r DAG2, echo=FALSE, fig.align='center', out.width='60%'} +plot(DAG2) +``` + +Treffen wir noch eine stark vereinfachende Annahme: + +$$f_{\color{blue}{Y}}(\color{green}{X},U_{\color{blue}{Y}}) = 2 \cdot \color{green}{X} + U_{\color{blue}{Y}}$$ + +Das bedeutet, dass der Mittelwert von $\color{blue}{Y}$ (Klausurpunkte) mit jeder Einheit von $\color{green}{X}$ (gelernte Stunden) um $2$ Einheiten steigt. Dabei liegt der Mittelwert von $U_{\color{blue}{Y}}$ bei Null. + +```{r erwartung, echo=FALSE} +question("Welchen Wert für $Y$ erwarten Sie, wenn jemand $x'=10$ Stunden lernt?", + answer("$0$"), + answer("$10$"), + answer("$20$", correct = TRUE, message = "Wenn wir für $U_Y$ im Schnitt einen Wert von $0$ erwarten, dann liegt der erwartete Wert von $Y$, wenn $x'=10$ ist, bei $2\\cdot 10 = 20$."), + answer("$30$"), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + + +*Hinweis*: Wie Sie im Interview mit Jakob Runge am Beispiel der Klimasysteme erfahren haben, erfordert das Aufstellen dieser Gleichungen in der Praxis viel theoretisches Hintergrundwissen. + + +## Abduktion + +Wir nehmen an: + +- $\color{green}{X} = U_{\color{green}{X}}$ +- $\color{blue}{Y} = f_{\color{blue}{Y}}(\color{green}{X},U_{\color{blue}{Y}}) = 2 \cdot \color{green}{X} + U_{\color{blue}{Y}}$ + +*"Sie lernen für eine Klausur 10 Stunden. Sie erreichen in der Klausur eine gute Note, sagen wir mit 50 Punkten."* + +Wir wissen jetzt also, was wir für Sie beobachtet haben: $\color{green}{x'}=10$ und $\color{blue}{y'}=50$. + +Damit wissen wir hier: + +- $U_{\color{green}{x'}}=10$ +- $U_{\color{blue}{y'}}=\color{blue}{y'}-2\cdot \color{green}{x'}= 50 - 2 \cdot 10 = 30$ + +*Mit anderen Worten:* Wir haben die beobachteten Daten $\color{green}{x'}, \color{blue}{y'}$ genutzt, um unser Wissen über $U_{\color{green}{X}}$ und $U_{\color{blue}{Y}}$ zu aktualisieren. + +## Aktion + +*"Hätte ich mehr gelernt, zum Beispiel 20 Stunden..."* + +Wir wollen also wissen, was wäre der Effekt einer Handlung im Sinne von $do(\color{green}{x}=20)$, also anstelle von + +$$\color{green}{X} = U_{\color{green}{X}}$$ + +lautet das aktualisierte, modifizierte kausale Modell + +$$do(\color{green}{x})=20.$$ + +Der Rest bleibt aber unverändert – inbesondere gehen wir weiterhin davon aus, dass für *Sie* $U_{\color{blue}{Y}}=30$ ist. + + +## Vorhersage + +Im modifizierten Modell gilt dann mit + +$$do(\color{green}{x})=20$$ + +und gegeben die Beobachtung $\color{green}{x'}=10, \color{blue}{y'}=50$ + +- ($U_{\color{green}{x'}}=10$) +- $U_{\color{blue}{y'}}=\color{blue}{y'}-2\cdot \color{green}{x'}= 50 - 2 \cdot 10 = 30$ + +für das Counterfactual: + +$$\color{blue}{y}=2\cdot\color{green}{x}+\underbrace{U_{\color{blue}{y}}}_{=U_{\color{blue}{y'}}}=2\cdot 20 + 30 = 70.$$ + +Dass die Bestimmung des Counterfactuals in diesem karikierten Beispiel so einfach war, liegt daran, dass wir nur zwei Variablen und für diese auch noch ein lineares datengenerierendes Modell angenommen haben. + +```{r vorhersage, echo=FALSE} +question("Wie lautet das Counterfactual $y$, wenn $x=10$ ist, sowie $x'=20$ und $y'=30$ beobachtet wurden? Zur Erinnerung, Sie müssen zunächst aus den beobachteten Werten $U_{y'}$ bestimmen und diesen Wert dann im Counterfactual für $U_{y}$ einsetzen.", + answer("$0$"), + answer("$10$", correct = TRUE, message = "Aus $x'=20$ und $y'=30$ folgt über Abduktion, dass $U_{y'}=30-2\\cdot 20 = -10$ ist. Damit gilt: $y=2\\cdot 10 -10 = 10$."), + answer("$20$"), + answer("$40$"), + answer("$50$"), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() + ) +``` + +## Zusammenfassung + +:::{.box} +Die Berechnung eines Counterfactuals erfolgt in 3 Schritten: + +1. **Abduktion:** Nutzen der beobachteten Werte $x', y'$ um die Verteilung der externen, unbekannten Ursachen $U$ zu bestimmen. + +2. **Aktion:** Modifikation des Modells, so dass Pfeile in $X$ gelöscht werden und $X=x$ gilt. + +3. **Vorhersage:** Verwenden des modifizierten Modells aus 2. und der Verteilung von $U$ aus 1., um den erwarteten Wert des Counterfactuals für $Y$ zu bestimmen. +::: + + +## KI-Campus + +[Zurück zum Kurs](https://learn.ki-campus.org/courses/7c8012d9-8729-4462-9ad0-be7d71118f37/launch) diff --git a/Module/Modul_10_KI.Rmd b/Module/Modul_10_KI.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..477afd3dc43863c9b75e7498745da9356072d91d --- /dev/null +++ b/Module/Modul_10_KI.Rmd @@ -0,0 +1,313 @@ +--- +title: "Modul 10: Graphen zeichnen und lesen" +output: + learnr::tutorial: + language: + de: js/tutorial_de.json + progressive: true + css: "css/style.css" +runtime: shiny_prerendered +--- + +<a href="https://ki-campus.org/"> +<img border="0" alt="KICampusLogo" src="images/KIcampusLogo.png" width="100" height="30" style="float: right"> +</a> + +```{r setup, include=FALSE} +library(ggplot2) +library(ggdag) +theme.fom <- theme_classic(22*1.04) +theme.fom <- theme.fom +theme_set( + theme.fom +) + +# deutsche Version von random_praise +source("random-praise_de/translation_random-praise_de.R") + + +library(learnr) +library(mosaic) +library(DT) + +set.seed(1896) + +# Stichprobenumfang +n <- 1000 +# Faehigkeit N(100,15) verteilt +faehigkeit <- rnorm(n, mean = 100, sd = 15) +# Geschlecht B(0.5) verteilt +geschlecht <- sample(c("w","m"), size = n, replace = TRUE) + +# "Aufstieg" ins Management ab einer faehigkeit von 115 für Männer, ab 130 für Frauen +vorstand <- ifelse(((geschlecht == "m" & faehigkeit > 115) | + (geschlecht == "w" & faehigkeit > 130)), + "j","n") + +# Gehalt: Faehigkeit * 10 * 2 (wenn Vorstand) * 1.05 (wenn Mann) +gehalt <- faehigkeit * 10 * + ifelse(vorstand == "j", 2, 1) * + ifelse(geschlecht == "m", 1.05, 1) + +# Datentabelle zusammensetzen +GPG <- data.frame( + geschlecht = geschlecht, + faehigkeit = round(faehigkeit), + vorstand = vorstand, + gehalt = round(gehalt,-2)) +``` + +## Lernziele + +In diesem Modul lernen Sie: + +- einen Graphen anhand einer angenommenen Kausalstruktur zu zeichnen; +- daraus die Konsequenz für die kausale Schlussfolgerung zu ziehen; +- eine Simulation für die Gender-Pay-Gap in R. + +## Eine Schlagzeile + +Eine Schlagzeile vom 16.11.2020 lautet ([Link](https://www.zeit.de/news/2020-11/16/frauen-im-vorstand-von-dax-firmen-verdienen-mehr-als-maenner)): + +> Frauen in Firmen-Vorständen sind besser bezahlt als Männer + +Kann das sein? Mensch denkt doch immer eher, dass Frauen im Job (und beim Gehalt) *benachteiligt* werden. + +Aber beides kann gleichzeitig stimmen: Frauen können im Job benachteiligt werden *und* Frauen können als Vorstand ein höheres Gehalt erzielen als Männer. + +Korrelation bedeutet nicht Kausalität. Mediatoren, Confounder und Collider lauern überall und können Verzerrungen (Bias) erzeugen. +Um Kausalität zu untersuchen müssen wir über den datengenerierenden Prozess nachdenken: Wie sind die Daten entstanden? Hier: Wie kommen die Gehälter von Frauen und Männern in Vorstandspositionen zustande? + +Und dies haben Sie in diesem Kurs gelernt 🏆 + +## Die Annahmen + +Hier unsere qualitativen Annahmen des datengenerierenden Prozesses: + +1. Die *Fähigkeit* für den (Vorstands-)Job ist unabhängig vom *Geschlecht*. + +2. Ob jemand in den *Vorstand* kommt, hängt ab von der *Fähigkeit* und dem *Geschlecht*. +(Für letzteres kann es unterschiedlichste Erklärungen geben: Beispielsweise kann es sein, dass Frauen weniger in solche Positionen befördert werden; es kann aber auch sein, dass sie sich weniger für solche Positionen interessieren.) + +3. Das *Gehalt*, das eine Person bekommt, hängt ab von der *Fähigkeit*, von der Tätigkeit als *Vorstand* und zumindest potentiell auch vom *Geschlecht*. + +```{r pfeil1, echo=FALSE} +question("Gibt es einen Pfeil zwischen *Fähigkeit* und *Geschlecht*?", + answer("Ja, in der Form *Fähigkeit* $\\rightarrow$ *Geschlecht*."), + answer("Ja, in der Form *Geschlecht* $\\rightarrow$ *Fähigkeit*."), + answer("Nein.", correct = TRUE, message = "Wir nehmen hier an, dass es keinen Zusammenhang zwischen *Fähigkeit* und *Geschlecht* gibt, daher gibt es auch keinen Pfeil."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() +) +``` + +<br> + +```{r pfeil2, echo=FALSE} +question("Gibt es einen Pfeil zwischen *Fähigkeit* und *Vorstand*?", + answer("Ja, in der Form *Fähigkeit* $\\rightarrow$ *Vorstand*." , correct = TRUE, message = "Wir nehmen an, dass die Vorstandstätigkeit von der Fähigkeit abhängt – und nicht umgekehrt."), + answer("Ja, in der Form *Vorstand* $\\rightarrow$ *Fähigkeit*."), + answer("Nein."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() +) +``` + +## DAGitty + +[DAGitty](http://dagitty.net/) ist ein einfach, auch im Browser, zu bedienendes Tool, mit dem Sie kausale Diagramme zeichnen (und analysieren) können. + +*Hinweis*: Für die Diagramme innerhalb dieses Kurses wurde das Paket `ggdag` ([https://ggdag.malco.io/](https://ggdag.malco.io/)) verwendet. + +Zeichnen Sie dort – oder auf einem Blatt Papier – das Diagramm, dass folgende Annahmen darstellt: + +1. Die *Fähigkeit* für den (Vorstands-)Job ist unabhängig vom *Geschlecht*. +2. Ob jemand in den *Vorstand* kommt, hängt ab von der *Fähigkeit* und dem *Geschlecht*. +3. Das *Gehalt*, das eine Person bekommt, hängt ab von der *Fähigkeit*, von der Tätigkeit als *Vorstand* und vom *Geschlecht*. + +*Klicken Sie erst danach zur Kontrolle auf `Weiter`* + +## + +<br> + +{width="65%"} + +1. Die *Fähigkeit* für den (Vorstands-)Job ist unabhängig vom *Geschlecht*. Daher kein Pfeil zwischen diesen Variablen. +2. Ob jemand in den *Vorstand* kommt, hängt ab von der *Fähigkeit* und dem *Geschlecht*. Daher sowohl ein Pfeil von *Geschlecht* zu *Vorstand* als auch von *Fähigkeit* zu *Vorstand*. +3. Das *Gehalt*, das eine Person bekommt, hängt ab von der *Fähigkeit*, von der Tätigkeit als *Vorstand* und vom *Geschlecht*. Daher jeweils ein Pfeil von *Fähigkeit*, *Vorstand* und *Geschlecht* zu *Gehalt*. + + +```{r collider, echo=FALSE} +question("Welche Rolle spielt *Vorstand* im Teilgraphen mit *Geschlecht* und *Fähigkeit*?", + answer("Mediator"), + answer("Confounder"), + answer("Collider", correct = TRUE, message = "Korrekt – die beiden Pfeile zeigen beide auf *Vorstand*."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement()) +``` + +## Eine Simulation + +Treffen wir zusätzlich noch quantitative Modellannahmen für das Beispiel: + +1. `faehigkeit` ist normalverteilt mit $\mu=100$ und $\sigma=15$. + +2. `geschlecht` ist bernoulliverteilt mit einer Wahrscheinlichkeit von $\pi=0.5$ für eine Frau. + +3. Ob jemand im Vorstand ist, hängt ab von `faehigkeit` und `geschlecht`. Dies modellieren wir indem ein Mann ab einer `faehigkeit` größer als 115 in den Vorstand kommt, eine Frau erst ab 130. Frauen müssen also fähiger sein als Männer um in den Vorstand zu kommmen – so hier die Annahme. + + +```{r plot, echo=FALSE, fig.align='center', out.width="60%", message=FALSE} +xpnorm(115, mean = 100, sd = 15, return = "plot") %>% gf_labs(title = "Vorstand für Männer", x = "Fähigkeit", y = "Dichte") +xpnorm(130, mean = 100, sd = 15, return = "plot") %>% gf_labs(title = "Vorstand für Frauen", x = "Fähigkeit", y= "Dichte") +``` + + +4. Das `gehalt` setzt sich zusammen aus `faehigkeit` ($\cdot 10$). Es ist im `vorstand` doppelt so hoch und für Männer noch einmal $5\%$ höher. Fähigere Leute verdienen mehr, Mitglieder des Vorstands verdienen mehr und Männer verdienen mehr. +$$\text{gehalt} = \text{faehigkeit} \cdot 10 \cdot \begin{cases}2, \,\text{ist Vorstand} \\ 1, \,\text{sonst} \end{cases} \cdot \begin{cases}1.05, \,\text{ist Mann} \\ 1, \,\text{sonst} \end{cases}.$$ +```{r plot2, echo=FALSE, fig.align='center', out.width="60%", message=FALSE} +mov <- data.frame(x1 = 50, x2 = 115, y1 = 50*10*1.05, y2=115*10*1.05) +miv <- data.frame(x1 = 115, x2 = 150, y1 = 115*10*2*1.05, y2=150*10*2*1.05) +fov <- data.frame(x1 = 50, x2 = 130, y1 = 50*10*1, y2=115*10*1) +fiv <- data.frame(x1 = 130, x2 = 150, y1 = 115*10*2*1, y2=150*10*2*1) +gf_segment(y1 + y2 ~ x1 + x2, data = mov, color = "purple") %>% + gf_segment(y1 + y2 ~ x1 + x2, data = miv, color = "purple") %>% + gf_segment(y1 + y2 ~ x1 + x2, data = fov, color = "orange") %>% + gf_segment(y1 + y2 ~ x1 + x2, data = fiv, color = "orange") %>% + gf_labs(x="Fähigkeit", y="Gehalt") + + annotate("text", label="Männer", x = 60, y= 3000, color = "purple")+ + annotate("text", label="Frauen", x = 60, y= 2500, color = "orange") +``` + + +Um dies in `R` für z. B. $n=1000$ Mitarbeiter:innen zu simulieren kann folgender Code verwendet werden: + +```{r simData} +# Paket aktivieren +library(mosaic) +# Zufallszahlengenerator initiieren +set.seed(1896) + +# Stichprobenumfang +n <- 1000 +# Faehigkeit: N(100,15) verteilt +faehigkeit <- rnorm(n, mean = 100, sd = 15) +# Geschlecht: B(0.5) verteilt +geschlecht <- sample(c("w","m"), size = n, replace = TRUE) + +# "Aufstieg" ins Management: ab einer faehigkeit von 115 für Männer, ab 130 für Frauen +vorstand <- ifelse(((geschlecht == "m" & faehigkeit > 115) | + (geschlecht == "w" & faehigkeit > 130)), + "j","n") + +# Gehalt: Faehigkeit * 10 * 2 (wenn Vorstand) * 1.05 (wenn Mann) +gehalt <- faehigkeit * 10 * + ifelse(vorstand == "j", 2, 1) * + ifelse(geschlecht == "m", 1.05, 1) + +# Datentabelle zusammensetzen, Werte runden +GPG <- data.frame( + geschlecht = geschlecht, + faehigkeit = round(faehigkeit), + vorstand = vorstand, + gehalt = round(gehalt,-2)) +``` + +<br> +<span style="color:#301a87;">➢</span> Ein Einblick in die simulierten Daten: + +```{r, echo=FALSE} +datatable(GPG) +``` + + +## Analyse 1 + +Wie konstruiert gemäß unserer Annahmen: + +Es gibt keine nennenswerten Unterschiede (hier: im arithmetischen Mittelwert, engl. mean; Funktion `mean()`) in der Fähigkeit zwischen den Geschlechtern: + +```{r meanf} +mean(faehigkeit ~ geschlecht, data = GPG) +``` + +Und im Gehalt? + +Ändern Sie den Code so, dass Sie den arithmetischen Mittelwert der Variable `gehalt` je Geschlecht ausgeben: + +```{r meang, exercise = TRUE} +mean(faehigkeit ~ geschlecht, data = GPG) +``` + +```{r meang-solution} +mean(gehalt ~ geschlecht, data = GPG) +``` + +## + +Wie konstruiert: + +Männer verdienen im Durchschnitt mit `r round(mean(gehalt ~ geschlecht, data = GPG))[1]` mehr als Frauen, deren Durchschnittsgehalt hier bei `r round(mean(gehalt ~ geschlecht, data = GPG))[2]` liegt. + +## Analyse 2 + +Was passiert, wenn wir uns auf die Vorstandsmitglieder beschränken, d. h., wir wählen (`filter`) nur die Beobachtungen aus, die die Bedingung erfüllen, dass sie im Vorstand sind (`vorstand == "j"`): + +```{r meangvorstande, exercise = TRUE} +GPG %>% + filter(vorstand == "j") %>% + mean(gehalt ~ geschlecht, data = .) +``` + +## + +```{r meangvorstand} +GPG %>% + filter(vorstand == "j") %>% + mean(gehalt ~ geschlecht, data = .) +``` + +Obwohl Männer nach Konstruktion insgesamt mehr verdienen, verdienen Frauen im Vorstand mehr. + +Warum? + +Weil sie fähiger sein mussten, um in den Vorstand zu kommen. + +Kontrollieren Sie dies, indem Sie den Code so abändern, dass Sie den arithmetischen Mittelwert der Variable `faehigkeit` je Geschlecht für die Vorstandsmitglieder ausgeben. + +```{r meanfvorstand, exercise = TRUE} +GPG %>% + filter(vorstand == "j") %>% + mean(gehalt ~ geschlecht, data = .) +``` + +```{r meanfvorstand-solution} +GPG %>% + filter(vorstand == "j") %>% + mean(faehigkeit ~ geschlecht, data = .) +``` + +<br> + +Und das Gehalt hängt ja, neben dem Geschlecht und der Tätigkeit im Vorstand auch von der Fähigkeit ab – so hier die Annahme. + +## Verzerrung + +Wie in Modul 6 besprochen: + +Adjustierung eines Colliders (Tätigkeit im Vorstand) erzeugt eine Verzerrung, es wird ein Scheinzusammenhang erzeugt, der den Effekt des Geschlechts auf das Gehalt verzerrt. Mit [DAGitty](http://dagitty.net/) kann dies schön gezeigt werden: + +{width="75%"} + +Das folgende Vidoeo zeigt eine kurze Einführung in die Bedienung von DAGitty anhand dieses Beispiels: + +{width="75%"} + + +## KI-Campus + +[Zurück zum Kurs](https://learn.ki-campus.org/courses/7c8012d9-8729-4462-9ad0-be7d71118f37/launch) diff --git a/Module/Modul_11_KI.Rmd b/Module/Modul_11_KI.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..58b4721cafe7280fb40a4de95938870730c74c2d --- /dev/null +++ b/Module/Modul_11_KI.Rmd @@ -0,0 +1,301 @@ +--- +title: "Modul 11: Schadet Rauchen Heranwachsenden?" +output: + learnr::tutorial: + language: + de: js/tutorial_de.json + progressive: true + css: "css/style.css" +runtime: shiny_prerendered +--- + +<a href="https://ki-campus.org/"> +<img border="0" alt="KICampusLogo" src="images/KIcampusLogo.png" width="100" height="30" style="float: right"> +</a> + +```{r setup, include=FALSE} +library(ggplot2) +library(ggdag) +theme.fom <- theme_classic(22*1.04) +theme.fom <- theme.fom +theme_set( + theme.fom +) + +# deutsche Version von random_praise +source("random-praise_de/translation_random-praise_de.R") + +# coordLV <- list( +# x = c(Geschlecht = 0, Alter = 0, RaucherIn = 1, Groesse = 2, Lungenvolumen = 3), +# y = c(Geschlecht = 1, Alter = 2, RaucherIn = 0, Groesse = 2, Lungenvolumen = 0)) +# +# dagLV <- dagify(Groesse ~ Geschlecht + Alter + RaucherIn, +# RaucherIn ~ Geschlecht + Alter, +# Lungenvolumen ~ Groesse + Geschlecht + Alter + RaucherIn, +# coords = coordLV, +# exposure = "RaucherIn", +# outcome = "Lungenvolumen") +# +# +# p1 <- ggdag(dagLV, text_col = "blue") + theme_dag_blank() + + +library(learnr) +library(mosaic) +library(DT) + +load("data/LV.Rdata") + +p1 <- DiagrammeR::grViz(" +digraph { +rankdir = LR; + graph [] + node [shape = circle fontcolor = black fontname = Poppins fontsize = 11 style = filled] + A [label = ' Größe '] + B [label = ' Geschlecht '] + C [label = ' Alter '] + D [label = ' RaucherIn ' fillcolor = '#0F710B' fontcolor = white, valign = 'bottom'] + E [label = 'Lungenvolumen' fillcolor = '#0033cc' fontcolor = white] + edge [minlen = 2] + {B; C} -> {A; E; D} [penwidth = .5] + D -> {A; E} [penwidth = .5] + A -> E [penwidth = .5] +} +") +``` + +## Lernziele + +In diesem Modul lernen Sie: + +- die Bestimmung eines kausalen Effekts mit Hilfe einer linearen Regression in `R` anhand eines realen Beispiels; +- wie Sie bestimmen können, welche Variablen in der Praxis adjustiert werden müssen. + + +## Rauchen bei Kindern und Jugendlichen + +Bisher haben wir oft mit simulierten Beispielen gearbeitet um die Grundlagen der Kausalinferenz herauszuarbeiten. Lassen Sie uns nun das Gelernte auf echte Daten anwenden. + +Wie auch beim menschlichen Beitrag zum Klimawandel gibt es inzwischen recht große Einigkeit bei der Frage, ob Rauchen der Gesundheit schadet. + +Aber das war nicht immer so, und eine naive Datenanalyse kann sogar zu einem gegenteiligen Ergebnis kommen. + +In einer Reihe von Papern (siehe z. B. [Kahn, 2005](https://doi.org/10.1080/10691898.2005.11910559)) wurde der Frage nachgegangen, inwieweit Rauchen das sogenannte *forcierte exspiratorische Volumen* bei Heranwachsenden beeinflusst. +Hierbei handelt es sich um eine Kennzahl der Lungenfunktion, das Lungenvolumen beim forcierten Ausatmen. + + +```{r ethik, echo=FALSE} +question("Ist hier ein randomisiertes Experiment ethisch vertretbar?", + answer("Ja."), + answer("Nein.", correct = TRUE, message = "Es sind negative Folgen bei den Teilnehmer:innen, die im Experiment den Raucher:innen zugeordnet werden, zu erwarten. Wie Sie aber im Interview mit Anne Brenøe gehört haben, können Variationen von Manipulationen durchaus ethisch vertretbar sein – beispielsweise könnte man randomisiert zuweisen, wer an einer Intervention zum Beendigen des Rauchens teilnehmen darf."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() +) +``` + +## + +Die hier verwendete Datentabelle `LV` enthält Beobachtungsdaten und hat folgende Struktur: + +```{r str} +str(LV) +``` + +mit den Variablen: + +- `Alter`: Alter in Jahren +- `Lungenvolumen`: forcierte exspiratorische Volumen in l +- `Groesse`: Größe in cm +- `Geschlecht`: `m` für männlich und `w` für weiblich (damals wurde kein diverses Geschlecht erhoben) +- `RaucherIn`: Hat die Person geraucht? `ja` oder `nein` + +Übersicht über die Daten von [Kahn, 2005](https://doi.org/10.1080/10691898.2005.11910559) : + +```{r head, echo = FALSE} +datatable(LV) +``` + + +## + +Aus inhaltlichen Gründen werden folgende Kausalzusammenhänge zwischen den Variablen angenommen: + +```{r, echo=FALSE} +p1 +``` + +Zu Erinnerung: Es handelt sich um Heranwachsende -- deswegen die Annahme, dass das Rauchen die Größe beeinflussen kann. + +## Rauchen und Lungenvolumen + +Ein Boxplot des Lungenvolumens in Abhängigkeit des Rauchverhaltens ergibt folgendes Ergebnis: + +```{r b1} +gf_boxplot(Lungenvolumen ~ RaucherIn, data = LV) %>% + gf_jitter(width = 0.2, height = 0, alpha = 0.15) +``` + +```{r median, echo=FALSE} +question("Welche Gruppe hat im Median das größere Lungenvolumen?", + answer("Die Nichtraucher:innen."), + answer("Die Raucher:innen.", correct = TRUE, message = "Während der Median bei den Nichtraucher:innen bei ca. 2.5 l liegt, liegt er bei den Raucher:innen bei ca. 3.2 l."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement()) +``` + +## Die Rolle des Geschlechts + +Sowohl Rauchen als auch Lungenvolumen hängen vom Geschlecht ab. + +Wenn wir zusätzlich nach Geschlecht aufteilen ergibt sich folgende Abbildung: + +```{r bedingtn} +gf_boxplot(Lungenvolumen ~ RaucherIn | Geschlecht, data = LV) +``` + + +Das Bild hat sich nicht geändert, Raucher:innen scheinen immer noch das größere Lungenvolumen zu haben. + +Woran könnte das liegen? + +## Die Rolle des Alters + +Natürlich gibt es auch einen Zusammenhang zwischen der Größe und dem Lungenvolumen: + +```{r, message=FALSE} +gf_point(Lungenvolumen ~ Groesse, data = LV) %>% + gf_smooth() +``` + +Aber auch zwischen Alter und Größe: + +```{r, message=FALSE} +gf_point(Groesse ~ Alter, data = LV) %>% + gf_smooth() +``` + +<br> + +Und zwischen Rauchen und Alter: + + +```{r, message=FALSE} +gf_boxplot(Alter ~ RaucherIn, data = LV) %>% + gf_jitter(width = 0.2, height = 0.2, alpha = 0.15) +``` + +## Kausale Modellierung Rauchen und Lungenvolumen + +Hier noch einmal das angenommene Modell: + +```{r p12, echo=FALSE} +p1 +``` + + +Eine naive Modellierung ohne Berücksichtigung von Drittvariablen ergibt folgendes Ergebnis, das wir schon dem Boxplot entnehmen konnten: + +```{r} +lm(Lungenvolumen ~ RaucherIn, data = LV) %>% + summary() +``` + +Raucher:innen haben *scheinbar* ein höheres Lungenvolumen: + +$$\widehat{\text{Lungenvolumen}} = 2.57 + 0.71 \cdot \begin{cases} 1 &: \text{RaucherIn = Ja} \\ 0&: \text{sonst} \end{cases}$$ + +## + +```{r p123, echo=FALSE} +p1 +``` + +Dieser Zusammenhang ist verzerrt, weil nicht-kausale Pfade durch die *Hintertür* (engl. backdoor) offen sind: + +$$\text{RaucherIn} \leftarrow \text{Geschlecht} \rightarrow \text{Lungenvolumen}$$ +sowie + +$$\text{RaucherIn} \leftarrow \text{Alter} \rightarrow \text{Lungenvolumen}$$ +Diese Pfade sollten also durch Adjustierung *blockiert* werden. + + +```{r chain, echo=FALSE} +question("Sollte darüber hinaus auch für die Variable `Groesse` adjustiert werden?", + answer("Ja."), + answer("Nein.", correct = TRUE, message = "Die Variable `Groesse` liegt auf dem kausalen Pfad (*Kette*) zwischen `RaucherIn` und `Lungenvolumen` (*Mediator*). Solche Mediatoren sollten nicht adjustiert werden. Was würde hier passieren, wenn wir es trotzdem ins Modell aufnehmen würden? Wir würden reale, durch das Rauchen verursachte Unterschiede wegadjustieren und dadurch die Effekte des Rauchens auf das Lungenvolumen unterschätzen."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement()) +``` + +## + +Geben Sie – unter der Annahme eines linearen Modells – die Formel an, die den (totalen) kausalen Effekt des Rauchens auf das Lungenvolumen schätzt. + +Zur Erinnerung: die Namen der Variablen im Datensatz waren <br> +`Alter`, `Lungenvolumen`, `Groesse`, `Geschlecht` und `RaucherIn`. + +```{r model, exercise = TRUE, eval=FALSE} +lm(Lungenvolumen ~ RaucherIn + ___ + ___, data = LV) %>% + summary() +``` + +```{r model-hint} +"Ergänzen Sie im Modell die zu adjustierenden Variablen Geschlecht und Alter." +``` + +```{r model-solution} +lm(Lungenvolumen ~ RaucherIn + Geschlecht + Alter, data = LV) %>% + summary() +``` + + +```{r effekt, echo=FALSE} +question("Hat in dem Modell Rauchen den zu erwartenden negativen Effekt auf das Lungenvolumen?", + answer("Ja.", correct = TRUE, message = "Der geschätzte Koeffizient (`Estimate`) ist mit $-0.153974$ negativ (für die Variable `RaucherInja `)."), + answer("Nein."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement()) +``` + +*Anmerkung*: Das lineare Modell stellt hier nur eine pragmatische Näherung da, weil es nicht-lineare Zusammenhänge zwischen Alter und Größe sowie Größe und Lungenvolumen gibt. Um den Effekt des Rauchens präzise zu schätzen, sollten diese nicht-linearen Zusammenhänge auch wirklich nicht-linear modelliert werden. + +## Simpson-Paradoxon + +In diesem Beispiel haben Sie erfahren, dass sich beobachtete Zusammenhängen deutlich von den wahren kausalen Zusammenhängen unterscheiden können – sogar so weit, dass insgesamt ein positiver Zusammenhang beobachtet wird (Raucher:innen haben ein höheres Lungenvolumen), während in einer adjustierten Betrachtung ein negativer Zusammenhang vorliegt. Dies ist ein Beispiel für das **Simpson-Paradoxon**. + +{width="75%"} + +## Ausblick: Adjustment Sets + +Natürlich könnten Sie für den Zusammenhang zwischen Rauchen und Lungenvolumen noch einen viel komplexeren Graphen erstellen, der zahlreiche potentielle Konfundierende enthält. + +Müssten wir, wenn wir einen solchen Graphen annehmen, dann automatisch immer für alle Konfundierenden adjustieren? + +Tatsächlich gibt es manchmal Situationen, in denen selbst mit weniger Kontrolle unverzerrte Effekte geschätzt werden können. +Das liegt daran, dass manchmal einzelne Variablen auf mehreren konfundierenden Pfaden liegen. +Somit kann das Berücksichtigen einer einzelnen Variable manchmal mehrere "Probleme" auf einmal lösen. + +Ob die Adjustierung für eine Menge an Variablen (für ein *Adjustment Set*) hinreichend ist, um einen kausalen Effekt von Interesse zu identifizieren, kann u.a. mithilfe des sogenannten *Back-Door Criterion* (Hintertür-Kriterium) bestimmt werden. +Wenn Sie die präzise Formulierung dieses Kriteriums interessiert, können Sie es in Judea Pearls Artikel ["Causal Diagrams for Empirical Research"](http://bayes.cs.ucla.edu/R218-B.pdf) nachlesen. +Exemplarische Beispiele für die Auswirkungen von Variablen bietet der ["A Crash Course in Good and Bad Controls"](https://ftp.cs.ucla.edu/pub/stat_ser/r493.pdf) von Cinelli et al.. + +Hinreichende Adjustment Sets lassen sich praktischerweise algorithmisch bestimmten. +Wenn Sie beispielsweise den angenommenen kausalen Graphen in [DAGitty](http://dagitty.net/) (siehe Modul 10) zeichnen, dann bestimmt die Software automatisch alle existierenden *minimal sufficient adjustment sets*, also die kleinstmöglichen Adjustment Sets, die ausreichen, um den kausalen Effekt zu identifizieren. + + + +## Hinweis + +Dieses Modul orientiert sich am Projekt [Causal Inference in Introductory Statistics Courses](https://github.com/kfcaby/causalLab) von [LTC Kevin Cummiskey](https://westpoint.edu/mathematical-sciences/profile/kevin_cummiskey). +Siehe auch Cummiskey, K., Adams, B,. Pleuss, J., Turner, D., Clark, N. \& Watts, K. (2020). *Causal Inference in Introductory Statistics Courses*, Journal of Statistics Education, [https://doi.org/10.1080/10691898.2020.1713936](https://doi.org/10.1080/10691898.2020.1713936). + +Datengrundlage ist der Artikel von Kahn, M. (2005). *An exhalent problem for teaching statistics*. Journal of Statistics Education, 13(2), [https://doi.org/10.1080/10691898.2005.11910559](https://doi.org/10.1080/10691898.2005.11910559). + + +## KI-Campus + +[Zurück zum Kurs](https://learn.ki-campus.org/courses/7c8012d9-8729-4462-9ad0-be7d71118f37/launch) diff --git a/Module/Modul_12_KI.Rmd b/Module/Modul_12_KI.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..ba88a00bb81a770ab56a579345fd3350117559ce --- /dev/null +++ b/Module/Modul_12_KI.Rmd @@ -0,0 +1,353 @@ +--- +title: "Modul 12: Praktisches Daten Hinterfragen" +output: + learnr::tutorial: + language: + de: js/tutorial_de.json + progressive: true + css: "css/style.css" +runtime: shiny_prerendered +--- + +<a href="https://ki-campus.org/"> +<img border="0" alt="KICampusLogo" src="images/KIcampusLogo.png" width="100" height="30" style="float: right"> +</a> + +```{r setup, include=FALSE} +library(ggplot2) +library(ggdag) +library(ggraph) +theme.fom <- theme_classic(22*1.04) +theme.fom <- theme.fom +theme_set( + theme.fom +) + +# deutsche Version von random_praise +source("random-praise_de/translation_random-praise_de.R") + +# coordCof <- list( +# x = c(Kaffeekonsum = 0, Fehlgeburt = 2, Uebelkeit = 0.5, U = 1.5), +# y = c(Kaffeekonsum = 1, Fehlgeburt = 1, Uebelkeit = 0, U = 0)) +# +# dagCof <- dagify(Kaffeekonsum ~ Uebelkeit, +# Uebelkeit ~ U, +# Fehlgeburt ~ U + Kaffeekonsum, +# coords = coordCof, +# exposure = "Kaffeekonsum", +# outcome = "Fehlgeburt") +# +# p1 <- ggdag(dagCof, text_col = "blue", node = FALSE) + theme_dag_blank() + +p1 <- DiagrammeR::grViz(" +digraph { +rankdir = LR; +ranksep = 0.7; + graph [] + node [shape = circle fontcolor = black fontname = Poppins fontsize = 6 style = filled] + A [label = 'Kaffeekonsum' fillcolor = '#0F710B' fontcolor = white] + B [label = ' Fehlgeburt ' fillcolor = '#0033cc' fontcolor = white] + C [label = ' Übelkeit '] + U [label = ' U '] + edge [minlen = 2] + A -> B [penwidth = .2] + C -> A [penwidth = .2] + U -> {B; C} [penwidth = .2] +{rank = same; A; C} +{rank = same; B; U} +} +") + + +# coordLif <- list( +# x = c(robust = 0, gesell = 0, fuenf = 1, siebzig = 2), +# y = c(robust = 2, gesell = 0, fuenf = 1, siebzig = 1)) +# dagLif <- dagify(fuenf ~ robust + gesell, +# siebzig ~ fuenf + robust + gesell, +# exposure = "gesell", +# outcome = "siebzig", +# labels = c("robust" = "Intrinsische\n Robustheit", +# "gesell" = "Art der Gesellschaft", +# "fuenf" = "Bis 5 Überleben", +# "siebzig" = "Bis 70 Überleben"), +# coords = coordLif) +# p2 <- ggdag(dagLif, text = FALSE, text_col = "blue", use_labels = "label", label_col = "blue") + +# theme_dag_blank() + +p2 <- DiagrammeR::grViz(" +digraph { +rankdir = LR; + graph [] + node [shape = circle fontcolor = black fontname = Poppins fontsize = 11 style = filled] + A [label = 'Intrinsische Robustheit'] + B [label = ' Art der Gesellschaft ' fillcolor = '#0F710B' fontcolor = white] + C [label = ' Bis 5 Überleben '] + D [label = ' Bis 70 Überleben ' fillcolor = '#0033cc' fontcolor = white] + edge [minlen = 2] + {A; B} -> {C; D} [penwidth = .5] + C -> D [penwidth = .5] +} +") + + +library(learnr) +library(mosaic) +``` + +## Lernziele + +In diesem Modul lernen Sie: + +- wie das praktische Hinterfragen von Daten in der Anwendung aussehen kann; + +- was es noch Spannendes im Bereich Kausalinferenz zu lernen gibt. + + +## Korrelation und Kausalität + + +Korrelation bedeutet nicht Kausalität – und keine Korrelation bedeutet nicht keine Kausalität. + +[Bueno de Mesquita und Fowler (2021)](https://press.princeton.edu/books/paperback/9780691214351/thinking-clearly-with-data) bringen es auf den Punkt: Es gilt: + +$$ +Beobachtete \, Korrelation = Kausaler\,Effekt + Verzerrung + Rauschen +$$ + +Wir hoffen, dass dieser Kurs mit seinen Beispielen Ihnen helfen kann, systematische *Verzerrung* zu adressieren. + +*Rauschen* entsteht darüber hinaus durch (zufällige, unsystematische) Stichprobenvariation. + +## Das Problem mit den vereinfachten Beispielen + +Im Rahmen dieses Kurses haben Sie gelernt, wie kausale Effekte definiert werden und wie man mithilfe von kausalen Graphen Annahmen abbilden und *unter diesen Annahmen* valide Schlußfolgerungen ablesen kann. + +Aber alle Graphen, die Sie gesehen haben, waren stark vereinfacht und enthielten nur wenige Variablen. +In der Realität sieht es natürlich viel komplexer aus – Graphen können hunderte Variablen beinhalten, darunter oft auch solche die sich schlecht messen lassen oder sogar unbeobachtbar sind. + +An vielen Stellen wissen wir schlicht und ergreifend nicht, wie das zugrundeliegende kausale Netz aussieht. + + +```{r unsicher, echo=FALSE} +question("Angenommen, wir kennen den wahren zugrundeliegenden kausalen Graphen nicht sicher und wollen trotzdem aus Beobachtungsdaten auf kausale Effekte schließen. + Können wir immer noch voll überzeugt sein, dass unsere Schlußfolgerungen stimmen?", + answer("Ja."), + answer("Nein.", correct = TRUE, message = "Unsicherheit über den kausalen Graphen führt zu Unsicherheit darüber, ob unsere Schlußfolgerungen korrekt sind. + Beispielsweise können wir oft nicht komplett ausschließen, dass zusätzliche unbeobachtete Confounder unsere Ergebnisse verzerren."), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() +) +``` + +## Perfect is the enemy of good + +Das ist aber kein Grund, das Handtuch zu werfen! + +Schlußfolgerungen sind immer mit gewissen Unsicherheiten behaftet. Selbst wenn Sie das zugrundeliegende kausale Netz perfekt kennen, kann Zufallsrauschen immer noch zu falschen Ergebnissen führen. Und selbst komplexe wissenschaftliche Modelle sind immer eine vereinfachte Darstellung der Realität. + +*** + +***Anmerkung:*** Die Wissenschaftsphilosophin Angela Potochnik beschäftigt sich in ihrem Buch [Idealization and the Aims of Science"](https://www.angelapotochnik.com/idealization.html) ausführlich mit der zentralen Rolle, die Vereinfachungen in der Wissenschaft spielen -- selbst in Grundlagenfächern wie der Physik. + +*** + +Selbst wenn wir nicht den kompletten kausalen Graphen kennen, hilft uns das Wissen über die fundamentalen kausalen Strukturen aber, kausale Schlußfolgerungen kritisch zu hinterfragen und mögliche Verzerrungen zu erkennen. + + +## Beispiel 1: Kaffeekonsum und Fehlgeburten + +Beobachtungsstudien berichten eine Korrelation zwischen Kaffeekonsum in der Schwangerschaft und Fehlgeburten. +Ein kausaler Effekt ist hier nicht unbedingt unplausibel: Koffein kann bei Schwangeren die Plazenta durchqueren. +Deswegen wird oft empfohlen, Kaffee und andere koffeinhaltige Getränke in der Schwangerschaft ganz zu meiden. +Aber gibt es hier wirklich einen kausalen Effekt, der diese Empfehlung rechtfertigt? + +Der Kaffeekonsum in der Schwangerschaft hängt von vielen Faktoren ab. +Beispielsweise leiden gerade im ersten Trimester viele unter Übelkeit, die ihnen die Lust auf Kaffee raubt. + +Unabhängig davon berichten Studien, dass Übelkeit und Erbrechen in der Schwangerschaft *negativ* mit dem Risiko für eine Fehlgeburt korrelieren. +Eine mögliche Erklärung ist, dass die Übelkeit von Hormonen verursacht wird, die in einer gesunden Schwangerschaft reichlich vorhanden sind. + + +```{r kaffee, echo=FALSE} +question("Auf welche fundamentale kausale Struktur zwischen Kaffeekonsum, Übelkeit und Fehlgeburt deutet dies hin?", + answer("Eine Kette"), + answer("Eine Gabel", correct = TRUE, message = "Übelkeit beeinflußt den Kaffeekonsum, Übelkeit korreliert mit einem niedrigeren Risiko für eine Fehlgeburt. + Damit könnte Übelkeit ein Confounder sein oder zumindest auf einem konfundierendem Pfad liegen, bei dem eine unbeobachtete Variable (z.B. Hormone) sowohl Übelkeit als auch das Fehlgeburtsrisiko beeinflußt."), + answer("Eine umgedrehte Gabel"), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement() +) +``` + +## Kaffee-Graph + +<center> +```{r p1, echo=FALSE, out.width="40%"} +p1 +``` +</center> + +Studien, die für Übelkeit als Variable auf einem potentiellen konfundierenden Pfad ($Kaffeekonsum \leftarrow Übelkeit \leftarrow U \rightarrow Fehlgeburt$) adjustieren, finden tendenziell schwächere Zusammenhänge. + +Die Idee, dass Übelkeit auf einem konfundierenden Pfad liegt, wird auch dadurch gestützt, dass Studien insgesamt weniger konsistente Zusammenhänge zwischen Fehlgeburten und dem Konsum anderer koffeinhaltiger Getränke (z. B. Tee oder Cola) finden. +Diese enthalten zwar Koffein, werden aber oft bei Übelkeit in der Schwangerschaft als weniger abstoßend empfunden. + +Insgesamt schlußfolgert beispielsweise das [American College of Obstetricians and Gynecologist (2020)](https://www.acog.org/clinical/clinical-guidance/committee-opinion/articles/2010/08/moderate-caffeine-consumption-during-pregnancy), dass moderater Koffeinkonsum (weniger als 200mg am Tag) kein Risikofaktor zu sein scheint. +Für größere Mengen an Koffein in der Schwangerschaft kann zu diesem Zeitpunkt keine sichere Schlußfolgerung gezogen werden. + +*** + +***Anmerkung:*** Die Zusammenhänge zwischen Kaffeekonsum, Übelkeit und Fehlgeburten werden in dem Buch "Expecting Better" von der Ökonomin Emily Oster genauer diskutiert. (Deutscher Titel: "Das einzig wahre Baby-Handbuch") + +*** + + +## Beispiel 2: Lebenserwartung in Jäger- und Sammlergesellschaften + +Hier ein Beispiel, das bereits im Interview mit Richard McElreath aufgekommen ist. + +Alle Evidenz deutet darauf hin, dass in prähistorischen Jäger- und Sammlergesellschaften die Lebenserwartung bei der Geburt mit etwa 25 Jahren sehr viel niedriger lag, als sie es heutzutage ist. + +Allerdings wird immer wieder das Argument angebracht, dass diese niedrige Zahl vor allem mit der hohen Säuglings- und Kindersterblichkeit zusammenhängt. +Wenn prähistorische Menschen es bis ins Jugendlichenalter schafften, so überlebten sie wahrscheinlich oft bis ins hohe Alter. + +Ähnliche Beobachtungen werden auch für noch existierende Jäger- und Sammlergesellschaften gemacht: Während die Sterblichkeit am Anfang des Lebens deutlich höher ist, so nimmt sie radikal ab, sobald die ersten Jahre überstanden sind. +Eine Lebensspanne von 70 Jahren ist dann nichts Ungewöhnliches. + +## Zurück in die Steinzeit? + +Diese Beobachtungen werden manchmal aufgegriffen, um Argumente zu verschiedenen Lebensstilen zu machen. + +Wenn Jäger und Sammler trotz fehlender Gesundheitsversorgung oft so alt werden, spricht das etwa dafür, dass ihr Lebensstil besonders gesund ist? + +Oder könnte man am Ende sogar schlußfolgern, dass die moderne Medizin uns gar nicht so viel langlebiger macht? + +Dass sich die Situation für Komplikationen bei Geburt und in den jungen Jahren verbessert hat, ist klar. +Aber was passiert danach? +Vielleicht werden die Effekte, die uns die moderne Medizin bringt, komplett aufgehoben von dem gesteigerten Risiko, sogenannten Zivilisationskrankheiten zu erliegen? + + +## Überlebens-Graph + +Aber bevor wir mit solchen Spekulationen beginnen, sollten wir uns zuerst Gedanken darüber machen, wie diese Daten – niedrige Lebenserwartung ab Geburt, recht hohe Lebenserwartung *nach überstandener Kindheit* – zustande kommen. + +<center> +```{r p2, echo=FALSE, out.width='60%'} +p2 +``` +</center> + +Menschen unterscheiden sich von Geburt an in bestimmten Faktoren, welche von Genen beeinflußt sind. +Beispielsweise sind manche Menschen besonders anfällig für Infekte, andere hatten mehr Glück und haben sehr fitte Immunsysteme. + +All solche Unterschiede haben wir hier unter *Intrinsischer Robustheit* zusammengefasst. +Nun interessiert uns, wie sehr die Gesellschaft, in der wir leben (Jäger und Sammler vs. modern), beeinflusst, ob wir unseren 70. Geburtstag erleben – und zwar unabhängig von den Effekten auf das Überleben bis zum 5. Geburtstag. + + +```{r chain, echo=FALSE} +question("Welche Rolle spielt \"Bis 5 Überleben\" im Teilgraphen mit \"Intrinsische Robustheit\" und \"Art der Gesellschaft\"", + answer("Mediator"), + answer("Confounder"), + answer("Collider", correct = TRUE, message = "Korrekt – die beiden Pfeile zeigen beide auf die \"Bis 5 Überleben\""), + allow_retry = TRUE, + correct = random_praise(), + incorrect = random_encouragement()) +``` + +## + +Wenn wir für die beiden Arten von Gesellschaft jeweils berechnen, wie hoch die Lebenserwatung für eine Person ist, die das 5. Lebensjahr erreicht hat, dann sind unsere Analysen bedingt auf die Variable "Bis 5 Überleben." +Diese ist jedoch ein Collider auf dem Pfad zwischen "Intrinsische Robustheit" und "Art der Gesellschaft." +Somit führen unsere Analysen zu einer nicht-kausalen Korrelation zwischen intrinsischer Robustheit und der Art der Gesellschaft. + +Der Vergleich der beiden Lebenserwartungen bedingt auf das Überleben bis ins 5. Lebensjahr ist damit ein verzerrter Schätzer für den direkten Effekt von der "Art der Gesellschaft" auf "Bis 70 Überleben". + +Auf inhaltlicher Ebene ist das sogar recht intuitiv. +Wer in einer Gesellschaft mit zahlreichen Risiken für das Überleben einige Jahre übersteht, muss von Haus aus relativ robust sein. +Wer in einer Gesellschaft mit wenigen Risiken und guter gesundheitlicher Versorgung aufwächst, hat trotz bestimmter gesundheitlicher Anfälligkeiten gute Überlebenschancen. + +Die Population der Menschen über 5 Jahre in Jäger- und Sammlergesellschaften ist damit von vornerein ganz anders als die Population der Menschen über 5 Jahre in modernen Gesellschaften. +Ein naiver Vergleich dieser zwei Populationen vermischt Effekte der Art der Gesellschaft auf das Überleben mit Scheinkorrelationen, welche durch den "Selektionsfilter" des Überlebens bis in die Kindheit verzerrt werden. + +Alleine aus diesen Daten können wir also noch keine belastbaren Schlüsse ziehen über die Vor- oder Nachteile bestimmter Lebensstile für die Langlebigkeit. + +Nur in Gedanken könnten wir hier Experimente durchführen und Kinder, die in einer der Gesellschaften ein bestimmtes Alter erreicht haben, zufällig einer der beiden Gesellschaften zuordnen. Um mit verfügbaren Beobachtungsdaten das Ergebnis eines solchen Experimentes anzunähern, reicht es nicht, bestimmte Lebenserwartungen zu vergleichen -- zusätzliche Variablen müssen berücksichtigt werden. + + +## Ausblick + +Hoffentlich konnten wir Ihnen einige Werkzeuge an die Hand geben, um in der Praxis kausale Schlüsse kritisch zu hinterfragen. + +Von Judea Pearl, Madelyn Glymour und Nicholas P. Jewell gibt es das Buch [Causal Inference in Statistics: A Primer](http://bayes.cs.ucla.edu/PRIMER/), welches die hier vorgestellten Grundlagen ausführlicher behandelt. +Jonas Peters (den Sie bereits aus dem Interview kennen) hat zusammen mit Dominik Janzing und Bernhard Schölkopf auch ein Buch geschrieben: [Elements of Causal Inference: Foundations and Learning Algorithms*](https://mitpress.mit.edu/books/elements-causal-inference). +Das Thema kausale Inferenz wird im Buch [Statistical Rethinking](https://xcelab.net/rm/statistical-rethinking/) im 6. Kapitel der zweiten Auflage von Richard McElreath behandelt – auch ihn kennen Sie schon aus dem Interview. +Ethan Bueno de Mesquita und Anthony Fowler behandeln in ihrem Buch [Thinking Clearly with Data: A Guide to Quantitative Reasoning and Analysis](https://press.princeton.edu/books/paperback/9780691214351/thinking-clearly-with-data) auch das Thema Kausale Inferenz sehr gut – allerdings aus einem etwas anderen Blickwinkel. + +Weitere Bücher aus unterschiedlichen Perspektiven sind z. B. [Causal Inference: The Mixtape*](https://mixtape.scunning.com/) von Scott Cunningham, [The Effect: An Introduction to Research Design and Causality*](https://theeffectbook.net/) von Nick Huntington-Klein oder [Causal Inference: What If*](https://www.hsph.harvard.edu/miguel-hernan/causal-inference-book/) von Hernán und Robins. + +Die mit einem Sternchen markierten Titel sind online frei verfügbar. + +<br> + +Natürlich gibt es über die konzeptuellen Grundlagen hinaus noch viel zu lernen, beispielsweise in den auf den nächsten Seiten beschriebenen Themenbereichen. + +## + +### Methoden für die Adjustierung von Drittvariablen +In diesem Kurs haben Sie gelernt, dass Drittvariablen manchmal in Analysen berücksichtigt werden sollten -- und manchmal nicht, je nach der Rolle, die sie im kausalen Graphen spielen. +Eine solche Adjustierung kann auf unterschiedliche Arten vorgenommen werden. +Im Kurs haben Sie beispielsweise gesehen, dass Variablen als Prädiktoren in einem linearen Regressionsmodel aufgenommen werden können. +Aber auch andere statistische Vorgehensweisen sind möglich, zum Beispiel das Aufteilen der Stichprobe (Stratifizierung) oder die Berechnung von Propensity Scores (siehe Interview mit Dean Eckles zu sozialer Ansteckung). +Auch Methoden des maschinellen Lernens finden hier Anwendung. + +*Lesetipp*: + +- Stephen L. Morgan und Christopher Winship, [Counterfactuals and Causal Inference: Methods and Principles for Social Research](https://www.cambridge.org/core/books/counterfactuals-and-causal-inference/5CC81E6DF63C5E5A8B88F79D45E1D1B7) + +### Natürliche Experimente +In diesem Kurs haben Sie etwas über die Magie des Zufalls gelernt, die randomisierte Experimente zu so einem nützlichen Werkzeug in der Kausalinferenz macht. +Zwischen randomisierte Experimenten und "reinen" Beobachtungsdaten liegen die sogenannten natürlichen Experimente. +Hier macht man es sich zu Nutzen, dass im Alltag manchmal Dinge praktisch durch Zufall entschieden werden. + +Ein erstes Beispiel für ein natürliches Experiment haben Sie schon im Interview mit Anne Brenøe zum Thema *Effekte des Stillens* kennengelernt: Ob eine Schwangere unter der Woche oder am Wochenende entbindet, ist im Prinzip zufällig, kann aber einen Einfluss darauf haben, ob und wie lange sie nach der Geburt stillen wird. + +Zur Analyse können dabei häufig sogenannte **Instrumentvariablen** oder eine **Regressions-Diskontinuitäts-Analyse** angewendet werden. Oder es wird die **Differenz-von-Differenzen** betrachtet. + +Für Arbeiten in diesem Bereich wurde übrigens im Jahre 2021 der Alfred-Nobel-Gedächtnispreis für Wirtschaftswissenschaften an David Card, Joshua Angrist und Guido Imbens verliehen! Herzlichen Glückwunsch! <br> + +Wie diese Methoden helfen wichtige Fragen zu beantworten hat die Schwedische Akademie der Wissenschaften [hier](https://www.nobelprize.org/uploads/2021/10/popular-economicsciencesprize2021-3.pdf) beschrieben. + + +*Lesetipps*: + +- Thad Dunning, [Natural Experiments in the Social Sciences](https://www.cambridge.org/gb/academic/subjects/social-science-research-methods/qualitative-methods/natural-experiments-social-sciences-design-based-approach?format=PB&isbn=9781107698000) +- Joshua D. Angrist und Jörn-Steffen Pischke, [Mastering 'Metrics: The Path from Cause to Effect](http://www.masteringmetrics.com/) + + +### Causal Discovery +In diesem Kurs sind wir oft davon ausgegangen, dass der zugrundeliegende kausale Graph im Prinzip bekannt ist. +Was aber, wenn das nicht der Fall ist? +Dann bewegen wir uns in den Bereich Causal Discovery, in dem es das Ziel ist, unterstützt durch Daten einen plausiblen kausalen Graphen herzuleiten. +In den letzten drei Interviews mit Jakob Runge, Jonas Peters und Sebastian Weichwald haben Sie schon einen ersten Einblick in den Themenkomplex bekommen. + +*Lesetipp*: + +- Peter Spirtes, Clark Glymour und Richard Scheines, [Causation, Prediction, and Search](http://cognet.mit.edu/book/causation-prediction-and-search) + +### Data Fusion +Aus der Vogelperspektive betrachtet gibt es viele Datenquellen, die herangezogen werden können, um mehr über Ursachen und Effekte zu lernen. +In der Regel ist keine davon perfekt. +Beobachtungsstudien leiden oft unter unbeobachteten Confoundern; in Experimenten machen nicht immer alle Personen das, was wir uns wünschen, und manchmal müssen wir auf andere Populationen zurückgreifen -- zum Beispiel in den initialen Stadien der Medikamentenzulassung auf Zellkulturen und Tierversuche. +Fehlende Daten und selektive Stichproben verkomplizieren die Situation weiter. +Die Idee der Causal Fusion ist, dass wir trotzdem all diese Datenquellen *in Kombination* nutzen können, um zu den bestmöglichen kausalen Schlußfolgerungen zu gelangen. + +*Lesetipp*: + +- Paul Hünermund und Elias Bareinboim, [Causal Inference and Data-Fusion in Econometrics](https://arxiv.org/abs/1912.09104v2) + + +## KI-Campus + +[Zurück zum Kurs](https://learn.ki-campus.org/courses/7c8012d9-8729-4462-9ad0-be7d71118f37/launch)