Binom dağılımının


16

Bu soru bir teknik takip olan bu soruya .

Raftery (1988) 'deN- sunulan modeli anlamakta ve çoğaltmakta zorluk çekiyorum : Binom N parametresi için çıkarım: WinBUGS / OpenBUGS / JAGS'ta hiyerarşik Bayes yaklaşımı . Bu sadece kod ile ilgili değil, bu yüzden burada konu üzerinde olmalıdır.

Arka fon

Let x=(x1,...,xn) bilinmeyen bir binom dağılımından başarı sayar bir dizi olması N- ve θ . Ayrıca, N- parametre μ (kağıtta tartışıldığı gibi) bir Poisson dağılımını izlediğini varsayıyorum . Daha sonra her xben , ortalama ile bir Poisson dağılımına sahiptir λ=μθ. Öncelikleri λ ve cinsinden belirtmek istiyorum θ.

N- veya hakkında iyi bir ön bilgiye sahip olmadığımı varsayarsak, λ ve θθ için bilgilendirici olmayan öncelikler atamak istiyorum . Ki, zaman önceki değerler olan λ ~ G bir m m bir ( 0.001 , 0.001 ) ve θ ~ u , n ı f o r m ( 0 , 1 ) .λθλ~G,birmmbir(0.001,0.001)θ~UnbenfÖrm(0,1)

Yazar önce uygunsuz kullanıyor p(N-,θ)αN--1ancak WinBUGS uygun olmayan öncelikleri kabul etmiyor.

Misal

Makalede (sayfa 226), gözlemlenen su kuşlarının aşağıdaki başarı sayıları verilmiştir: 53,57,66,67,72 . N- , nüfusun büyüklüğünü tahmin etmek istiyorum .

WinBUGS ( @ Stéphane Laurent'in yorumundan sonra güncellenen) örneğinde nasıl çalışacağım :

model {

# Likelihood
  for (i in 1:N) {
    x[i] ~ dbin(theta, n)
  }

# Priors

n ~ dpois(mu)
lambda ~ dgamma(0.001, 0.001)
theta ~ dunif(0, 1)
mu <- lambda/theta

}

# Data

list(x = c(53, 57, 66, 67, 72), N = 5)

# Initial values

list(n = 100, lambda = 100, theta  = 0.5)
list(n = 1000, lambda = 1000, theta  = 0.8)
list(n = 5000, lambda = 10, theta  = 0.2)

Modeli yok eşik 20.000 örneklerinde yanık-in 500'000 numunelerden sonra güzel yakınsama değil. İşte bir JAGS çalışmasının çıktısı:

Inference for Bugs model at "jags_model_binomial.txt", fit using jags,
 5 chains, each with 5e+05 iterations (first 20000 discarded), n.thin = 5
 n.sims = 480000 iterations saved
         mu.vect  sd.vect   2.5%     25%     50%     75%    97.5%  Rhat  n.eff
lambda    63.081    5.222 53.135  59.609  62.938  66.385   73.856 1.001 480000
mu       542.917 1040.975 91.322 147.231 231.805 462.539 3484.324 1.018    300
n        542.906 1040.762 95.000 147.000 231.000 462.000 3484.000 1.018    300
theta      0.292    0.185  0.018   0.136   0.272   0.428    0.668 1.018    300
deviance  34.907    1.554 33.633  33.859  34.354  35.376   39.213 1.001  43000

Sorular

Açıkçası, bir şey eksik ama tam olarak ne olduğunu göremiyorum. Bence modelin formülasyonu bir yerde yanlış. Yani sorularım:

  • Modelim ve uygulaması neden çalışmıyor?
  • Raftery (1988) tarafından verilen model nasıl doğru şekilde formüle edilebilir ve uygulanabilir?

Yardımın için teşekkürler.


2
Kağıt ardından Eklemek gerekir mu=lambda/thetave değiştirme n ~ dpois(lambda)ilen ~ dpois(mu)
Stéphane Laurent

@ StéphaneLaurent Öneri için teşekkürler. Kodu buna göre değiştirdim. Ne yazık ki, model hala birbirine yaklaşmıyor.
COOLSerdash

1
örneklediğinizde ne olur ? N-<72
Sycorax, Reinstate Monica

1
Eğer modeliniz en az 72 waterbuck olduğunu varsayar çünkü, olabilirlik, sıfırdır. Bunun örnekleyici için sorunlara yol açıp açmadığını merak ediyorum. N-<72
Sycorax, Reinstate Monica'ya

3
Sorunun yakınsama olduğunu düşünmüyorum. Sorun numune kötü çünkü modelin birden çok düzeyde korelasyon yüksek derece performans olduğunu düşünüyorum R iken, düşük n e f f tekrarlamalar toplam sayısına göre düşüktür. Sadece posteriorun doğrudan, örneğin bir ızgara θ , N üzerinden hesaplanmasını öneririm . R,^neffθ,N-
Sycorax, Reinstate Monica'ya

Yanıtlar:


7

Kodunuzu çalýţtýrdýđýnýzdan beri, bu cevap biraz geç oldu. Ama kodu zaten yazdım, bu yüzden ...

Değeri için, bu aynı * model uygun rstan. Tüketici dizüstü bilgisayarımda 11 saniye içinde tahmin ediliyor ve daha az yineleme ile ilgilenilen parametrelerimiz için daha yüksek etkili bir örnek boyutu elde ediyor .(N-,θ)

raftery.model   <- "
    data{
        int     I;
        int     y[I];
    }
    parameters{
        real<lower=max(y)>  N;
        simplex[2]      theta;
    }
    transformed parameters{
    }
    model{
        vector[I]   Pr_y;

        for(i in 1:I){
            Pr_y[i] <-  binomial_coefficient_log(N, y[i])
                        +multiply_log(y[i],         theta[1])
                        +multiply_log((N-y[i]),     theta[2]);
        }
        increment_log_prob(sum(Pr_y));
        increment_log_prob(-log(N));            
    }
"
raft.data           <- list(y=c(53,57,66,67,72), I=5)
system.time(fit.test    <- stan(model_code=raftery.model, data=raft.data,iter=10))
system.time(fit     <- stan(fit=fit.test, data=raft.data,iter=10000,chains=5))

theta2-simpleks olarak kullandığımı unutmayın . Bu sadece sayısal kararlılık içindir. Faiz miktarı theta[1]; Açıkçası theta[2]gereksiz bilgi.

* Gördüğünüz gibi, posterior özet neredeyse aynıdır ve gerçek bir miktara yükseltmek , çıkarımlarımız üzerinde önemli bir etkiye sahip görünmemektedir.N-

için% 97.5'lik kantil, modelim için% 50 daha büyük, ancak bunun nedeni, stan'ın örnekleyicisinin, posteriorun tamamını keşfetmek için basit bir rastgele yürüyüşten daha iyi olması, bu yüzden kuyruklara daha kolay bir şekilde girebilmesinden daha iyi olduğunu düşünüyorum. Yine de yanılıyor olabilirim.N-

            mean se_mean       sd   2.5%    25%    50%    75%   97.5% n_eff Rhat
N        1078.75  256.72 15159.79  94.44 148.28 230.61 461.63 4575.49  3487    1
theta[1]    0.29    0.00     0.19   0.01   0.14   0.27   0.42    0.67  2519    1
theta[2]    0.71    0.00     0.19   0.33   0.58   0.73   0.86    0.99  2519    1
lp__      -19.88    0.02     1.11 -22.89 -20.31 -19.54 -19.09  -18.82  3339    1

Stan'den üretilen values ​​değerlerini alarak, bunları arka tahmin değerleri ˜ y çizmek için kullanıyorum . Arka tahminlerin ortalamasının ˜ y'nin örnek verilerin ortalamasına çok yakın olduğuna şaşırmamalıyız !N-,θy~y~

N.samples   <- round(extract(fit, "N")[[1]])
theta.samples   <- extract(fit, "theta")[[1]]
y_pred  <- rbinom(50000, size=N.samples, prob=theta.samples[,1])
mean(y_pred)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  32.00   58.00   63.00   63.04   68.00  102.00 

rstanN-y¯=θN-

bir ızgara üzerinde posterior

Aşağıdaki kod, standart sonuçlarımızın anlamlı olduğunu doğrulayabilir.

theta   <- seq(0+1e-10,1-1e-10, len=1e2)
N       <- round(seq(72, 5e5, len=1e5)); N[2]-N[1]
grid    <- expand.grid(N,theta)
y   <- c(53,57,66,67,72)
raftery.prob    <- function(x, z=y){
    N       <- x[1]
    theta   <- x[2]
    exp(sum(dbinom(z, size=N, prob=theta, log=T)))/N
}

post    <- matrix(apply(grid, 1, raftery.prob), nrow=length(N), ncol=length(theta),byrow=F)    
approx(y=N, x=cumsum(rowSums(post))/sum(rowSums(post)), xout=0.975)
$x
[1] 0.975

$y
[1] 3236.665

rstan(0,1)x{N-|N-ZN-72)}


+1 ve kabul edildi. Etkilendim! Stan'i bir karşılaştırma için kullanmaya çalıştım ama modeli aktaramadım. Modelimin tahmin edilmesi yaklaşık 2 dakika sürüyor.
COOLSerdash

Bu sorun için stan ile ilgili bir hıçkırık, tüm parametrelerin gerçek olması gerektiğinden, biraz rahatsızlık verir. Ancak, günlük olasılığını herhangi bir keyfi işlevle cezalandırabileceğiniz için, bunu programlamak için sorundan geçmeniz gerekir ... Ve bunu yapmak için oluşturulmuş işlevleri kazmak ...
Sycorax, Reinstate Monica

Evet! Bu benim sorunumdu. nbir tamsayı olarak ilan edilemez ve sorun için bir geçici çözüm bilmiyordum.
COOLSerdash

Masaüstümde yaklaşık 2 dakika.
COOLSerdash

1
@COOLSerdash [Bu] [1] sorusuyla ilgilenebilirsiniz, burada ızgara sonuçlarının veya rstansonuçlarının hangilerinin daha doğru olduğunu sordum . [1] stats.stackexchange.com/questions/114366/...
Sycorax eski haline Monica diyor

3

λ

İşte benim analiz komut dosyası ve JAGS ve R kullanarak sonuçları:

#===============================================================================================================
# Load packages
#===============================================================================================================

sapply(c("ggplot2"
         , "rjags"
         , "R2jags"
         , "hdrcde"
         , "runjags"
         , "mcmcplots"
         , "KernSmooth"), library, character.only = TRUE)

#===============================================================================================================
# Model file
#===============================================================================================================

cat("
    model {

    # Likelihood    
    for (i in 1:N) {
      x[i] ~ dbin(theta, n)
    }

    # Prior       
    n ~ dpois(mu)
    lambda ~ dgamma(0.005, 0.005)
#     lambda ~ dunif(0, 1000)
    mu <- lambda/theta
    theta ~ dunif(0, 1)    
}    
", file="jags_model_binomial.txt")


#===============================================================================================================
# Data
#===============================================================================================================

data.list <- list(x = c(53, 57, 66, 67, 72, NA), N = 6) # Waterbuck example from Raftery (1988)

#===============================================================================================================
# Inits
#===============================================================================================================

jags.inits <- function() { 
  list(
    n = sample(max(data.list$x, na.rm = TRUE):1000, size = 1) 
    , theta = runif(1, 0, 1)
    , lambda = runif(1, 1, 10)
#     , cauchy  = runif(1, 1, 1000)
    #     , mu = runif(1, 0, 5)
  )
}

#===============================================================================================================
# Run the chains
#===============================================================================================================

# Parameters to store

params <- c("n"
            , "theta"
            , "lambda"
            , "mu"
            , paste("x[", which(is.na(data.list[["x"]])), "]", sep = "")
)

# MCMC settings

niter <- 500000 # number of iterations
nburn <- 20000  # number of iterations to discard (the burn-in-period)
nchains <- 5    # number of chains

# Run JAGS

out <- jags(
  data                 = data.list
  , parameters.to.save = params
  , model.file         = "jags_model_binomial.txt"
  , n.chains           = nchains
  , n.iter             = niter
  , n.burnin           = nburn
  , n.thin             = 50
  , inits              = jags.inits
  , progress.bar       = "text")

Hesaplama masaüstü bilgisayarımda yaklaşık 98 saniye sürdü.

#===============================================================================================================
# Inspect results
#===============================================================================================================

print(out
      , digits = 2
      , intervals = c(0.025, 0.1, 0.25, 0.5, 0.75, 0.9,  0.975))

Sonuçlar:

Inference for Bugs model at "jags_model_binomial.txt", fit using jags,
 5 chains, each with 5e+05 iterations (first 20000 discarded), n.thin = 50
 n.sims = 48000 iterations saved
         mu.vect sd.vect  2.5%    10%    25%    50%    75%     90%   97.5% Rhat n.eff
lambda     62.90    5.18 53.09  56.47  59.45  62.74  66.19   69.49   73.49    1 48000
mu        521.28  968.41 92.31 113.02 148.00 232.87 467.10 1058.17 3014.82    1  1600
n         521.73  968.54 95.00 114.00 148.00 233.00 467.00 1060.10 3028.00    1  1600
theta       0.29    0.18  0.02   0.06   0.13   0.27   0.42    0.55    0.66    1  1600
x[6]       63.03    7.33 49.00  54.00  58.00  63.00  68.00   72.00   78.00    1 36000
deviance   34.88    1.53 33.63  33.70  33.85  34.34  35.34   36.81   39.07    1 48000

N-522233N-

jagsfit.mcmc <- as.mcmc(out)
jagsfit.mcmc <- combine.mcmc(jagsfit.mcmc)

hpd.80 <- hdr.den(log(as.vector(jagsfit.mcmc[, "n"])), prob = c(80), den = bkde(log(as.vector(jagsfit.mcmc[, "n"])), gridsize = 10000))

exp(hpd.80$mode)

[1] 149.8161

N-

(hpd.ints <- HPDinterval(jagsfit.mcmc, prob = c(0.8)))

               lower      upper
deviance 33.61011007  35.677810
lambda   56.08842502  69.089507
mu       72.42307587 580.027182
n        78.00000000 578.000000
theta     0.01026193   0.465714
x[6]     53.00000000  71.000000

N-150(78;578)(80;598)

Sitemizi kullandığınızda şunları okuyup anladığınızı kabul etmiş olursunuz: Çerez Politikası ve Gizlilik Politikası.
Licensed under cc by-sa 3.0 with attribution required.