5  Globusversuch

5.1 Aufgabe 1

5.1.1 Aufgabe 1 a)

Nutzen Sie die Gittermethode gegliedert in 10 Hypothesen, um herauszufinden, welcher der wahrscheinlichste Wasseranteil des Globus ist, wenn wir bei 20 Durchführungen 14-mal Wasser getroffen haben.

set.seed(42)
d <-
  tibble(
    p_Gitter = seq(from = 0, to = 1, by = 0.1), #Definiere die Hypothesen
    Priori  = 1, #Bestimme die Priori-Werte
    Likelihood = dbinom(14, size = 20, prob = p_Gitter), #Likelihood für jeden Gitterwert
    unstd_Post = Likelihood * Priori, #unstand. Posteriori-Werte
    Post = unstd_Post / sum(unstd_Post)) %>% #stand. Posteriori-Werte (summiert zu 1)
    mutate(
      Post = round(Post, digits = 2)) #Runde die Posteriori-Werte auf 2 Dezimalstellen (oder eine andere gewünschte Anzahl)
d %>%
  arrange(-Post)

Der wahrscheinlichste Wasseranteil (laut unserem Modell) ist 0,7. Die Wahrscheinlichkeit beträgt 40 %.

5.1.2 Aufgabe 1 b)

Wie groß ist die Wahrscheinlichkeit, dass der Globus über 50 Prozent Wasseranteil hat (laut unserem Modell)?

d%>%
  filter(p_Gitter > 0.5)%>%
  summarise(sum(Post))
1
Zeige nur noch die Wasseranteile über 50 Prozent.
2
Die Funktion sum() summiert alle Werte einer Spalte; in diesem Fall ist diese Spalte Post.

Die Wahrscheinlichkeit, dass der Wasseranteil auf dem Globus größer ist als 50 Prozent, liegt laut unserem Modell bei 91 %.

5.1.3 Aufgabe 1 c)

Wie groß ist die Wahrscheinlichkeit, einen Wasseranteil zwischen 50 und 70 Prozent zu erhalten?

d%>%
  filter(p_Gitter > .5 & p_Gitter < .7)%>%
  summarise(sum(Post))

Die Wahrscheinlichkeit, dass der Wasseranteil laut unserem Modell zwischen 50 und 70 Prozent liegt, ist ca. 26 Prozent.

5.1.4 Aufgabe 1 d)

Wie groß ist die Wahrscheinlichkeit, dass der Wasseranteil 70 Prozent nicht übersteigt?

d%>%
  filter(p_Gitter <= .7)%>%
  summarise(sum(Post))

Grob 35 Prozent der Posteriori-Verteilung liegt unterhalb eines Wasseranteils von 70 Prozent. Das heißt, ein Wasseranteil von 70 Prozent wird mit 35-prozentiger Wahrscheinlichkeit nicht überschritten.

5.1.5 Aufgabe 1 e)

Nehmen Sie an, Sie könnten begründen, dass ein Wasseranteil unter 50 % nicht existiert. Formen Sie die Gittermethode so, dass Werte unterhalb von 50 % Wasseranteil eine Posteriori-Wahrscheinlichkeit von 0 bekommen. Tipp: Nutzen Sie die Funktion case_when(), um den Prior zu definieren.

set.seed(42)

d3 <-
  tibble(
    p_Gitter = seq(from = 0, to = 1, by = 0.1), #Definiere die Hypothesen
    Priori  = case_when(p_Gitter < 0.5 ~ 0, #Für alle p_Gitter-Werte unter 0.5 gilt apriori 0
                        p_Gitter >= 0.5 ~ 1), #Für alle p_Gitter-Werte über oder gleich 0.5 gilt apriori 1
    Likelihood = dbinom(14, size = 20, prob = p_Gitter), #Berechne Likelihood für jeden Gitterwert
    unstd_Post = Likelihood * Priori, #Berechne unstand. Posteriori-Werte
    Post = round(unstd_Post / sum(unstd_Post), 2)) #Berechne und runde stand. Posteriori-Werte
d3

5.2 Aufgabe 2

Stellen Sie sich folgendes Szenario vor:
Sie wollen einen USB-Stick an Ihren Computer anschließen und erwischen die falsche Seite. Kein Problem, denken Sie, dann wird es wohl die andere sein. Also drehen Sie den Stick um und probieren es mit der anderen Seite. Aber schon wieder passt es nicht! Da kann doch irgendwas nicht stimmen.

5.2.1 Aufgabe 2 a)

Nutzen Sie die Funktion dbinom(), um zu ermitteln, wie groß die Wahrscheinlichkeit ist, dass wir nur eines von fünf Malen treffen, obwohl die Trefferwahrscheinlichkeit bei 50 % liegen.

dbinom(1, size = 5, prob = .5)
[1] 0.15625

Unser Szenario, also dass wir eines von fünf Malen treffen, hat eine Eintrittswahrscheinlichkeit von ca. 16 Prozent, wenn die Trefferchance tatsächlich 50/50 steht. Aber wenn die Wahrscheinlichkeit so gering ist, dann kann es doch nicht sein, dass uns dieses Szenario trotzdem so regelmäßig passiert?

5.2.2 Aufgabe 2 b)

Berechnen wir ein Mal die Wahrscheinlichkeit eines von fünf Malen zu treffen, wenn die Trefferahrscheinlichkeit bei 20 Prozent läge.

dbinom(1, 5, .2)
[1] 0.4096

Das Ergebnis sagt uns: Wenn die Trefferwahrscheinlichkeit bei 20 Prozent liegt, dann sollten wir in ca. 41 Prozent der Fälle eines von fünf Mal treffen. Scheint uns das nicht etwas plausibler? Naja, zumindest ist es wahrscheinlicher, als wenn wir eine Trefferchance von 50/50 annehmen.

5.2.3 Aufgabe 2 c)

Definieren wir nun ein Modell, dass 100 Variationen der Trefferchance (d.h. 100 Paramterwerte/Hypothesen) beinhaltet. Außerdem schließen wir von vornherein aus, dass die Trefferchance größer ist als 30 %.

set.seed(42)

USB <-
  tibble(c_Treffer = seq(0, 1, by = 0.01),
         Priori = case_when(c_Treffer > 0.3 ~ 0,
                            c_Treffer <= 0.3 ~ 1))%>%
  mutate(Likelihood = dbinom(1, size = 5, prob = c_Treffer),
         unst_Post = Priori * Likelihood,
         Post = unst_Post / sum(unst_Post))
USB

Das Modell steht. Wir sehen, dass Beobachtungen mit einer Trefferchance von mehr als 30 % in der Post-Spalte eine Wahrscheinlichkeit von Null haben.

5.2.4 Aufgabe 2 d)

Wie groß ist die Wahrscheinlichkeit, dass die echte Trefferchance (laut unserem Modell) zwischen 12,5 % und 27,5 % liegt?

USB%>%
  filter(c_Treffer > 0.125 & c_Treffer < 0.275)%>%
  summarise(sum(Post))

5.2.5 Aufgabe 2 e)

Welcher ist der wahrscheinlichste Anteil, laut unserem Modell?

USB%>%
  arrange(-Post)

Nach unserem Modell ist die wahrscheinlichste Trefferchance ca. 20 Prozent. Allerdings hat diese für sich genommen nur eine Wahrscheinlichkeit von 4 %. Wir wissen allerdings auch aus Aufgabe 2d, dass sich ca. 60 % der Wahrscheinlichkeitsmasse in dem Intervall zwischen 12,5 % Trefferchance und 27,5 Prozent Trefferchance befinden.

Wir können also nach unserem Modell schließen, dass die echte Trefferchance vermutlich sehr nahe bei 20 % liegt, allerdings mit einer Wahrscheinlichkeit von 60 Prozent, irgendwo in dem Intervall zwischen 12,5 % und 27,5 %.

5.3 Codesammlung

Gitter erstellen

d <-
  tibble(
    # definiere das Gitter: 
    p_Gitter = seq(from = 0, to = 1, by = 0.1),
    # bestimme den Priori-Wert:       
    Priori  = 1) %>%  
    mutate(
      # berechne Likelihood für jeden Gitterwert:
      Likelihood = dbinom(x, size = n, prob = p_Gitter),
      # berechen unstand. Posteriori-Werte:
      unstd_Post = Likelihood * Priori,
      # berechne stand. Posteriori-Werte (summiert zu 1):
      Post = unstd_Post / sum(unstd_Post)) %>%
    mutate(
      # Runde die Posteriori-Werte auf 2 Dezimalstellen (oder eine andere gewünschte Anzahl):
      Post = round(Post, digits = 2))

Wahrscheinlichster Wert bei X Treffern von n?

d %>%
  arrange(-Post)

Wie groß ist die Wahrscheinlichkeit für Anteil von über X Prozent?

d%>%
  filter(p_Gitter > 0.X)%>% #zeige nur noch die Wasseranteile über X Prozent
  summarise(sum(Post)) #die Funktion sum() summiert alle Werte einer Spalte; in diesem Fall ist diese Spalte Post

Wie groß ist die Wahrscheinlichkeit für einen Anteil zwischen X und Y Prozent?

d%>%
  filter(p_Gitter > .X & p_Gitter < .Y)%>%
  summarise(sum(Post))

Apriori vorher definieren, Anteil unter X% existiert nicht:

d2 <-
  tibble(
    # definiere das Gitter: 
    p_Gitter = seq(from = 0, to = 1, by = 0.1),
    # bestimme den Priori-Wert:       
    Priori  = case_when(p_Gitter < 0.X ~ 0, #alle p_Gitter-Werte unter 0.X werden mit 0 verrechnet
                        p_Gitter >= 0.X ~ 1)) %>%  #alle p_Gitter-Werte über oder gleich 0.X sind gleichwahrscheinlich und werden mit 1 verrechnet
    mutate(
      # berechne Likelihood für jeden Gitterwert:
      Likelihood = dbinom(x, size = n, prob = p_Gitter),
     # berechen unstand. Posteriori-Werte:
      unstd_Post = Likelihood * Priori,
      # berechne stand. Posteriori-Werte (summiert zu 1):
      Post = unstd_Post / sum(unstd_Post)) %>%
    mutate(
      # Runde die Posteriori-Werte auf 2 Dezimalstellen (oder eine andere gewünschte Anzahl):
      Post = round(Post, digits = 2))

Binomialverteilung aufstellen, um die Wahrscheinlichkeit für ein bestimmtes Ereignis zu bekommen: Wie wahrscheinlich ist es, X Treffern von n zu bekommen, wenn die Trefferwahrscheinlichkeit bei Y% liegt?

dbinom(x, size = n, prob = .y)