Thông thường, khoảng tin cậy với độ bao phủ 95% rất giống với khoảng tin cậy chứa 95% mật độ sau. Điều này xảy ra khi ưu tiên là đồng phục hoặc gần đồng phục trong trường hợp sau. Do đó, khoảng tin cậy thường có thể được sử dụng để xấp xỉ khoảng tin cậy và ngược lại. Điều quan trọng, chúng ta có thể kết luận từ điều này rằng việc giải thích sai nhiều về khoảng tin cậy là khoảng tin cậy có ít hoặc không có tầm quan trọng thực tế đối với nhiều trường hợp sử dụng đơn giản.
Có một số ví dụ về các trường hợp điều này không xảy ra, tuy nhiên tất cả chúng dường như bị đánh cắp bởi những người đề xuất thống kê Bayes trong một nỗ lực để chứng minh rằng có một cái gì đó sai với cách tiếp cận thường xuyên. Trong các ví dụ này, chúng ta thấy khoảng tin cậy chứa các giá trị không thể, v.v ... được cho là cho thấy chúng vô nghĩa.
Tôi không muốn quay lại những ví dụ đó, hoặc một cuộc thảo luận triết học về Bayesian vs Người thường xuyên.
Tôi chỉ tìm kiếm ví dụ về điều ngược lại. Có trường hợp nào mà khoảng tin cậy và khoảng tin cậy khác nhau đáng kể và khoảng thời gian được cung cấp bởi quy trình tin cậy rõ ràng là vượt trội không?
Để làm rõ: Đây là về tình huống khi khoảng tin cậy thường được dự kiến trùng với khoảng tin cậy tương ứng, tức là khi sử dụng các linh mục phẳng, thống nhất, v.v. Tôi không quan tâm đến trường hợp ai đó chọn một người xấu tùy tiện trước đó.
EDIT: Đáp lại câu trả lời của @JaeHyeok Shin bên dưới, tôi phải không đồng ý rằng ví dụ của anh ấy sử dụng khả năng chính xác. Tôi đã sử dụng tính toán bayes gần đúng để ước tính phân phối sau chính xác cho theta bên dưới trong 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))
Đây là khoảng tin cậy 95%:
> as.numeric(hdi(chain[, 1], credMass = 0.95))
[1] -1.400304 1.527371
EDIT # 2:
Đây là bản cập nhật sau những bình luận của @JaeHyeok Shin. Tôi đang cố gắng giữ nó đơn giản nhất có thể nhưng kịch bản phức tạp hơn một chút. Những thay đổi chính:
- Bây giờ sử dụng dung sai 0,001 cho giá trị trung bình (nó là 1)
- Tăng số bước lên 500k để tính dung sai nhỏ hơn
- Giảm sd của phân phối đề xuất xuống 1 để tính dung sai nhỏ hơn (là 10)
- Đã thêm khả năng rnorm đơn giản với n = 2k để so sánh
- Đã thêm kích thước mẫu (n) làm thống kê tóm tắt, đặt dung sai thành 0,5 * n_target
Đây là mã:
### 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)
Kết quả, trong đó hdi1 là "khả năng" của tôi và hdi2 là rnorm đơn giản (n, theta, 1):
> 2*1.96/sqrt(2e3)
[1] 0.08765386
> diff(hdi1)
[1] 1.087125
> diff(hdi2)
[1] 0.07499163
Vì vậy, sau khi hạ đủ dung sai và với chi phí của nhiều bước MCMC hơn, chúng ta có thể thấy chiều rộng CrI dự kiến cho mô hình rnorm.
