Як знайти 95% надійний інтервал?

Я намагаюся обчислити 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")

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

Перше, що слід врахувати, - що саме ви хочете узагальнити, використовуючи свої інтервали. Наприклад, вас можуть зацікавити інтервали, отримані за допомогою квантових елементів, але ви також можете бути зацікавлені у регіоні найвищої щільності (див. Тут чи тут ) вашого розповсюдження. Незважаючи на те, що це не має великої різниці у простих випадках, таких як симетричні, одномодальні розподіли, це змінить більш складні розподіли. Як правило, квантили дають вам інтервал, що містить масу ймовірності, сконцентровану навколо медіани (середня вашого розподілу), а область найвищої щільності - область навколо мод$100\alpha\%$розподілу. Це буде зрозуміліше, якщо порівняти дві ділянки на малюнку нижче - квантили «вирізають» розподіл вертикально, тоді як область найвищої щільності «ріже» його по горизонталі.

Наступне, що слід врахувати - як боротися з тим, що у вас є неповна інформація про розподіл (якщо припустити, що ми говоримо про безперервний розподіл, у вас є лише купа очок, а не функція). Що ви можете зробити з цього приводу, це взяти значення "як є", або використовувати якусь інтерполяцію або згладжування, щоб отримати значення "між".

Одним із підходів було б використання лінійної інтерполяції (див. ?approxfunR), або ж щось більш гладке, як сплайни (див. ?splinefunR). Якщо ви обираєте такий підхід, ви повинні пам’ятати, що алгоритми інтерполяції не мають доменних знань про ваші дані і можуть повертати недійсні результати, такі як значення нижче нуля тощо.

# 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]

2а) Знайдіть кванти чисельно

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\alpha\%$$\Pr(X \in \mu \pm \zeta) \ge \alpha$$\zeta$