Il arrive souvent qu'un intervalle de confiance avec une couverture de 95% soit très similaire à un intervalle crédible qui contient 95% de la densité postérieure. Cela se produit lorsque le prieur est uniforme ou presque uniforme dans ce dernier cas. Ainsi, un intervalle de confiance peut souvent être utilisé pour approximer un intervalle crédible et vice versa. Surtout, nous pouvons en conclure que la mauvaise interprétation très diffamatoire d'un intervalle de confiance en tant qu'intervalle crédible a peu ou pas d'importance pratique pour de nombreux cas d'utilisation simples.
Il existe un certain nombre d'exemples de cas où cela ne se produit pas, mais ils semblent tous être triés sur le volet par les partisans des statistiques bayésiennes dans le but de prouver qu'il y a un problème avec l'approche fréquentiste. Dans ces exemples, nous voyons que l'intervalle de confiance contient des valeurs impossibles, etc. qui sont censées montrer qu'elles sont absurdes.
Je ne veux pas revenir sur ces exemples, ou une discussion philosophique de Bayesian vs Frequentist.
Je cherche juste des exemples du contraire. Y a-t-il des cas où la confiance et les intervalles crédibles sont sensiblement différents, et l'intervalle fourni par la procédure de confiance est clairement supérieur?
Pour clarifier: il s'agit de la situation dans laquelle l'intervalle crédible devrait généralement coïncider avec l'intervalle de confiance correspondant, c'est-à-dire lors de l'utilisation de prieurs plats, uniformes, etc. Je ne suis pas intéressé par le cas où quelqu'un choisit un prieur arbitrairement mauvais.
EDIT: En réponse à la réponse de @JaeHyeok Shin ci-dessous, je ne suis pas d'accord que son exemple utilise la bonne probabilité. J'ai utilisé le calcul bayésien approximatif pour estimer la distribution postérieure correcte pour thêta ci-dessous dans R:
### Methods ###
# Packages
require(HDInterval)
# Define the likelihood
like <- function(k = 1.2, theta = 0, n_print = 1e5){
x = NULL
rule = FALSE
while(!rule){
x = c(x, rnorm(1, theta, 1))
n = length(x)
x_bar = mean(x)
rule = sqrt(n)*abs(x_bar) > k
if(n %% n_print == 0){ print(c(n, sqrt(n)*abs(x_bar))) }
}
return(x)
}
# Plot results
plot_res <- function(chain, i){
par(mfrow = c(2, 1))
plot(chain[1:i, 1], type = "l", ylab = "Theta", panel.first = grid())
hist(chain[1:i, 1], breaks = 20, col = "Grey", main = "", xlab = "Theta")
}
### Generate target data ###
set.seed(0123)
X = like(theta = 0)
m = mean(X)
### Get posterior estimate of theta via ABC ###
tol = list(m = 1)
nBurn = 1e3
nStep = 1e4
# Initialize MCMC chain
chain = as.data.frame(matrix(nrow = nStep, ncol = 2))
colnames(chain) = c("theta", "mean")
chain$theta[1] = rnorm(1, 0, 10)
# Run ABC
for(i in 2:nStep){
theta = rnorm(1, chain[i - 1, 1], 10)
prop = like(theta = theta)
m_prop = mean(prop)
if(abs(m_prop - m) < tol$m){
chain[i,] = c(theta, m_prop)
}else{
chain[i, ] = chain[i - 1, ]
}
if(i %% 100 == 0){
print(paste0(i, "/", nStep))
plot_res(chain, i)
}
}
# Remove burn-in
chain = chain[-(1:nBurn), ]
# Results
plot_res(chain, nrow(chain))
as.numeric(hdi(chain[, 1], credMass = 0.95))
Voici l'intervalle crédible à 95%:
> as.numeric(hdi(chain[, 1], credMass = 0.95))
[1] -1.400304 1.527371
EDIT # 2:
Voici une mise à jour après les commentaires de @JaeHyeok Shin. J'essaie de le garder aussi simple que possible, mais le script est devenu un peu plus compliqué. Principaux changements:
- Utilisant maintenant une tolérance de 0,001 pour la moyenne (elle était de 1)
- Augmentation du nombre d'étapes à 500k pour tenir compte d'une plus petite tolérance
- Diminution du sd de la distribution de la proposition à 1 pour tenir compte d'une tolérance plus petite (elle était de 10)
- Ajout de la vraisemblance rnorm simple avec n = 2k pour comparaison
- Ajout de la taille de l'échantillon (n) en tant que statistique récapitulative, définissez la tolérance à 0,5 * n_target
Voici le code:
### Methods ###
# Packages
require(HDInterval)
# Define the likelihood
like <- function(k = 1.3, theta = 0, n_print = 1e5, n_max = Inf){
x = NULL
rule = FALSE
while(!rule){
x = c(x, rnorm(1, theta, 1))
n = length(x)
x_bar = mean(x)
rule = sqrt(n)*abs(x_bar) > k
if(!rule){
rule = ifelse(n > n_max, TRUE, FALSE)
}
if(n %% n_print == 0){ print(c(n, sqrt(n)*abs(x_bar))) }
}
return(x)
}
# Define the likelihood 2
like2 <- function(theta = 0, n){
x = rnorm(n, theta, 1)
return(x)
}
# Plot results
plot_res <- function(chain, chain2, i, main = ""){
par(mfrow = c(2, 2))
plot(chain[1:i, 1], type = "l", ylab = "Theta", main = "Chain 1", panel.first = grid())
hist(chain[1:i, 1], breaks = 20, col = "Grey", main = main, xlab = "Theta")
plot(chain2[1:i, 1], type = "l", ylab = "Theta", main = "Chain 2", panel.first = grid())
hist(chain2[1:i, 1], breaks = 20, col = "Grey", main = main, xlab = "Theta")
}
### Generate target data ###
set.seed(01234)
X = like(theta = 0, n_print = 1e5, n_max = 1e15)
m = mean(X)
n = length(X)
main = c(paste0("target mean = ", round(m, 3)), paste0("target n = ", n))
### Get posterior estimate of theta via ABC ###
tol = list(m = .001, n = .5*n)
nBurn = 1e3
nStep = 5e5
# Initialize MCMC chain
chain = chain2 = as.data.frame(matrix(nrow = nStep, ncol = 2))
colnames(chain) = colnames(chain2) = c("theta", "mean")
chain$theta[1] = chain2$theta[1] = rnorm(1, 0, 1)
# Run ABC
for(i in 2:nStep){
# Chain 1
theta1 = rnorm(1, chain[i - 1, 1], 1)
prop = like(theta = theta1, n_max = n*(1 + tol$n))
m_prop = mean(prop)
n_prop = length(prop)
if(abs(m_prop - m) < tol$m &&
abs(n_prop - n) < tol$n){
chain[i,] = c(theta1, m_prop)
}else{
chain[i, ] = chain[i - 1, ]
}
# Chain 2
theta2 = rnorm(1, chain2[i - 1, 1], 1)
prop2 = like2(theta = theta2, n = 2000)
m_prop2 = mean(prop2)
if(abs(m_prop2 - m) < tol$m){
chain2[i,] = c(theta2, m_prop2)
}else{
chain2[i, ] = chain2[i - 1, ]
}
if(i %% 1e3 == 0){
print(paste0(i, "/", nStep))
plot_res(chain, chain2, i, main = main)
}
}
# Remove burn-in
nBurn = max(which(is.na(chain$mean) | is.na(chain2$mean)))
chain = chain[ -(1:nBurn), ]
chain2 = chain2[-(1:nBurn), ]
# Results
plot_res(chain, chain2, nrow(chain), main = main)
hdi1 = as.numeric(hdi(chain[, 1], credMass = 0.95))
hdi2 = as.numeric(hdi(chain2[, 1], credMass = 0.95))
2*1.96/sqrt(2e3)
diff(hdi1)
diff(hdi2)
Les résultats, où hdi1 est ma "vraisemblance" et hdi2 est la rnorm simple (n, thêta, 1):
> 2*1.96/sqrt(2e3)
[1] 0.08765386
> diff(hdi1)
[1] 1.087125
> diff(hdi2)
[1] 0.07499163
Ainsi, après avoir suffisamment abaissé la tolérance, et au détriment de nombreuses autres étapes MCMC, nous pouvons voir la largeur CrI attendue pour le modèle rnorm.