Confounding
Confounding bei binären Daten
Zum Datensatz
Der Datensatz “hospAB.csv” für diese Übung enthält die folgenden Variablen:
- death: Die abhängige, binäre Variable, ob der Patient/die Patientin gestorben ist (1) oder nicht (0)
- risk: eine binäre Variable, welche einschätzt, wie gefährdet der Patient/die Patientin ist (1 = low risk, 2 = highrisk)
- age: eine binäre Variable für das Alter (0 = <60J., 1 = >60J.)
- sex: eine binäre Variable für das Geschlecht (1 = female, 2 = male)
- hospital: eine binäre Variable, um welches Spital es sich handelt (0 = A, 1 = B)
Ziel ist es herauszufinden, ob sich die Odds, um zu sterben, zwischen den beiden Spitälern unterscheiden.
Übung 1
Aufgaben
- Importiere den Datensatz.
- Schau die Struktur des Datensatzes an. Wenn nötig, erstelle Faktoren mit entsprechenden Labels.
- Erstelle geeignete Grafiken, um einen Eindruck zur Verteilung der einzelnen Variablen in den beiden Spitälern zu erhalten.
Lösungen
Datensatz importieren:
library(rio)
d.hospital <- import("~/Documents/Git/fm-msc-bfh/Exercises/Confounding/hospAB.csv")Es bietet sich an, bei allen qualitativen Variablen Faktoren zu erstellen:
str(d.hospital)## 'data.frame': 1600 obs. of 5 variables:
## $ risk : int 1 2 1 2 1 2 1 2 1 2 ...
## $ sex : int 2 2 2 2 1 1 1 1 2 2 ...
## $ age : int 0 0 1 1 0 0 1 1 0 0 ...
## $ death : int 1 1 1 1 1 1 1 1 1 1 ...
## $ hospital: int 0 0 0 0 0 0 0 0 1 1 ...d.hospital$risk <- factor(d.hospital$risk, levels = c(1,2),
labels = c("low risk", "high risk"))
d.hospital$sex <- factor(d.hospital$sex, levels = c(1,2),
labels = c("female", "male"))
d.hospital$age <- factor(d.hospital$age, levels = c(0,1),
labels = c("<60", "60+"))
d.hospital$death <- factor(d.hospital$death, levels = c(0,1),
labels = c("survived", "died"))
d.hospital$hospital <- factor(d.hospital$hospital, levels = c(0,1),
labels = c("A", "B"))
str(d.hospital)## 'data.frame': 1600 obs. of 5 variables:
## $ risk : Factor w/ 2 levels "low risk","high risk": 1 2 1 2 1 2 1 2 1 2 ...
## $ sex : Factor w/ 2 levels "female","male": 2 2 2 2 1 1 1 1 2 2 ...
## $ age : Factor w/ 2 levels "<60","60+": 1 1 2 2 1 1 2 2 1 1 ...
## $ death : Factor w/ 2 levels "survived","died": 2 2 2 2 2 2 2 2 2 2 ...
## $ hospital: Factor w/ 2 levels "A","B": 1 1 1 1 1 1 1 1 2 2 ...Da es sich um rein qualitative Daten handelt, eigenen sich Balkendiagramme, um deren Verteilung zu betrachten:
barplot(table(d.hospital$risk, d.hospital$hospital),
legend = TRUE, main = "Risk", xlab = "Hospital")
barplot(table(d.hospital$sex, d.hospital$hospital),
legend = TRUE, main = "Sex", xlab = "Hospital")
barplot(table(d.hospital$age, d.hospital$hospital),
legend = TRUE, main = "Age", xlab = "Hospital")
barplot(table(d.hospital$death, d.hospital$hospital),
legend = TRUE, main = "Death", xlab = "Hospital")
Für die tidyverse-Fans hier noch eine etwas elegantere Lösung…
library(tidyverse)
d.hospital %>%
pivot_longer(risk:death, names_to = "profile", values_to = "values") %>%
ggplot(aes(x = values, fill = hospital)) + geom_bar()
Man sieht, dass die Risikofaktoren (high risk,
male, 60+) in Spital B häufiger vorkommen.
Übung 2
Aufgaben
- Erstelle eine 2x2 Tabelle mit dem Spital in den Zeilen und den Todesfällen in den Spalten. Was stellst du fest?
- Berechne die Differenz der zwei Proportionen der gestorbenen
Personen. Berechne ebenfalls das dazugehörige 95% CI und den p-Wert. Was
stellst du fest? Tipp:
prop.test() - Berechne das Odds Ratio, dessen 95% CI und den p-Wert. Was stellst
du fest? Tipp:
oddsratio()aus dem Paketepitools
Lösungen
Zuerst wird die 2x2 Tabelle erstellt:
tab <- table(d.hospital$hospital, d.hospital$death)
tab##
## survived died
## A 760 40
## B 719 81Darin ist ersichtlich, dass es in Spital B mehr Todesfälle gibt.
Wir brauchen den prop.test(), um die Proportion an
Todesfällen der beiden Spitäler statistisch zu vergleichen.
prop.test(c(40,81), c(800, 800)) ##
## 2-sample test for equality of proportions with continuity correction
##
## data: c(40, 81) out of c(800, 800)
## X-squared = 14.305, df = 1, p-value = 0.0001555
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.07828847 -0.02421153
## sample estimates:
## prop 1 prop 2
## 0.05000 0.10125# Der erste Vektor steht für die "Events", der zweite für das n pro GruppeDie Proportionsdifferenz beträgt 0.10125- 0.05000 = 5.125%. Das 95% CI schneidet die H0 nicht. Der p-Wert ist mit 0.01% klein. Es scheint also Evidenz dafür zu geben, dass in Spital B wirklich mehr Menschen sterben…
Mit der Berechnung des OR kommen wir zum gleichen Fazit:
library(epitools)
oddsratio(tab, correction = TRUE)## $data
##
## survived died Total
## A 760 40 800
## B 719 81 800
## Total 1479 121 1600
##
## $measure
## odds ratio with 95% C.I.
## estimate lower upper
## A 1.000000 NA NA
## B 2.135312 1.450752 3.191248
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## A NA NA NA
## B 9.931952e-05 0.0001372591 0.0001554553
##
## $correction
## [1] TRUE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"Das OR beträgt 2.14, das heisst die Chance um zu sterben ist in Spital B mehr als doppelt so hoch wie in Spital A. Das 95% CI schneidet H0 deutlich nicht, der p-Wert ist wiederum gleich wie bei den anderen Analysen.
Fazit: Spital B meiden?!
Übung 3
Aufgabe
Nun geht es darum, mögliche Confounding-Variablen zu berücksichtigen. Berechne das Odds Ratio erneut, allerdings stratifiziert nach Risikogruppe. Was stellst du fest?
Tipp: Du brauchst die subset()-Funktion
Lösung
Zuerst müssen Teildatensätze und je eine neue 2x2 Tabelle erstellt werden:
lowrisk <- subset(d.hospital, risk == "low risk")
highrisk <- subset(d.hospital, risk == "high risk")
tab_lowrisk <- table(lowrisk$hospital, lowrisk$death)
tab_highrisk <- table(highrisk$hospital, highrisk$death)
tab_lowrisk##
## survived died
## A 585 15
## B 386 14tab_highrisk##
## survived died
## A 175 25
## B 333 67Nun kann für jedes Stratum die Odds Ratio berechnet werden:
oddsratio(tab_highrisk)## $data
##
## survived died Total
## A 175 25 200
## B 333 67 400
## Total 508 92 600
##
## $measure
## odds ratio with 95% C.I.
## estimate lower upper
## A 1.000000 NA NA
## B 1.402734 0.8644944 2.340432
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## A NA NA NA
## B 0.173498 0.1876631 0.1731913
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"oddsratio(tab_lowrisk)## $data
##
## survived died Total
## A 585 15 600
## B 386 14 400
## Total 971 29 1000
##
## $measure
## odds ratio with 95% C.I.
## estimate lower upper
## A 1.000000 NA NA
## B 1.415058 0.6637963 2.998005
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## A NA NA NA
## B 0.3636991 0.4420656 0.3559016
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"In beiden Strata sinkt die Odds Ratio beträchtlich. Auffällig ist auch, dass beide 95% CI’s nun H0 schneiden… Die Variable “risk” scheint also ein wichtiger Confounder zu sein.
Übung 4
Aufgabe
Versuche nun, alle potentiellen Confounder zu berücksichtigen. Erstelle dazu einen Teildatensatz, in welchem nur Männer über 60 Jahren und einem hohen Risiko vertreten sind. Was findest du heraus, wenn du die Odds Ratio erneut berechnest?
Tipp: innerhalb der subset() Funktion kann man mehrere
Bedingungen mit einem & aneinander knüpfen.
Lösung
Zuerst wird wieder der Teildatensatz und die 2x2 Tabelle erstellt
high_risk_profile <- subset(d.hospital,
sex == "male" & risk == "high risk" & age == "60+")
tab_high_risk_profile <- table(high_risk_profile$hospital, high_risk_profile$death)
tab_high_risk_profile##
## survived died
## A 30 10
## B 120 40Nun die adjustierte Odds Ratio
oddsratio(tab_high_risk_profile)## $data
##
## survived died Total
## A 30 10 40
## B 120 40 160
## Total 150 50 200
##
## $measure
## odds ratio with 95% C.I.
## estimate lower upper
## A 1.0000000 NA NA
## B 0.9919928 0.4547018 2.3173
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## A NA NA NA
## B 0.984425 1 1
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"Die Odds Ratio beträgt 1. Das heisst, wenn man für alle Confounder kontrolliert, gibt es keinen Unterschied zwischen Spital A und B in Bezug auf die Chance, zu sterben.
Übung 5
Aufgabe
Nun soll noch Mantel-Haenszel Methode verwendet werden. Die Funktion
mhor() befindet sich im Package epiDisplay.
Die Funktion braucht drei Argumente:
- Outcome: die abhängige Variable
- Gruppe: eine Variable welche Exponierte und nicht-Exponierte identifiziert
- Confounder: eine potentielle Confounding Variable
Was ist das Resultat dieser Analyse?
Tipp: Wir müssen alle Confounding-Variablen (sex, age, risk) in eine
Variable bringen (am Schluss sollten \(2*2*2 =
8\) Ausprägungen existieren). Um dies zu erreichen ist z.B. die
paste() Funktion hilfreich. Hier ein Beispiel:
a <- "A"
b <- "B"
c <- "C"
abc <- paste(a,b,c, sep = "")
abc## [1] "ABC"Das sep = "" definiert, wie die einzelnen Elemente
getrennt werden (in diesem Fall gar nicht)
Lösung
Zuerst werden alle Confounding-Variablen (sex, age, risk) in eine Variable gebracht:
d.hospital$profile <- factor(paste(d.hospital$risk,d.hospital$sex, d.hospital$age))
tab <- table(d.hospital$profile, d.hospital$death)
tab##
## survived died
## high risk female <60 95 5
## high risk female 60+ 119 21
## high risk male <60 144 16
## high risk male 60+ 150 50
## low risk female <60 297 3
## low risk female 60+ 144 6
## low risk male <60 245 5
## low risk male 60+ 285 15Dann können wir die mhor() Funktion anwenden:
library(epiDisplay)
mhor(d.hospital$death, d.hospital$hospital, d.hospital$profile)##
## Stratified analysis by Var3
## OR lower lim. upper lim. P value
## Var3 high risk female <60 1 0.0800 9.16 1
## Var3 high risk female 60+ 1 0.3313 3.42 1
## Var3 high risk male <60 1 0.3086 3.55 1
## Var3 high risk male 60+ 1 0.4280 2.50 1
## Var3 low risk female <60 1 0.0168 19.43 1
## Var3 low risk female 60+ 1 0.0875 7.26 1
## Var3 low risk male <60 1 0.0199 10.40 1
## Var3 low risk male 60+ 1 0.3011 3.84 1
## M-H combined 1 0.6455 1.55 1
##
## M-H Chi2(1) = 0 , P value = 1
## Homogeneity test, chi-squared 7 d.f. = 0 , P value = 1
Wir sehen, dass für jede separate Strata die Odds Ratio 1 beträgt. Wie oben kommen wir zum Schluss, dass es keinen Unterschied zwischen Spital A und B in Bezug auf die Chance zu sterben gibt, wenn man alle Confounding-Variablen berücksichtigt.