이항 분포 의

이 질문의 기술 후속 인 이 질문에 .

Raftery (1988) : 이항 매개 변수에 대한 추론 : $N$ WinBUGS / OpenBUGS / JAGS 의 계층 적 Bayes 접근 방식 에 제시된 모델을 이해하고 복제하는 데 어려움이 있습니다. 그것은 코드에 관한 것이 아니라 여기서 주제에 관한 것이어야합니다.

배경

하자 알 수있는 이항 분포에서 성공 카운트의 집합이 될 과 . 또한, 은 논문에서 논의 된 바와 같이 파라미터 갖는 포아송 분포를 따른 다고 가정합니다 . 그런 다음 각 는 평균 포아송 분포를 갖습니다 . 및 우선 순위를 지정하고 싶습니다 . $x=(x_{1},\ldots,x_{n})$ $N$ $\theta$ $N$ $\mu$ $x_{i}$ $\lambda = \mu \theta$ $\lambda$ $\theta$

또는 에 대한 사전 지식이 충분하지 않다고 가정하면 및 정보가없는 사전을 할당하려고합니다 . 내 선행은 및 입니다. $N$ $\theta$ $\lambda$ $\theta$ $\lambda\sim \mathrm{Gamma}(0.001, 0.001)$ $\theta\sim \mathrm{Uniform}(0, 1)$

저자는 이전에 부적절한 것을 사용 하지만 WinBUGS는 부적절한 선행을 받아들이지 않습니다. $p(N,\theta)\propto N^{-1}$

예

이 논문 (226 페이지)에는 다음과 같은 성공한 관찰 된 물 벅이 제공됩니다 : . 모집단의 크기 인 을 추정하고 싶습니다 . $53, 57, 66, 67, 72$ $N$

다음은 WinBUGS ( @ Stéphane Laurent의 의견에 따라 업데이트 됨) 에서 예제를 해결하는 방법입니다 .

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)

이 모델은 않습니다 문턱 20'000 샘플 번인 (burn-in)으로 500'000 샘플 후 잘 수렴하지. 다음은 JAGS 실행 결과입니다.

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

질문

분명히, 나는 무언가를 놓치고 있지만 정확히 무엇을 볼 수 없습니다. 모델의 내 공식이 어딘가에 잘못되었다고 생각합니다. 그래서 내 질문은 :

모델과 구현이 작동하지 않는 이유는 무엇입니까?
Raftery (1988)가 제시 한 모델을 어떻게 정확하게 구성하고 구현할 수 있습니까?

당신의 도움을 주셔서 감사합니다.

— 시원한
소스

종이에 따라 당신은 추가해야합니다 mu=lambda/theta및 교체 n ~ dpois(lambda)와 함께n ~ dpois(mu)

— 스테판 로랑

@ StéphaneLaurent 제안 해 주셔서 감사합니다. 이에 따라 코드를 변경했습니다. 슬프게도 모델은 여전히 수렴하지 않습니다.

— COOLSerdash

N < 72

$N<72$

N < 72

$N<72$

\hat{R}

$\hat{R}$

n_{e f f}

$n_{eff}$

θ, N

$\theta, N$

답변:

글쎄, 당신은 코드가 작동하기 때문에이 답변이 너무 늦게 보입니다. 하지만 이미 코드를 작성 했으므로 ...

rstan $(N, \theta)$

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 심플 렉스로 캐스트 합니다. 이것은 수치 적 안정성을위한 것입니다. 관심 수량은 다음과 같습니다 theta[1]. 분명히 theta[2]불필요한 정보입니다.

$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

$N, \theta$ $\tilde{y}$ $\tilde{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

rstan $N$ $\bar{y}=\theta N$

그리드 뒤

아래 코드는 스탠의 결과가 의미가 있음을 확인할 수 있습니다.

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)\times\left\{N|N\in\mathbb{Z}\land N\ge72)\right\}$

— Sycorax는 Reinstate Monica를 말합니다
소스

+1하고 수락했습니다. 나는 감동! 나는 또한 비교를 위해 Stan을 사용하려고 시도했지만 모델을 전송할 수 없었습니다. 내 모델을 추정하는 데 약 2 분이 걸립니다.

— COOLSerdash

이 문제에 대한 stan의 한 가지 단점은 모든 매개 변수가 실제이어야하므로 조금 불편하다는 것입니다. 그러나 임의의 함수에 의해 로그 우도를 불이익을 줄 수 있기 때문에, 프로그램을 작성하는 데 어려움을 겪어야합니다. 그리고 작성된 함수를 파헤쳐 야합니다.

— Sycorax는 Reinstate Monica라고 말합니다

예! 바로 내 문제였습니다. n정수로 선언 할 수 없으며 문제에 대한 해결 방법을 몰랐습니다.

— COOLSerdash

내 데스크탑에서 약 2 분.

— COOLSerdash

@COOLSerdash [this] [1] 질문에 관심이있을 수 있습니다. 여기서 어떤 그리드 결과 또는 rstan결과가 더 정확한지 묻습니다 . [1] stats.stackexchange.com/questions/114366/…

— Sycorax는 Monica Reinstate Monica가

$\lambda$

다음은 JAGS 및 R을 사용한 분석 스크립트 및 결과입니다.

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

데스크탑 PC에서 계산에 약 98 초가 걸렸습니다.

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

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

결과는 다음과 같습니다.

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$ $522$ $233$ $N$

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

— 시원한
소스