Analyse bayésienne avec histogramme préalable. Pourquoi dessiner des simulations du postérieur?

Il s'agit d'une question de débutant sur un exercice du «calcul bayésien avec R» de Jim Albert. Notez que bien que cela puisse être un devoir, dans mon cas, ce n'est pas le cas, car j'apprends les méthodes bayésiennes en R parce que je pense que je pourrais l'utiliser dans mes futures analyses.

Quoi qu'il en soit, bien qu'il s'agisse d'une question spécifique, elle implique probablement une compréhension de base des méthodes bayésiennes.

Ainsi, dans l'exercice 2.2, Jim Albert nous demande d'analyser l'expérience d'un jet de sou. Vois ici. Nous devons utiliser un histogramme préalable, c'est-à-dire diviser l'espace des pvaleurs possibles en 10 intervalles de longueur .1et leur attribuer une probabilité préalable.

Puisque je sais que la vraie probabilité sera .5, et je pense qu'il est hautement improbable que l'univers ait changé les lois de probabilité ou que le sou soit robuste, mes prieurs sont:

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

le long des points intermédiaires

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

Jusqu'ici tout va bien. Ensuite, nous tournons le sou 20 fois et enregistrons le nombre de succès (têtes) et d'échecs (queue). Facile à faire:

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

Dans mon expérience, s == 7et f == 13. Vient ensuite la partie que je ne comprends pas:

Simuler à partir de la distribution postérieure en (1) calculant la densité postérieure de p sur une grille de valeurs sur (0,1) et (2) en prenant un échantillon simulé avec remplacement à partir de la grille. (La fonction histprioret samplesont utiles dans ce calcul). Comment les probabilités d'intervalle ont-elles changé sur la base de vos données?

Voici comment cela se fait:

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)

Mais pourquoi faisons-nous cela ?

Nous pouvons facilement obtenir la densité postérieure en multipliant l'a priori avec la probabilité appropriée, comme cela est fait dans la ligne deux du bloc ci-dessus. Ceci est un tracé de la distribution postérieure:

Comme la distribution postérieure est ordonnée, nous pouvons obtenir des résultats pour les intervalles introduits dans l'histogramme préalable en résumant les éléments de la densité postérieure:

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])

(Les experts en R pourraient trouver une meilleure façon de créer ce vecteur. Je suppose que cela pourrait avoir quelque chose à voir avec ça 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

De plus, nous avons 500 tirages de la distribution postérieure qui ne nous disent rien de différent. Voici un graphique de la densité des tirages simulés:

Maintenant, nous utilisons les données simulées pour obtenir des probabilités pour nos intervalles en comptant la proportion de simulations dans l'intervalle:

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)

(Encore une fois: existe-t-il un moyen plus efficace de le faire?)

Résumez les résultats:

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

Il n'est pas surprenant que la simultion ne produise aucun autre résultat que le postérieur, sur lequel elle était basée. Ainsi, pourquoi avons-nous dessiné ces simulations en premier lieu ?

Pour répondre à votre sous-question: comment faire les choses suivantes de manière plus élégante?

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])

La façon la plus simple de le faire en utilisant la base R est:

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

Notez que les ruptures vont de 0 à 1. Cela donne:

     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

Et nous avons:

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

Ma compréhension est que, puisque la densité postérieure obtenue à partir du produit de la densité et de la probabilité antérieures n'est qu'un APPROXIMATIF de la densité postérieure, nous ne pouvons donc pas en faire directement d'inférence EXACTE.

Par conséquent, nous devons en prélever un échantillon aléatoire et procéder à une inférence à partir de l'échantillon, tout comme la méthode de simulation pour la famille postérieure de la famille bêta.