Es ist häufig der Fall, dass ein Konfidenzintervall mit 95% Deckung einem glaubwürdigen Intervall sehr ähnlich ist, das 95% der posterioren Dichte enthält. Dies geschieht, wenn der Prior im letzteren Fall gleichförmig oder nahezu gleichförmig ist. Daher kann ein Konfidenzintervall häufig verwendet werden, um ein glaubwürdiges Intervall zu approximieren und umgekehrt. Wichtig ist, dass wir daraus schließen können, dass die häufig missverstandene Fehlinterpretation eines Konfidenzintervalls als glaubwürdiges Intervall für viele einfache Anwendungsfälle wenig bis gar keine praktische Bedeutung hat.
Es gibt eine Reihe von Beispielen für Fälle, in denen dies nicht der Fall ist, jedoch scheinen sie alle von Befürwortern der Bayes'schen Statistik ausgewählt worden zu sein, um zu beweisen, dass etwas mit dem frequentistischen Ansatz nicht in Ordnung ist. In diesen Beispielen sehen wir, dass das Konfidenzintervall unmögliche Werte usw. enthält, die zeigen sollen, dass sie Unsinn sind.
Ich möchte nicht auf diese Beispiele oder eine philosophische Diskussion von Bayesian vs Frequentist zurückkommen.
Ich suche nur Beispiele für das Gegenteil. Gibt es Fälle, in denen das Konfidenzintervall und das glaubwürdige Intervall erheblich voneinander abweichen und das vom Konfidenzverfahren bereitgestellte Intervall eindeutig überlegen ist?
Zur Verdeutlichung: Hierbei handelt es sich um die Situation, in der normalerweise erwartet wird, dass das glaubwürdige Intervall mit dem entsprechenden Konfidenzintervall übereinstimmt, dh wenn flache, einheitliche usw. Prioren verwendet werden. Ich interessiere mich nicht für den Fall, dass jemand einen willkürlich falschen Prior wählt.
EDIT: Als Antwort auf @JaeHyeok Shins Antwort unten muss ich nicht zustimmen, dass sein Beispiel die richtige Wahrscheinlichkeit verwendet. Ich habe die ungefähre Bayes'sche Berechnung verwendet, um die korrekte hintere Verteilung für Theta unten in R zu schätzen:
### 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))
Dies ist das zu 95% glaubwürdige Intervall:
> as.numeric(hdi(chain[, 1], credMass = 0.95))
[1] -1.400304 1.527371
EDIT # 2:
Hier ist ein Update nach @JaeHyeok Shins Kommentaren. Ich versuche es so einfach wie möglich zu halten, aber das Skript wurde etwas komplizierter. Hauptänderungen:
- Jetzt mit einer Toleranz von 0,001 für den Mittelwert (es war 1)
- Die Anzahl der Schritte wurde auf 500.000 erhöht, um eine geringere Toleranz zu berücksichtigen
- Der SD der Angebotsverteilung wurde auf 1 gesenkt, um eine geringere Toleranz zu berücksichtigen (10).
- Zum Vergleich wurde die einfache Normalwahrscheinlichkeit mit n = 2k hinzugefügt
- Die Stichprobengröße (n) wurde als zusammenfassende Statistik hinzugefügt. Setzen Sie die Toleranz auf 0,5 * n_Ziel
Hier ist der 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)
Die Ergebnisse, bei denen hdi1 meine "Wahrscheinlichkeit" und hdi2 das einfache rnorm (n, theta, 1) ist:
> 2*1.96/sqrt(2e3)
[1] 0.08765386
> diff(hdi1)
[1] 1.087125
> diff(hdi2)
[1] 0.07499163
Nach einer ausreichenden Verringerung der Toleranz und auf Kosten vieler weiterer MCMC-Schritte können wir die erwartete CrI-Breite für das Normalmodell sehen.