- Bilden Sie die Untergruppe der Werte von ALP.B für die Dosis A und weisen Sie diese Werte der Variablen alp.a.b zu.
x <- read.csv("liver.csv")
alp.a <- subset(x$ALP.M, x$dose=="A")
alp.d <- subset(x$ALP.M, x$dose=="D")
alp.a.b <- subset(x$ALP.B, x$dose=="A")
- Bilden Sie die Differenz zwischen den Vektoren alp.a und alp.a.b und weisen Sie das Ergebnis der Variablen diff.alp.a zu.
diff.alp.a <- alp.a - alp.a.b
Bilden Sie analog die Differenz zwischen den Vektoren alp.d und alp.d.b und weisen Sie das Ergebnis der Variablen diff.alp.d zu.
alp.d.b <- subset(x$ALP.B, x$dose=="D")
diff.alp.d <- alp.d - alp.d.b
Bestimmen Sie den p-Value für den Vergleich der Mittelwerte von diff.alp.a und diff.alp.d mittels t-Test.
t.test(diff.alp.a, diff.alp.d )
Welch Two Sample t-test
data: diff.alp.a and diff.alp.d
t = -4.2779, df = 167.9, p-value = 3.161e-05
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
-13.521081 -4.982084
sample estimates:
mean of x mean of y
2.87500 12.12658
Zusatz: Visualisierung der Daten
boxplot(diff.alp.a, diff.alp.d, boxwex = 0.2, las = 2)
# boxwex macht schmalere boxes beim box plot
grid()

boxplot(alp.a-alp.a.b, alp.d-alp.d.b, boxwex = 0.2, las = 2, ylim = c(0, 20))
grid()

Mann-Whitney U test
wilcox.test(diff.alp.a, diff.alp.d)
Wilcoxon rank sum test with continuity correction
data: diff.alp.a and diff.alp.d
W = 6728, p-value = 2.058e-11
alternative hypothesis: true location shift is not equal to 0
- Tragen Sie in einem Streudiagramm die Schwellenwerte der ROC-Kurve für S100β gegen die Sensitivitäten auf.
# get dataset of 141 patients with aneurysmal subarachnoid hemorrhage
library(pROC)
data(aSAH)
roc.s100b <- roc(outcome ~ s100b, data= aSAH)
plot(roc.s100b$thresholds, roc.s100b$sensitivities,
xlab = "Schwellenwert",
ylab = "Sensitivität")
grid()

- Zeichnen Sie ROC-Kurven für S100β und NDKA inklusive Konfidenzbändern. Verwenden Sie dazu transparente Farben für die Konfidenzbänder. Hinweise: Transparente Farben erhält man durch
rgb(1,0,0,0.1) (transparentes Rot) oder
rgb(0,0,1,0.1) (transparentes Blau).
Der letzte Wert gibt jeweils die Stärke der Undurchsichtigkeit (0: völlig transparent, 1: völlig undurchsichtig) an. Die ersten drei Werte spezifizieren die Farbe als RGB-Werte zwischen 0 und 1.)
roc.s100b.ci <- roc(outcome ~ s100b, data=aSAH, ci = TRUE)
roc.ndka.ci <- roc(outcome ~ ndka, data=aSAH, ci = TRUE)
plot(roc.s100b.ci, col = "blue", legacy.axes = TRUE)
plot(roc.ndka.ci, col = "red", add = TRUE)

# Berechnung dauert ca. 1 min
col.s100b <- rgb(1, 0, 0, 0.2)
col.ndka <- rgb(0, 0, 1, 0.2)
ci.s100b <- ci.se(roc.s100b.ci, specificities = seq(0, 1, 0.01))
ci.ndka <- ci.se(roc.ndka.ci, specificities = seq(0, 1 , 0.01))
plot(roc.s100b.ci, col = "blue", legacy.axes = TRUE)
plot(roc.ndka.ci, col = "red", add = TRUE)
plot(ci.s100b, type = "shape", col = col.s100b)
plot(ci.ndka, type = "shape", col = col.ndka)
plot(roc.s100b.ci, col = "blue", add = TRUE)
plot(roc.ndka.ci, col = "red", add = TRUE)

LS0tCnRpdGxlOiAiQ3Jhc2hrdXJzIFIgLS0gw5xidW5nZW4gVGVpbCAyIgpvdXRwdXQ6CiAgaHRtbF9ub3RlYm9vazogZGVmYXVsdAotLS0KCgoxLiBCaWxkZW4gU2llIGRpZSBVbnRlcmdydXBwZSBkZXIgV2VydGUgdm9uIEFMUC5CIGbDvHIgZGllIERvc2lzIEEgdW5kIHdlaXNlbiBTaWUgZGllc2UgV2VydGUgZGVyIFZhcmlhYmxlbiBhbHAuYS5iIHp1LgoKYGBge3J9CnggPC0gcmVhZC5jc3YoImxpdmVyLmNzdiIpCgphbHAuYSA8LSBzdWJzZXQoeCRBTFAuTSwgeCRkb3NlPT0iQSIpCmFscC5kIDwtIHN1YnNldCh4JEFMUC5NLCB4JGRvc2U9PSJEIikKIAphbHAuYS5iIDwtIHN1YnNldCh4JEFMUC5CLCB4JGRvc2U9PSJBIikKYGBgCgoKMi4gQmlsZGVuIFNpZSBkaWUgRGlmZmVyZW56IHp3aXNjaGVuIGRlbiBWZWt0b3JlbiBhbHAuYSB1bmQgYWxwLmEuYiB1bmQgd2Vpc2VuIFNpZSBkYXMgRXJnZWJuaXMgZGVyIFZhcmlhYmxlbiBkaWZmLmFscC5hIHp1LiAKCmBgYHtyfQpkaWZmLmFscC5hIDwtIGFscC5hIC0gYWxwLmEuYgpgYGAKCkJpbGRlbiBTaWUgYW5hbG9nIGRpZSBEaWZmZXJlbnogendpc2NoZW4gZGVuIFZla3RvcmVuIGFscC5kIHVuZCBhbHAuZC5iIHVuZCB3ZWlzZW4gU2llIGRhcyBFcmdlYm5pcyBkZXIgVmFyaWFibGVuIGRpZmYuYWxwLmQgenUuIAoKYGBge3J9CmFscC5kLmIgPC0gc3Vic2V0KHgkQUxQLkIsIHgkZG9zZT09IkQiKQoKZGlmZi5hbHAuZCA8LSBhbHAuZCAtIGFscC5kLmIKYGBgCgpCZXN0aW1tZW4gU2llIGRlbiBwLVZhbHVlIGbDvHIgZGVuIFZlcmdsZWljaCBkZXIgTWl0dGVsd2VydGUgdm9uIGRpZmYuYWxwLmEgdW5kIGRpZmYuYWxwLmQgbWl0dGVscyB0LVRlc3QuIAoKYGBge3J9CnQudGVzdChkaWZmLmFscC5hLCBkaWZmLmFscC5kICkKYGBgCgoKWnVzYXR6OiBWaXN1YWxpc2llcnVuZyBkZXIgRGF0ZW4gCgpgYGB7cn0KYm94cGxvdChkaWZmLmFscC5hLCBkaWZmLmFscC5kLCBib3h3ZXggPSAwLjIsIGxhcyA9IDIpCiMgYm94d2V4IG1hY2h0IHNjaG1hbGVyZSBib3hlcyBiZWltIGJveCBwbG90CmdyaWQoKQpgYGAKCmBgYHtyfQoKYm94cGxvdChhbHAuYS1hbHAuYS5iLCBhbHAuZC1hbHAuZC5iLCBib3h3ZXggPSAwLjIsIGxhcyA9IDIsIHlsaW0gPSBjKDAsIDIwKSkKZ3JpZCgpCgpgYGAKCk1hbm4tV2hpdG5leSBVIHRlc3QKCmBgYHtyfQp3aWxjb3gudGVzdChkaWZmLmFscC5hLCBkaWZmLmFscC5kKQoKYGBgCgoKMy4gVHJhZ2VuIFNpZSBpbiBlaW5lbSBTdHJldWRpYWdyYW1tIGRpZSBTY2h3ZWxsZW53ZXJ0ZSBkZXIgUk9DLUt1cnZlIGbDvHIgUzEwMM6yIGdlZ2VuIGRpZSBTZW5zaXRpdml0w6R0ZW4gYXVmLiAKCmBgYHtyfQoKIyBnZXQgZGF0YXNldCBvZiAxNDEgcGF0aWVudHMgd2l0aCBhbmV1cnlzbWFsIHN1YmFyYWNobm9pZCBoZW1vcnJoYWdlCmxpYnJhcnkocFJPQykKZGF0YShhU0FIKQoKcm9jLnMxMDBiIDwtIHJvYyhvdXRjb21lIH4gczEwMGIsIGRhdGE9IGFTQUgpCgpwbG90KHJvYy5zMTAwYiR0aHJlc2hvbGRzLCByb2MuczEwMGIkc2Vuc2l0aXZpdGllcywgCiAgICAgeGxhYiA9ICJTY2h3ZWxsZW53ZXJ0IiwKICAgICB5bGFiID0gIlNlbnNpdGl2aXTDpHQiKQpncmlkKCkKCmBgYAoKCjQuIFplaWNobmVuIFNpZSBST0MtS3VydmVuIGbDvHIgUzEwMM6yIHVuZCBOREtBIGlua2x1c2l2ZSBLb25maWRlbnpiw6RuZGVybi4gVmVyd2VuZGVuIFNpZSBkYXp1IHRyYW5zcGFyZW50ZSBGYXJiZW4gZsO8ciBkaWUgS29uZmlkZW56YsOkbmRlci4gCkhpbndlaXNlOiBUcmFuc3BhcmVudGUgRmFyYmVuIGVyaMOkbHQgbWFuIGR1cmNoIAoKcmdiKDEsMCwwLDAuMSkgKHRyYW5zcGFyZW50ZXMgUm90KSBvZGVyIAoKcmdiKDAsMCwxLDAuMSkgKHRyYW5zcGFyZW50ZXMgQmxhdSkuIAoKRGVyIGxldHp0ZSBXZXJ0IGdpYnQgamV3ZWlscyBkaWUgU3TDpHJrZSBkZXIgVW5kdXJjaHNpY2h0aWdrZWl0ICgwOiB2w7ZsbGlnIHRyYW5zcGFyZW50LCAxOiB2w7ZsbGlnIHVuZHVyY2hzaWNodGlnKSBhbi4gRGllIGVyc3RlbiBkcmVpIFdlcnRlIHNwZXppZml6aWVyZW4gZGllIEZhcmJlIGFscyBSR0ItV2VydGUgendpc2NoZW4gMCB1bmQgMS4pCgpgYGB7cn0Kcm9jLnMxMDBiLmNpIDwtIHJvYyhvdXRjb21lIH4gczEwMGIsIGRhdGE9YVNBSCwgY2kgPSBUUlVFKQpyb2MubmRrYS5jaSA8LSByb2Mob3V0Y29tZSB+IG5ka2EsIGRhdGE9YVNBSCwgY2kgPSBUUlVFKQoKcGxvdChyb2MuczEwMGIuY2ksIGNvbCA9ICJibHVlIiwgbGVnYWN5LmF4ZXMgPSBUUlVFKQpwbG90KHJvYy5uZGthLmNpLCBjb2wgPSAicmVkIiwgYWRkID0gVFJVRSkgCgpgYGAKCmBgYHtyLCByZXN1bHRzPSJoaWRlIn0KIyBCZXJlY2hudW5nIGRhdWVydCBjYS4gMSBtaW4KCmNvbC5zMTAwYiA8LSByZ2IoMSwgMCwgMCwgMC4yKQpjb2wubmRrYSA8LSByZ2IoMCwgMCwgMSwgMC4yKQoKY2kuczEwMGIgPC0gY2kuc2Uocm9jLnMxMDBiLmNpLCBzcGVjaWZpY2l0aWVzID0gc2VxKDAsIDEsIDAuMDEpKQpjaS5uZGthIDwtIGNpLnNlKHJvYy5uZGthLmNpLCBzcGVjaWZpY2l0aWVzID0gc2VxKDAsIDEgLCAwLjAxKSkKCnBsb3Qocm9jLnMxMDBiLmNpLCBjb2wgPSAiYmx1ZSIsIGxlZ2FjeS5heGVzID0gVFJVRSkKcGxvdChyb2MubmRrYS5jaSwgY29sID0gInJlZCIsIGFkZCA9IFRSVUUpIApwbG90KGNpLnMxMDBiLCB0eXBlID0gInNoYXBlIiwgY29sID0gY29sLnMxMDBiKQpwbG90KGNpLm5ka2EsIHR5cGUgPSAic2hhcGUiLCBjb2wgPSBjb2wubmRrYSkKcGxvdChyb2MuczEwMGIuY2ksIGNvbCA9ICJibHVlIiwgYWRkID0gVFJVRSkKcGxvdChyb2MubmRrYS5jaSwgY29sID0gInJlZCIsIGFkZCA9IFRSVUUpIAoKYGBgCg==