Bayesianische Analyse mit vorherigem Histogramm. Warum Simulationen von hinten zeichnen?

Dies ist eine Anfängerfrage zu einer Übung in Jim Alberts „Bayesian Computation with R“. Beachten Sie, dass dies zwar Hausaufgaben sein können, in meinem Fall jedoch nicht, da ich Bayes'sche Methoden in R lerne, weil ich denke, dass ich sie in meinen zukünftigen Analysen verwenden könnte.

Obwohl dies eine spezifische Frage ist, beinhaltet sie wahrscheinlich ein grundlegendes Verständnis der Bayes'schen Methoden.

In Übung 2.2 bittet uns Jim Albert, das Experiment eines Penny Throws zu analysieren. Siehe hier. Wir müssen vorher ein Histogramm verwenden, dh den Raum möglicher pWerte in 10 Längenintervalle teilen .1und diesen eine vorherige Wahrscheinlichkeit zuweisen.

Da ich weiß, dass die wahre Wahrscheinlichkeit sein wird .5, und ich denke, dass es höchst unwahrscheinlich ist, dass das Universum die Wahrscheinlichkeitsgesetze geändert hat oder der Penny robust ist, sind meine Prioritäten:

prior <- c(1,5,20,100,5000,5000,100,20,5,1)
prior <- prior/sum(prior)

entlang der Intervallmittelpunkte

midpt <- seq(0.05, 0.95, by=0.1)

So weit, ist es gut. Als nächstes drehen wir den Penny 20 Mal und zeichnen die Anzahl der Erfolge (Köpfe) und Misserfolge (Schwanz) auf. Einfach gemacht:

y <- rbinom(n=20,p=.5,size=1)
s <- sum(y==1)
f <- sum(y==0)

In meiner Erfahrung s == 7und f == 13. Als nächstes kommt der Teil, den ich nicht verstehe:

Simulieren Sie aus der posterioren Verteilung, indem Sie (1) die posteriore Dichte von p in einem Gitter von Werten auf (0,1) berechnen und (2) eine simulierte Probe mit Ersetzung aus dem Gitter entnehmen. (Die Funktion histpriorund samplesind bei dieser Berechnung hilfreich). Wie haben sich die Intervallwahrscheinlichkeiten aufgrund Ihrer Daten verändert?

So wird's gemacht:

p <- seq(0,1, length=500)
post <- histprior(p,midpt,prior) * dbeta(p,s+1,f+1)
post <- post/sum(post)

ps <- sample(p, replace=TRUE, prob = post)

Aber warum machen wir das ?

Wir können die hintere Dichte leicht erhalten, indem wir den Prior mit der entsprechenden Wahrscheinlichkeit multiplizieren, wie in Zeile zwei des obigen Blocks ausgeführt. Dies ist eine Darstellung der posterioren Verteilung:

Wenn die posteriore Verteilung geordnet ist, können wir Ergebnisse für die zuvor im Histogramm eingeführten Intervalle erhalten, indem wir Elemente der posterioren Dichte zusammenfassen:

post.vector <- vector()
post.vector[1] <- sum(post[p < 0.1])
post.vector[2] <- sum(post[p > 0.1 & p <= 0.2])
post.vector[3] <- sum(post[p > 0.2 & p <= 0.3])
post.vector[4] <- sum(post[p > 0.3 & p <= 0.4])
post.vector[5] <- sum(post[p > 0.4 & p <= 0.5])
post.vector[6] <- sum(post[p > 0.5 & p <= 0.6])
post.vector[7] <- sum(post[p > 0.6 & p <= 0.7])
post.vector[8] <- sum(post[p > 0.7 & p <= 0.8])
post.vector[9] <- sum(post[p > 0.8 & p <= 0.9])
post.vector[10] <- sum(post[p > 0.9 & p <= 1])

(R-Experten könnten einen besseren Weg finden, um diesen Vektor zu erstellen. Ich denke, es könnte etwas damit zu tun haben sweep?)

round(cbind(midpt,prior,post.vector),3)

      midpt prior post.vector
 [1,]  0.05 0.000       0.000
 [2,]  0.15 0.000       0.000
 [3,]  0.25 0.002       0.003
 [4,]  0.35 0.010       0.022
 [5,]  0.45 0.488       0.737
 [6,]  0.55 0.488       0.238
 [7,]  0.65 0.010       0.001
 [8,]  0.75 0.002       0.000
 [9,]  0.85 0.000       0.000
[10,]  0.95 0.000       0.000

Darüber hinaus haben wir 500 Draws aus der posterioren Verteilung, die uns nichts anderes sagen. Hier ist ein Diagramm der Dichte der simulierten Zeichnungen:

Jetzt verwenden wir die simulierten Daten, um Wahrscheinlichkeiten für unsere Intervalle zu erhalten, indem wir zählen, welcher Anteil der Simulationen innerhalb des Intervalls liegt:

sim.vector <- vector()
sim.vector[1] <- length(ps[ps < 0.1])/length(ps)
sim.vector[2] <- length(ps[ps > 0.1 & ps <= 0.2])/length(ps)
sim.vector[3] <- length(ps[ps > 0.2 & ps <= 0.3])/length(ps)
sim.vector[4] <- length(ps[ps > 0.3 & ps <= 0.4])/length(ps)
sim.vector[5] <- length(ps[ps > 0.4 & ps <= 0.5])/length(ps)
sim.vector[6] <- length(ps[ps > 0.5 & ps <= 0.6])/length(ps)
sim.vector[7] <- length(ps[ps > 0.6 & ps <= 0.7])/length(ps)
sim.vector[8] <- length(ps[ps > 0.7 & ps <= 0.8])/length(ps)
sim.vector[9] <- length(ps[ps > 0.8 & ps <= 0.9])/length(ps)
sim.vector[10] <- length(ps[ps > 0.9 & ps <= 1])/length(ps)

(Nochmals: Gibt es einen effizienteren Weg, dies zu tun?)

Ergebnisse zusammenfassen:

round(cbind(midpt,prior,post.vector,sim.vector),3)

      midpt prior post.vector sim.vector
 [1,]  0.05 0.000       0.000      0.000
 [2,]  0.15 0.000       0.000      0.000
 [3,]  0.25 0.002       0.003      0.000
 [4,]  0.35 0.010       0.022      0.026
 [5,]  0.45 0.488       0.737      0.738
 [6,]  0.55 0.488       0.238      0.236
 [7,]  0.65 0.010       0.001      0.000
 [8,]  0.75 0.002       0.000      0.000
 [9,]  0.85 0.000       0.000      0.000
[10,]  0.95 0.000       0.000      0.000

Es ist nicht verwunderlich, dass die Simultan keine anderen Ergebnisse liefert als der hintere, auf dem sie basiert. So warum ziehen wir diese Simulationen in erster Linie ?

Um Ihre Unterfrage zu beantworten: Wie können Sie Folgendes eleganter machen?

post.vector <- vector()
post.vector[1] <- sum(post[p < 0.1])
post.vector[2] <- sum(post[p > 0.1 & p <= 0.2])
post.vector[3] <- sum(post[p > 0.2 & p <= 0.3])
post.vector[4] <- sum(post[p > 0.3 & p <= 0.4])
post.vector[5] <- sum(post[p > 0.4 & p <= 0.5])
post.vector[6] <- sum(post[p > 0.5 & p <= 0.6])
post.vector[7] <- sum(post[p > 0.6 & p <= 0.7])
post.vector[8] <- sum(post[p > 0.7 & p <= 0.8])
post.vector[9] <- sum(post[p > 0.8 & p <= 0.9])
post.vector[10] <- sum(post[p > 0.9 & p <= 1])

Der einfachste Weg, dies mit Base R zu tun, ist:

group <- cut(p, breaks=seq(0,1,0.1), include.lowest = T)
post.vector.alt <- aggregate(post, FUN=sum, by=list(group))

Beachten Sie, dass die Pausen von 0 bis 1 gehen. Dies ergibt:

     Group.1            x
1    [0,0.1] 3.030528e-13
2  (0.1,0.2] 1.251849e-08
3  (0.2,0.3] 6.385088e-06
4  (0.3,0.4] 6.732672e-04
5  (0.4,0.5] 2.376448e-01
6  (0.5,0.6] 7.372805e-01
7  (0.6,0.7] 2.158296e-02
8  (0.7,0.8] 2.691182e-03
9  (0.8,0.9] 1.205200e-04
10   (0.9,1] 3.345072e-07

Und wir haben:

> all.equal (post.vector.alt$x, post.vector)
[1] TRUE

Mein Verständnis ist, dass, da die posteriore Dichte, die aus dem Produkt der vorherigen Dichte und Wahrscheinlichkeit erhalten wird, nur ungefähr die posteriore Dichte ist, wir daher keinen direkten Rückschluss daraus ziehen können.

Folglich müssen wir eine Zufallsstichprobe daraus ziehen und Rückschlüsse auf die Stichprobe ziehen, genau wie bei der Simulationsmethode für den hinteren Teil der Beta-Familie.