二項分布の

この質問は、技術的なフォローアップでこの質問。

Raftery（1988）で $N$ 提示されたモデルの理解と複製に問題があります：二項 パラメーターの推論： WinBUGS / OpenBUGS / JAGSの階層ベイズアプローチ。ただし、コードだけではないので、ここでトピックを取り上げる必要があります。

バックグラウンド

ましょうの未知との二項分布から、成功回数の集合と。さらに、はパラメーターポアソン分布に従うと仮定します（論文で説明）。その後、各平均のポアソン分布持っ。と観点から事前確率を指定したい。 $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éphaneLaurentのコメントの後に更新）の例を解決しようとした方法は次のとおりです。

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バーンインサンプルで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 14

をサンプリングするとどうなりますか？

N < 72

$N<72$

— Sycoraxが復活モニカ言う

場合、モデルは少なくとも72のウォーターバックがあると仮定しているため、尤度はゼロです。それがサンプラーに問題を引き起こしているのではないかと思っています。

N < 72

$N<72$

— Sycoraxが復活モニカ言う

問題は収束だとは思いません。私はこの問題は、サンプラが乏しいため、モデルの複数のレベルでの相関度が高いの実行していることだと思う

低く、一方、

反復の総数に対して低いあります。たとえば、グリッド

事後を直接計算することをお勧めします。

\hat{R}

$\hat{R}$

n_{e f f}

$n_{eff}$

θ, N

$\theta, N$

— Sycoraxが復活モニカ言う

回答:

さて、コードが機能するようになったので、この答えは少し遅すぎるようです。しかし、私はすでにコードを書いているので...

価値のあることは、これはに適合する*モデルrstanです。消費者のラップトップでは11秒で推定され、対象のパラメーター有効サンプルサイズをより少ない反復で達成します。 $(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$ を実際の量にしても、推論に実質的な影響はないようです。

$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\}$

— シコラックス、モニカを復職させる
ソース

+1および承認済み。私が感銘を受けた！また、比較のためにスタンを使用しようとしましたが、モデルを転送できませんでした。私のモデルの推定には約2分かかります。

— COOLSerdash 14

この問題の原因の1つは、すべてのパラメーターが実数でなければならないことです。そのため、少し不便です。あなたが任意の関数で対数尤度を罰することができますので、しかし、あなたはそれをプログラムする手間を通過...そして、そうするように構成機能を掘るために持っている...

— Sycoraxは回復モニカ言う

はい！それがまさに私の問題でした。n整数として宣言できず、問題の回避策を知りませんでした。

— COOLSerdash 14

デスクトップで約2分。

— COOLSerdash 14

@COOLSerdash [this] [1]の質問に興味があるかもしれません。ここでは、どのグリッド結果またはrstan結果がより正しいかを尋ねます。[1] stats.stackexchange.com/questions/114366/...

— Sycoraxが復活モニカ言う

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

— クール
ソース