มันมักจะเป็นกรณีที่ช่วงความเชื่อมั่นที่มีความคุ้มครอง 95% จะคล้ายกันมากกับช่วงเวลาที่น่าเชื่อถือที่มี 95% ของความหนาแน่นหลัง สิ่งนี้เกิดขึ้นเมื่อชุดก่อนหน้านั้นเหมือนกันหรือใกล้เคียงในกรณีหลัง ดังนั้นช่วงความมั่นใจมักจะถูกใช้เพื่อประมาณช่วงเวลาที่น่าเชื่อถือและในทางกลับกัน ที่สำคัญเราสามารถสรุปได้ว่าสิ่งนี้เป็นการตีความที่ผิดพลาดอย่างมากของช่วงความเชื่อมั่นเนื่องจากช่วงเวลาที่น่าเชื่อถือนั้นมีความสำคัญเพียงเล็กน้อยถึงไม่มีประโยชน์เลยสำหรับกรณีการใช้งานที่ง่าย
มีตัวอย่างจำนวนมากที่มีกรณีที่สิ่งนี้ไม่ได้เกิดขึ้นอย่างไรก็ตามพวกเขาทั้งหมดดูเหมือนจะถูกเชอร์รี่โดยผู้สนับสนุนของ Bayesian stats ในความพยายามที่จะพิสูจน์ว่ามีบางอย่างผิดปกติกับวิธีการที่ใช้บ่อย ในตัวอย่างเหล่านี้เราจะเห็นช่วงความมั่นใจมีค่าที่เป็นไปไม่ได้ ฯลฯ ซึ่งควรจะแสดงว่าไร้สาระ
ฉันไม่ต้องการกลับไปดูตัวอย่างเหล่านั้นหรือการอภิปรายเชิงปรัชญาของ Bayesian vs Frequentist
ฉันแค่กำลังมองหาตัวอย่างของสิ่งที่ตรงกันข้าม มีกรณีใดบ้างที่ความมั่นใจและช่วงเวลาที่เชื่อถือได้แตกต่างกันอย่างมีนัยสำคัญและช่วงเวลาที่กำหนดโดยขั้นตอนความเชื่อมั่นนั้นเหนือกว่าอย่างชัดเจนหรือไม่
ในการชี้แจง: นี่เป็นเรื่องเกี่ยวกับสถานการณ์ที่คาดว่าช่วงเวลาที่น่าเชื่อถือจะตรงกับช่วงความเชื่อมั่นที่สอดคล้องกันเช่นเมื่อใช้แบบแฟลตเครื่องแบบและนักบวช ฯลฯ ฉันไม่สนใจในกรณีที่มีคนเลือกที่ไม่ดีโดยพลการมาก่อน
แก้ไข: เพื่อตอบสนองต่อคำตอบของ @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)
- เพิ่มความน่าจะเป็น rnorm แบบง่ายด้วย 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 อีกมากมายเราสามารถเห็นความกว้างของ CrI ที่คาดหวังสำหรับโมเดล rnorm