% 95 güvenilir aralık nasıl bulunur?

Aşağıdaki posterior dağılımın% 95 güvenilir aralığını hesaplamaya çalışıyorum. R için işlevi bulamadım ama aşağıdaki yaklaşım doğru mu?

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")

Henry tarafından belirtildiği gibi , normal dağılım olduğunu varsayıyorsunuz ve verileriniz normal dağılımı izliyorsa mükemmel bir sorun var, ancak normal dağılımını kabul edemiyorsanız yanlış olacaktır. Aşağıda sadece veri noktaları ve bunlara eşlik eden yoğunluk tahminleri verildiğinde bilinmeyen dağılım için kullanabileceğiniz iki farklı yaklaşımı açıklayacağım .xpx

$100\alpha\%$dağıtım. Aşağıdaki resimdeki iki grafiği karşılaştırırsanız bu daha açık olacaktır - en yüksek yoğunluk bölgesi yatay olarak "keserken", miktarlar dağılımı dikey olarak "keser".

Dikkate alınacak bir sonraki şey, dağıtım hakkında eksik bilgiye sahip olmanızla nasıl başa çıkılacağıdır (sürekli dağıtımdan bahsettiğimizi varsayarsak, bir işlevden ziyade sadece bir noktaya sahipsiniz). Bu konuda yapabileceğiniz şey, değerleri "olduğu gibi" almak veya "arada" değerlerini elde etmek için bir tür enterpolasyon veya yumuşatma kullanmaktır.

Bir yaklaşım doğrusal enterpolasyon (bakınız ?approxfunR) veya alternatif olarak spline ( ?splinefunR'de bakınız ) gibi daha pürüzsüz bir şey kullanmak olacaktır . Böyle bir yaklaşımı seçerseniz, enterpolasyon algoritmalarının verileriniz hakkında etki alanı bilgisine sahip olmadığını ve sıfırın altındaki değerler gibi geçersiz sonuçlar döndürebileceğini hatırlamanız gerekir.

# 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

Düşünebileceğiniz ikinci yaklaşım, sahip olduğunuz verileri kullanarak dağılımınıza yaklaşmak için çekirdek yoğunluğu / karışım dağılımını kullanmaktır. Buradaki zor kısım, optimum bant genişliği hakkında karar vermektir.

# 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

Daha sonra, ilgi aralıklarını bulacaksınız. Sayısal olarak veya simülasyonla devam edebilirsiniz.

1a) Kantil aralıklar elde etmek için örnekleme

# 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) En yüksek yoğunluklu bölgeyi elde etmek için örnekleme

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) Miktarları sayısal olarak bulun

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

2b) Sayısal olarak en yüksek yoğunluk bölgesini bulun

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

Aşağıdaki grafiklerde görebileceğiniz gibi, tek modlu, simetrik dağılım durumunda, her iki yöntem de aynı aralığı döndürür.

$100\alpha\%$$\Pr(X \in \mu \pm \zeta) \ge \alpha$$\zeta$