Часто бывает так, что доверительный интервал с охватом 95% очень похож на вероятный интервал, который содержит 95% апостериорной плотности. Это происходит, когда предшествующий является однородным или почти однородным в последнем случае. Таким образом, доверительный интервал часто можно использовать для аппроксимации вероятного интервала и наоборот. Важно отметить, что из этого можно сделать вывод, что очень ошибочное неверное истолкование доверительного интервала как вероятного интервала практически не имеет практического значения для многих простых случаев использования.
Существует целый ряд примеров, когда этого не происходит, однако, похоже, что все они, похоже, подобраны сторонниками байесовской статистики в попытке доказать, что что-то не так с частым подходом. В этих примерах мы видим, что доверительный интервал содержит невозможные значения и т. Д., Что должно показывать, что они бессмысленны.
Я не хочу возвращаться к тем примерам или философскому обсуждению Байесовского против Фрикалистов.
Я просто ищу примеры обратного. Существуют ли случаи, когда доверительные и достоверные интервалы существенно различаются, а интервал, обеспечиваемый процедурой достоверности, явно превосходит?
Для пояснения: речь идет о ситуации, когда вероятный интервал обычно должен совпадать с соответствующим доверительным интервалом, то есть при использовании плоских, равномерных и т. Д. Априорных значений. Меня не интересует случай, когда кто-то выбирает произвольно плохой приор.
РЕДАКТИРОВАТЬ: В ответ на ответ @JaeHyeok Шин ниже, я должен не согласиться, что его пример использует правильную вероятность. Я использовал приблизительное байесовское вычисление для оценки правильного апостериорного распределения для тета, приведенного ниже в 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)
- Увеличено количество шагов до 500 КБ, чтобы учесть меньший допуск
- Уменьшил 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 - простая норма (n, theta, 1):
> 2*1.96/sqrt(2e3)
[1] 0.08765386
> diff(hdi1)
[1] 1.087125
> diff(hdi2)
[1] 0.07499163
Таким образом, после достаточного снижения допуска и за счет многих других шагов MCMC, мы можем увидеть ожидаемую ширину CrI для модели rnorm.
