49  Lösungen Wahrscheinlichkeiten

Autor:in

Zugehörigkeit

Jörg große Schlarmann

Hochschule Niederrhein

Hier finden Sie die Lösungen zu den Übungsaufgaben von Abschnitt 44.5.

Die hier vorgestellten Lösungen stellen immer nur eine mögliche Vorgehensweisen dar und sind sicherlich nicht der Weisheit letzter Schluss. In R führen viele Wege nach Rom, und wenn Sie mit anderem Code zu den richtigen Ergebnissen kommen, dann ist das völlig in Ordnung.

49.1 Lösung zur Aufgabe 44.5.1

a) Lassen Sie in R eine beliebige Poker-Spielkarte ziehen.

# lade Kartenspiele
load(url("https://www.produnis.de/R/data/cards.RData"))

# ziehe Karte
sample(poker, 1)

[1] Herz 5
52 Levels: Kreuz 2 < Karo 2 < Herz 2 < Pik 2 < Kreuz 3 < Karo 3 < ... < Pik As

# alternativ kann das 'probs'-Paket verwendet werden
karten <- probs::cards(makespace=TRUE)
probs::sim(karten, ntrials=1)

  rank suit
1    A Club

b) Lassen Sie in R 2 Münzen werfen.

# lade Datensatz
coin <- c("Kopf", "Zahl")

# wirf 2 Münzen
sample(coin, 2, replace=TRUE)

[1] "Kopf" "Zahl"

# alternativ kann das 'probs'-Paket verwendet werden
coin <- probs::tosscoin(2, makespace=TRUE)
probs::sim(coin, ntrials=1)

  toss1 toss2
1     H     T

c) Lassen Sie in R 2 Würfel werfen.

# lade Datensatz
würfel <- c(1:6)

# wirf 2 Münzen
sample(würfel, 2, replace=TRUE)

[1] 2 4

# alternativ kann das 'probs'-Paket verwendet werden
würfel <- probs::rolldie(2, makespace=TRUE)
probs::sim(würfel, ntrials=1)

  X1 X2
1  5  4

49.2 Lösung zur Aufgabe 44.5.2

a) Wiederholen Sie die Zufallsexperimente und lassen Sie R \(10\) mal, \(100\) mal \(1.000\) mal und \(1.000.000\) mal zwei Münzen werfen. Erstellen Sie je eine relative Häufigkeitstabelle der Ergebnisse. Wie sind die Tabellen zu bewerten?

# erzeuge Wahrscheinlichkeitsraum
münzen <- probs::tosscoin(2, makespace=TRUE)

# werfe 10mal 2 Münzen
versuch <- probs::sim(münzen, ntrials=10)
# berechne Wahrscheinlichkeitsverteilung
probs::empirical(versuch)

  toss1 toss2 probs
1     T     H   0.3
2     H     T   0.4
3     T     T   0.3

# werfe 100mal 2 Münzen
versuch <- probs::sim(münzen, ntrials=100)
# berechne Wahrscheinlichkeitsverteilung
probs::empirical(versuch)

  toss1 toss2 probs
1     H     H  0.30
2     T     H  0.20
3     H     T  0.28
4     T     T  0.22

# werfe 1.000mal 2 Münzen
versuch <- probs::sim(münzen, ntrials=1000)
# berechne Wahrscheinlichkeitsverteilung
probs::empirical(versuch)

  toss1 toss2 probs
1     H     H 0.252
2     T     H 0.248
3     H     T 0.249
4     T     T 0.251

# werfe 1.000.000mal 2 Münzen
versuch <- probs::sim(münzen, ntrials=1000000)
# berechne Wahrscheinlichkeitsverteilung
probs::empirical(versuch)

  toss1 toss2    probs
1     H     H 0.249949
2     T     H 0.249696
3     H     T 0.250325
4     T     T 0.250030

Mit zunehmender Wiederholung nähern sich die Wahrscheinlichkeitsverteilungen den relativen Häufigkeiten an.

b) Welche theoretischen Wahrscheinlichkeiten haben die möglichen Wurfergebnisse? Stimmen diese mit den beobachteten Ergebnissen überein?

Je häufiger das Zufallsexperiment wiederholt wird, desto mehr nähern sich die beobachteten Wahrscheinlichkeiten den theoretischen Wahrscheinlichkeiten an.

49.3 Lösung zur Aufgabe 44.5.3

a) Ziehen Sie zufällig 3 Boxen, ohne zurücklegen.

boxen <- c("A", "A", "A", "B", "B", "C")

# ziehe 3 Boxen ohne Zurücklegen
sample(boxen, 3, replace=FALSE)

[1] "B" "A" "B"

Ziehen Sie zufällig 3 Boxen, diesmal mit zurücklegen.

boxen <- c("A", "A", "A", "B", "B", "C")

# ziehe 3 Boxen ohne Zurücklegen
sample(boxen, 3, replace=TRUE)

[1] "B" "A" "B"

49.4 Lösung zur Aufgabe 44.5.4

a) Erstellen Sie ein Datenframe mit den Variablen Windpocken, Masern, Röteln und Häufigkeit und übertragen Sie die Daten.

df <- tribble(
  ~Windpocken, ~Masern, ~Röteln, ~Häufigkeit,
  "No",        "No",    "No",    2654,
  "No",        "No",    "Yes",   1436,
  "No",        "Yes",   "No",    1682,
  "No",        "Yes",   "Yes",   668,
  "Yes",       "No",    "No",    1747,
  "Yes",       "No",    "Yes",   476,
  "Yes",       "Yes",   "No",    876,
  "Yes",       "Yes",   "Yes",   265
)

b) Erstellen Sie den Wahrscheinlichkeitsraum der Lebenszeitprävalenz.

# Wahrscheinlichkeitsraum
wr <- probs::probspace(df[,-4], probs=df$Häufigkeit/sum(df$Häufigkeit))
wr

  Windpocken Masern Röteln      probs
1         No     No     No 0.27070583
2         No     No    Yes 0.14647083
3         No    Yes     No 0.17156263
4         No    Yes    Yes 0.06813545
5        Yes     No     No 0.17819257
6        Yes     No    Yes 0.04855161
7        Yes    Yes     No 0.08935129
8        Yes    Yes    Yes 0.02702978

# Erstelle daraus die marginale Verteilung
probs::marginal(wr)

  Windpocken Masern Röteln      probs
1         No     No     No 0.27070583
2        Yes     No     No 0.17819257
3         No    Yes     No 0.17156263
4        Yes    Yes     No 0.08935129
5         No     No    Yes 0.14647083
6        Yes     No    Yes 0.04855161
7         No    Yes    Yes 0.06813545
8        Yes    Yes    Yes 0.02702978

c) Wie groß ist die Wahrscheinlichkeit, dass eine zufällig gezogene Person Windpocken hatte?

# Wahrscheinlichkeitsraum
wr <- probs::probspace(df[,-4], probs=df$Häufigkeit/sum(df$Häufigkeit))
# berechne Wahrscheinlichkeit
probs::Prob(wr, event=Windpocken=="Yes")

[1] 0.3431253

Die Wahrscheinlichkeit beträgt 34.31%.

d) Wie groß ist die Wahrscheinlichkeit, dass eine zufällig gezogene Person Windpocken oder Masern hatte?

# berechne Wahrscheinlichkeit
probs::Prob(wr, event=Windpocken=="Yes" | Röteln=="Yes")

[1] 0.5577315

Die Wahrscheinlichkeit beträgt 55.77%.

e) Wie groß ist die Wahrscheinlichkeit, dass eine zufällig gezogene Person Masern und Röteln hatte?

# berechne Wahrscheinlichkeit
probs::Prob(wr, event=Masern=="Yes" & Röteln=="Yes")

[1] 0.09516524

Die Wahrscheinlichkeit beträgt 9.52%.

f) Wie groß ist die Wahrscheinlichkeit, dass eine zufällig gezogene Person, die bereits an Masern erkrankte, nun an Windpocken erkrankt?

# berechne Wahrscheinlichkeit
probs::Prob(wr, event=Windpocken=="Yes", given= Masern=="Yes")

[1] 0.3268404

Die Wahrscheinlichkeit beträgt 32.68%.

g) Wie groß ist die Wahrscheinlichkeit, dass eine zufällig gezogene Person, die keine Masern und keine Röteln hatte, an Windpocken erkrankt?

# berechne Wahrscheinlichkeit
probs::Prob(wr, event=Masern=="No" & Röteln=="No", 
                given= Windpocken=="Yes")

[1] 0.5193222

Die Wahrscheinlichkeit beträgt 51.93%.

49.5 Lösung zur Aufgabe 44.5.5

a) Erstellen Sie ein Datenframe mit den Variablen Schwanger, Testergebnis und Häufigkeit.

df <- tribble(
  ~Schwanger, ~Test, ~Häufigkeit,
    "Nein", "-",   3876,
    "Nein", "+",  47,
    "Ja", "-",  12,
    "Ja", "+", 131
)

b) Erstellen Sie den Wahrscheinlichkeitsraum.

# Wahrscheinlichkeitsraum
wr <- probs::probspace(df[,-3], probs=df$Häufigkeit/sum(df$Häufigkeit))
wr

  Schwanger Test       probs
1      Nein    - 0.953271028
2      Nein    + 0.011559272
3        Ja    - 0.002951303
4        Ja    + 0.032218396

# Erstelle daraus die marginale Verteilung
probs::marginal(wr)

  Schwanger Test       probs
1        Ja    - 0.002951303
2      Nein    - 0.953271028
3        Ja    + 0.032218396
4      Nein    + 0.011559272

c) Berechnen Sie die Prävalenz der Schwangerschaften.

# Wahrscheinlichkeitsraum
probs::Prob(wr, event=Schwanger=="Ja")

[1] 0.0351697

Die Prävalenz liegt bei 3.52%.

d) Wie groß ist die Wahrscheinlichkeit, ein positives Testergebnis zu ziehen?

# Wahrscheinlichkeitsraum
probs::Prob(wr, event=Test=="+")

[1] 0.04377767

Die Wahrscheinlichkeit liegt bei 4.38%.

e) Bestimmen Sie die Sensitivität des Tests

# Wahrscheinlichkeitsraum
probs::Prob(wr, event=Test=="+", given= Schwanger=="Ja")

[1] 0.9160839

Die Sensitivität liegt bei 91.61%.

f) Bestimmen Sie die Spezifität des Tests

# Wahrscheinlichkeitsraum
probs::Prob(wr, event=Test=="-", given= Schwanger=="Nein")

[1] 0.9880194

Die Spezifität liegt bei 98.8%.

g) Bestimmen Sie den positiv prädiktiven Wert des Tests

# Wahrscheinlichkeitsraum
probs::Prob(wr, event=Schwanger=="Ja", given=Test=="+")

[1] 0.7359551

Der positiv prädiktive Wert liegt bei 73.6%.

h) Bestimmen Sie den negativ prädiktiven Wert des Tests

# Wahrscheinlichkeitsraum
probs::Prob(wr, event=Schwanger=="Nein", given=Test=="-")

[1] 0.9969136

Der negative prädiktive Wert liegt bei 99.69%.

Alternativ kann auch die Funktion sens.spec() aus dem Paket jgsbook verwendet werden:

jgsbook::sens.spec(rp=131, fp=12, rn=3876, fn=47)

  sens  spec   ppw  npw
1 73.6 99.69 91.61 98.8

49.6 Lösung zur Aufgabe 44.5.6

Erstelle den Ereignisraum des Zufallsexperiments, das aus dem Werfen einer Münze, dem Werfen eines Würfels und dem Ziehen einer Karte aus einem französischen Kartenspiel besteht.

würfel <- 1:6
münze <- c("Kopf", "Zahl")
bild <- c(7:10 ,"B", "D", "K", "A")
farbe <- c("Kreuz", "Pik", "Karo", "Herz")

Ereignisraum <- expand.grid(Münze=münze, Bild=bild, 
                            Farbe=farbe, Würfel=würfel)
head(Ereignisraum)

  Münze Bild Farbe Würfel
1  Kopf    7 Kreuz      1
2  Zahl    7 Kreuz      1
3  Kopf    8 Kreuz      1
4  Zahl    8 Kreuz      1
5  Kopf    9 Kreuz      1
6  Zahl    9 Kreuz      1

49.7 Lösung zur Aufgabe 44.5.7

df <- tribble(
  ~Impfung, ~Grippe, ~Häufigkeit,
   "Nein",   "Nein",   418,
   "Nein",    "Ja",    312,
   "Ja",     "Nein",   233,
   "Ja",     "Ja",   37)

a) Erzeugen Sie den Wahrscheinlichkeitsraum

wr <- probs::probspace(df[,-3],probs=df$Häufigkeit/sum(df$Häufigkeit))
wr

  Impfung Grippe probs
1    Nein   Nein 0.418
2    Nein     Ja 0.312
3      Ja   Nein 0.233
4      Ja     Ja 0.037

# Erstelle daraus die marginale Verteilung
probs::marginal(wr)

  Impfung Grippe probs
1      Ja     Ja 0.037
2    Nein     Ja 0.312
3      Ja   Nein 0.233
4    Nein   Nein 0.418

b) Wie groß ist die Wahrscheinlichkeit, dass eine zufällig ausgewählte Person geimpft ist?

probs::Prob(wr,event=Impfung=="Ja")

[1] 0.27

Die Wahrscheinlichkeit beträgt 27%.

c) Wie hoch ist die Prävalenz der Grippe?

probs::Prob(wr,event=Grippe=="Ja")

[1] 0.349

Die Prävalenz beträgt 34.9%.

d) Wie groß ist die Wahrscheinlichkeit, dass geimpfte Personen an Grippe erkranken? Ist die Impfung effektiv?

probs::Prob(wr,event=Grippe=="Ja", given=Impfung=="Ja")

[1] 0.137037

Die Wahrscheinlichkeit beträgt 13.7%.

49.8 Lösung zur Aufgabe 44.5.8

df <- tribble(
  ~Ebola, ~Test, ~Häufigkeit,
   "Nein",   "+",   28,
   "Nein",    "-",    97465,
   "Ja",     "+",   147,
   "Ja",     "-",   65)

a) Erzeugen Sie den Wahrscheinlichkeitsraum

wr <- probs::probspace(df[,-3],probs=df$Häufigkeit/sum(df$Häufigkeit))
wr

  Ebola Test        probs
1  Nein    + 0.0002865769
2  Nein    - 0.9975436262
3    Ja    + 0.0015045289
4    Ja    - 0.0006652679

# Erstelle daraus die marginale Verteilung
probs::marginal(wr)

  Ebola Test        probs
1    Ja    - 0.0006652679
2  Nein    - 0.9975436262
3    Ja    + 0.0015045289
4  Nein    + 0.0002865769

b) Berechnen Sie die Prävalenz von Ebola in der Bevölkerung.

probs::Prob(wr,event=Ebola=="Ja")

[1] 0.002169797

Die Prävalenz beträgt 0.22%.

c) Wie hoch ist die Wahrscheinlichkeit, ein negatives Testergebnis zu erhalten?

probs::Prob(wr,event=Test=="-")

[1] 0.9982089

Die Prävalenz beträgt 99.82%.

d) Berechnen Sie die Sensitivität und Spezifität des Tests.

# entweder 
# Sensitivität
probs::Prob(wr,event=Test=="+", given=Ebola=="Ja")

[1] 0.6933962

# Spezifität
probs::Prob(wr,event=Test=="-", given=Ebola=="Nein")

[1] 0.9997128

# oder
jgsbook::sens.spec(fp=28, rn=97465, rp=147, fn=65)

   sens  spec ppw   npw
1 69.34 99.97  84 99.93

e) Kann der Test besser Erkrankte erkennen, oder Gesunde?

jgsbook::sens.spec(fp=28, rn=97465, rp=147, fn=65)

   sens  spec ppw   npw
1 69.34 99.97  84 99.93

Er kann besser Gesunde erkennen.

f) Wenn eine Person einen positiven Test erhält, wie hoch ist dann die Wahrscheinlichkeit, dass er tatsächlich krank ist?

# positiv prädiktiv
probs::Prob(wr,event=Ebola=="Ja", given=Test=="+")

[1] 0.84

Die Wahrscheinlichkeit liegt bei 84%.

g) Wenn eine Person einen negativen Test erhält, wie hoch ist dann die Wahrscheinlichkeit, dass er tatsächlich gesund ist?

# negativ prädiktiv
probs::Prob(wr,event=Ebola=="Nein", given=Test=="-")

[1] 0.9993335

Die Wahrscheinlichkeit liegt bei 99.93%.

große Schlarmann, J. (2024a). Angewandte Übungen in R. Hochschule Niederrhein. https://github.com/produnis/angewandte_uebungen_in_R

große Schlarmann, J. (2024c). Statistik mit R und RStudio - Ein Nachschlagewerk für Gesundheitsberufe. Hochschule Niederrhein. https://www.produnis.de/R

große Schlarmann, J. (2024b). Statistik mit R und RStudio - Ein Nachschlagewerk für Gesundheitsberufe. Hochschule Niederrhein. https://www.produnis.de/R

große Schlarmann, J. (2024d). table traineR. Workouts für {data.table}. Hochschule Niederrhein. https://www.produnis.de/tabletrainer/

große Schlarmann, J. (2024e). trainingslageR. Ein Übungsbuch für R-Einsteiger*innen und Fortgeschrittene. Hochschule Niederrhein. https://www.produnis.de/trainingslager