事前ヒストグラムによるベイズ分析。なぜ後方からシミュレーションを描くのですか？

これは、ジムアルバートの「Rを使用したベイジアン計算」の演習に関する初心者の質問です。これは宿題かもしれませんが、私の場合はそうではないことに注意してください。私はRでベイズ法を学んでいるので、将来の分析でそれを使用するかもしれないと思うからです。

とにかく、これは特定の質問ですが、おそらくベイズ法の基本的な理解が関係しています。

したがって、エクササイズ2.2では、ジムアルバートがペニースローの実験を分析するように求めています。こちらをご覧ください。事前ヒストグラムを使用します。つまり、可能なp値のスペースを10の長さの間隔で分割し.1、事前確率をこれらに割り当てます。

私は真の確率がになることを知っており.5、宇宙が確率の法則を変更したり、ペニーが頑丈である可能性は非常に低いと思うので、私の事前確率は次のとおりです。

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

区間中点に沿って

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

ここまでは順調ですね。次に、ペニーを20回スピンし、成功（ヘッド）と失敗（テール）の数を記録します。簡単にできます：

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

私の支出では、s == 7そしてf == 13。次に私が理解していない部分があります：

（1）（0,1）の値のグリッドでpの事後密度を計算し、（2）グリッドから置き換えてシミュレートしたサンプルを取得することにより、事後分布からシミュレートします。（関数 histpriorとsampleはこの計算に役立ちます）。データに基づいて間隔確率はどのように変化しましたか？

これがどのように行われるかです：

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)

しかし、なぜそれを行うのですか？

上記のブロックの2行目で行ったように、事前分布に適切な尤度を乗算することにより、事後密度を簡単に取得できます。これは事後分布のプロットです。

事後分布が順序付けられているため、事後密度の要素を要約することにより、事前にヒストグラムに導入された間隔の結果を取得できます。

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エキスパートは、そのベクトルを作成するためのより良い方法を見つけるかもしれません。私はそれが何かと関係があるかもしれませんね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

さらに、事後分布から500のドローがあり、違いは何もありません。これは、シミュレートされた描画の密度のプロットです。

次に、シミュレーションデータを使用して、区間内のシミュレーションの割合をカウントすることにより、区間の確率を取得します。

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)

（再度：これを行うためのより効率的な方法はありますか？）

結果の要約：

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

シマルチンが基にした後部以外の結果を生成しないことは驚くに値しません。したがって、なぜ最初にそれらのシミュレーションを描画したのですか？

あなたのサブ質問に答えるために：以下をよりエレガントにするにはどうすればいいですか？

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を使用してこれを行う最も簡単な方法は、次のとおりです。

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

ブレークは0から1に変わることに注意してください。これにより、次の結果が得られます。

     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

そして私たちは持っています：

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

私の理解は、事前密度と尤度の積から得られる事後密度は事後密度の単なる近似値であるため、それから直接正確に推論することはできないということです。

したがって、ベータファミリーからの事後のシミュレーション方法と同じように、ランダムなサンプルを抽出し、サンプルから推論を行う必要があります。