多くの場合、95%のカバレッジの信頼区間は、95%の事後密度を含む信頼区間と非常によく似ています。これは、前者が均一であるか、後者の場合にほぼ均一であるときに起こります。したがって、信頼区間を近似するために信頼区間を使用することがよくあります。重要なことは、これから、信頼区間としての信頼区間のひどく間違った誤解は、多くの単純なユースケースにとって実際的重要性がほとんどないか、まったくないということを結論付けることができます。
これが起こらない場合の例はたくさんありますが、それらはすべて、頻繁なアプローチに何か問題があることを証明しようとして、ベイジアン統計の支持者によって厳選されているようです。これらの例では、信頼区間に不可能な値などが含まれており、それらがナンセンスであることを示しています。
これらの例や、ベイジアン対フリークエンティストの哲学的議論に戻りたくありません。
私はちょうど反対の例を探しています。信頼区間と信頼区間が大幅に異なり、信頼手順によって提供される区間が明らかに優れている場合はありますか?
明確にするために:これは、信頼できる区間が通常、対応する信頼区間と一致すると予想される状況、つまり、フラット、均一などの事前分布を使用する状況についてです。誰かが勝手に悪い事前を選択する場合には興味がありません。
編集: 以下の@JaeHyeok Shinの回答に応じて、彼の例が正しい尤度を使用していることに同意しなければなりません。近似ベイズ計算を使用して、以下の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))
これは95%の信頼できる間隔です。
> as.numeric(hdi(chain[, 1], credMass = 0.95))
[1] -1.400304 1.527371
編集#2:
@JaeHyeok Shinのコメントの後の更新です。できるだけシンプルにしようとしていますが、スクリプトはもう少し複雑になりました。主な変更:
- 現在、平均に0.001の許容値を使用しています(1でした)
- 許容誤差を小さくするために、ステップ数を500kに増やしました
- 許容差を小さくするために、プロポーザル分布のsdを1に減らしました(10でした)
- 比較のためにn = 2kの単純なノルム尤度を追加
- サンプルサイズ(n)を要約統計として追加し、許容値を0.5 * n_targetに設定
コードは次のとおりです。
### 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)
結果は、hdi1が私の「可能性」であり、hdi2は単純なrnorm(n、theta、1)です。
> 2*1.96/sqrt(2e3)
[1] 0.08765386
> diff(hdi1)
[1] 1.087125
> diff(hdi2)
[1] 0.07499163
そのため、許容誤差を十分に下げ、さらに多くのMCMCステップを犠牲にして、rnormモデルの予想されるCrI幅を確認できます。