Как найти 95% вероятный интервал?

13

Я пытаюсь вычислить 95% вероятный интервал следующего апостериорного распределения. Я не смог найти функцию в R для нее, но правильный ли подход ниже?

x <- seq(0.4,12,0.4)
px <-  c(0,0, 0, 0, 0, 0, 0.0002, 0.0037, 0.018, 0.06, 0.22 ,0.43, 0.64,0.7579, 0.7870, 0.72, 0.555, 0.37, 0.24, 0.11, 0.07, 0.02, 0.009, 0.005, 0.0001, 0,0.0002, 0, 0, 0)
plot(x,px, type="l")
mm <- sum(x*px)/sum(px)
var <- (sum((x)^2*px)/sum(px)) - (mm^2)
cat("95% credible interval: ", round(mm -1.96*sqrt(var),3), "-", round(mm + 1.96*sqrt(var),3),"\n")
user19758
источник
1
Не совсем - вы предполагали нормальное распределение и равный интервал относительно среднего значения, ни один из которых не является особенно оправданным в этом контексте. На самом деле вы собрали около вероятности, предполагая, что это дискретное распределение, и вам нужно немного расширить интервал, чтобы получить . Лучше взять область с наивысшей плотностью, которая равна если это дискретное распределение. В качестве альтернативы возьмите интервал, чтобы вероятность быть ниже или меньше, а вероятность быть выше или ниже, также здесь. 95 % [ 4.4 , 8.0 ] 2.5 % 2.5 % [ 4.4 , 8.0 ]94%95%[4.4,8.0]2.5%2.5%[4.4,8.0]
Генри

Ответы:

24

Как отметил Генри , вы предполагаете нормальное распределение, и это совершенно нормально, если ваши данные соответствуют нормальному распределению, но будут неправильными, если вы не можете принять нормальное распределение для них. Ниже я опишу два разных подхода, которые вы могли бы использовать для неизвестного распределения, учитывая только точки данных xи сопутствующие оценки плотности px.

Первое, что нужно учитывать, это то, что именно вы хотите обобщить, используя ваши интервалы. Например, вас могут интересовать интервалы, полученные с использованием квантилей, но вас также может интересовать область с наивысшей плотностью (см. Здесь или здесь ) вашего распределения. Хотя в простых случаях, таких как симметричные унимодальные распределения, это не должно иметь большого значения (если таковое имеется), это будет иметь значение для более «сложных» распределений. Как правило, квантили дают интервал, содержащий вероятностную массу, сконцентрированную вокруг медианы (середина от вашего распределения), в то время как область с наивысшей плотностью является областью вокруг мод100α%распределения. Это будет более понятным, если вы сравните два графика на рисунке ниже - квантили «обрезают» распределение по вертикали, в то время как область с самой высокой плотностью «обрезает» его по горизонтали.

Квантили против HDR интервалов

Следующее, что нужно рассмотреть, - это как справиться с тем фактом, что у вас есть неполная информация о распределении (при условии, что мы говорим о непрерывном распределении, у вас есть только куча точек, а не функция). Что вы можете сделать с этим, так это взять значения «как есть» или использовать некоторую интерполяцию или сглаживание для получения «промежуточных» значений.

Один из подходов состоит в том, чтобы использовать линейную интерполяцию (см. ?approxfunВ R) или, альтернативно, что-то более гладкое, как сплайны (см. ?splinefunВ R). Если вы выбираете такой подход, вы должны помнить, что алгоритмы интерполяции не знают предметной области ваших данных и могут возвращать неверные результаты, такие как значения ниже нуля и т. Д.

# grid of points
xx <- seq(min(x), max(x), by = 0.001)

# interpolate function from the sample
fx <- splinefun(x, px) # interpolating function
pxx <- pmax(0, fx(xx)) # normalize so prob >0

Второй подход, который вы могли бы рассмотреть, - это использовать плотность ядра / распределение смеси, чтобы приблизить ваше распределение, используя имеющиеся у вас данные. Здесь самое сложное - выбрать оптимальную полосу пропускания.

# density of kernel density/mixture distribution
dmix <- function(x, m, s, w) {
  k <- length(m)
  rowSums(vapply(1:k, function(j) w[j]*dnorm(x, m[j], s[j]), numeric(length(x))))
}

# approximate function using kernel density/mixture distribution
pxx <- dmix(xx, x, rep(0.4, length.out = length(x)), px) # bandwidth 0.4 chosen arbitrary

Далее вы найдете интересующие вас интервалы. Вы можете продолжить численно или путем моделирования.

1a) Выборка для получения квантильных интервалов

# sample from the "empirical" distribution
samp <- sample(xx, 1e5, replace = TRUE, prob = pxx)

# or sample from kernel density
idx <- sample.int(length(x), 1e5, replace = TRUE, prob = px)
samp <- rnorm(1e5, x[idx], 0.4) # this is arbitrary sd

# and take sample quantiles
quantile(samp, c(0.05, 0.975)) 

1b) Отбор проб для получения области наибольшей плотности

samp <- sample(pxx, 1e5, replace = TRUE, prob = pxx) # sample probabilities
crit <- quantile(samp, 0.05) # boundary for the lower 5% of probability mass

# values from the 95% highest density region
xx[pxx >= crit]

2a) Найти квантили численно

cpxx <- cumsum(pxx) / sum(pxx)
xx[which(cpxx >= 0.025)[1]]   # lower boundary
xx[which(cpxx >= 0.975)[1]-1] # upper boundary

2b) Найти область наибольшей плотности численно

const <- sum(pxx)
spxx <- sort(pxx, decreasing = TRUE) / const
crit <- spxx[which(cumsum(spxx) >= 0.95)[1]] * const

Как вы можете видеть на графиках ниже, в случае унимодального, симметричного распределения оба метода возвращают один и тот же интервал.

Два вида интервалов

Конечно, вы также можете попытаться найти интервал вокруг некоторого центрального значения, такого как и использовать некоторую оптимизацию для поиска подходящего , но два описанных выше подхода, кажется, используются чаще и являются более интуитивными.100α%Pr(Xμ±ζ)αζ

Тим
источник
Почему вы делаете выборку, когда вы можете просто вычислить квантили непосредственно из предоставленной информации (используя любой метод)?
whuber
1
@whuber, потому что это дешево и просто, но я отредактирую, чтобы описать расчет без симуляции завтра.
Тим
Привет Тим, это очень полезно. Разве не правильно было бы просто взять квантиль из распределения. (ниже <- x [который (as.logical (diff (cumsum (px) / sum (px)> 0.025)))]) (верхний <- x [which (as.logical (diff (cumsum (px) / sum) (px) <0,975)))])
user19758
@ user19758 пожалуйста, проверьте мои изменения.
Тим
+1 Дополнительные пояснения, иллюстрации и код устанавливают высокий стандарт для ответов на этом сайте. Спасибо!
whuber