การประมาณแบบเบย์ของ

คำถามนี้เป็นการติดตามด้านเทคนิคของคำถามนี้

ฉันมีปัญหาในการทำความเข้าใจและจำลองแบบจำลองที่แสดงในRaftery (1988): การอนุมานสำหรับพารามิเตอร์binomial : แนวทาง Bayes แบบลำดับชั้น$N$ใน WinBUGS / OpenBUGS / JAGS มันไม่เพียงเกี่ยวกับรหัสเท่านั้นดังนั้นควรอยู่ในหัวข้อที่นี่

พื้นหลัง

ให้เป็นชุดของการนับความสำเร็จจากการกระจายทวินามด้วยไม่รู้จักNและθ นอกจากนี้ฉันคิดว่าNตามการกระจายของปัวซองด้วยพารามิเตอร์μ (ดังที่กล่าวไว้ในบทความ) จากนั้นแต่ละx ฉันมีการกระจาย Poisson ที่มีค่าเฉลี่ยλ = μ θ ฉันต้องการที่จะระบุไพรเออร์ในแง่ของλและθ$x=(x_{1},\ldots,x_{n})$$N$$\theta$$N$$\mu$$x_{i}$$\lambda = \mu \theta$$\lambda$$\theta$

สมมติว่าผมไม่ได้มีความรู้ใด ๆ ก่อนที่ดีเกี่ยวกับหรือθผมต้องการที่จะกำหนดไพรเออร์ที่ไม่แสดงข้อมูลทั้งλและθ พูด, ไพรเออร์ของฉันλ ~ G เมตรเมตร ( 0.001 , 0.001 )และθ ~ U n ฉันฉo R เมตร ( 0 , 1 )$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) นับประสบความสำเร็จต่อไปนี้ waterbucks สังเกตให้: 72 ฉันต้องการประมาณN , ขนาดของประชากร$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)

รูปแบบที่ไม่งัวได้มาบรรจบกันเป็นอย่างดีหลังจาก 500'000 ตัวอย่างกับ 20'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) จะกำหนดและดำเนินการอย่างถูกต้องได้อย่างไร?

ขอบคุณสำหรับความช่วยเหลือของคุณ.

เมื่อคุณได้รหัสของคุณมาทำงานดูเหมือนว่าคำตอบนี้จะสายเกินไป แต่ฉันได้เขียนรหัสแล้วดังนั้น ...

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

โปรดทราบว่าฉันหล่อthetaเป็น 2-simplex นี่เป็นเพียงความเสถียรเชิงตัวเลข ปริมาณที่น่าสนใจคือtheta[1]; เห็นได้ชัดว่าtheta[2]เป็นข้อมูลที่ไม่จำเป็น

$N$

$N$นั้นใหญ่กว่า 50% สำหรับแบบจำลองของฉัน แต่ฉันคิดว่านั่นเป็นเพราะตัวอย่างของสแตนดีกว่าในการสำรวจเต็มรูปแบบด้านหลังกว่าการเดินแบบสุ่มง่าย ๆ ดังนั้นมันจึงสามารถทำให้มันเป็นหาง ฉันอาจจะผิด

            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ตัวอย่างเป็นปัญหาหรือไม่ฉันคำนวณหลังส่วนตาราง เราจะเห็นได้ว่าด้านหลังเป็นรูปกล้วย หลังชนิดนี้อาจเป็นปัญหาสำหรับ euclidian metric HMC แต่ลองตรวจสอบผลลัพธ์ที่เป็นตัวเลข (ความรุนแรงของรูปร่างกล้วยถูกระงับจริง ๆ ตั้งแต่ที่นี่$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

ฮึ่ม นี่ไม่ใช่สิ่งที่ฉันคาดหวัง การประเมินผลกริดสำหรับควอนไทล์ 97.5% นั้นใกล้เคียงกับผลลัพธ์ของ JAGS มากกว่าrstanผลลัพธ์ ในเวลาเดียวกันฉันไม่เชื่อว่าผลลัพธ์ของตารางควรนำมาเป็นข่าวประเสริฐเนื่องจากการประเมินผลของกริดทำให้มีความเรียบง่ายค่อนข้างหยาบหลายประการ: การแก้ปัญหากริดไม่ดีเกินไปในมือข้างหนึ่ง ) ยืนยันว่าความน่าจะเป็นทั้งหมดในกริดต้องเป็น 1 เนื่องจากเราต้องวาดขอบเขต (และจุดกริด จำกัด ) เพื่อให้ปัญหาสามารถคำนวณได้ (ฉันยังคงรอ RAM อนันต์) อันที่จริงแบบจำลองของเรามีความเป็นไปได้ในเชิงบวกมากกว่า$(0,1)\times\left\{N|N\in\mathbb{Z}\land N\ge72)\right\}$. แต่บางทีสิ่งที่ลึกซึ้งยิ่งกว่าก็คือเล่นที่นี่

ขอขอบคุณอีกครั้งที่ @ StéphaneLaurentและ @ user777 สำหรับข้อมูลที่มีค่าของพวกเขาในความคิดเห็น หลังจาก tweaking ของก่อนสำหรับบาง$\lambda$ ตอนนี้ฉันสามารถทำซ้ำผลลัพธ์จากกระดาษของ Raftery (1988)

นี่คือสคริปต์การวิเคราะห์และผลลัพธ์ของฉันโดยใช้ 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")

การคำนวณใช้เวลาประมาณ 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

และ 80% -HPD ของ $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$ และ 80% -HPD คือ $(78; 578)$ which is very close to the limits given in the paper which are $(80; 598)$.