Winbugs JAGS-即使使用伪先验，层次模型比较也不会在模型之间跳跃

我正在使用所描述的分层建模框架在JAGS中对两个模型进行比较。该框架中的思想是通过将每个版本指定为一个类别变量的一个级别来运行和比较模型的多个版本。这个分类变量的后验分布可以解释为各种模型的相对概率

在下面的代码中，我比较了两个模型。这些模型在形式上是相同的。每个都有一个需要估计的参数，

mE

。可以看出，这些模型的优先级不同。这两个先验分布都是beta分布，其模式为0.5。然而，模型2的先验分布更为集中。还要注意的是，我使用了伪先验，我希望它能防止链条卡在其中一个模型上。但无论如何，这一模式似乎陷入了困境

模型如下：

 model {

  m ~ dcat( mPriorProb[] )
  mPriorProb[1] <- .5
  mPriorProb[2] <- .5

  omegaM1[1] <- 0.5      #true prior
  omegaM1[2] <- 0.5      #psuedo prior 
  kappaM1[1] <- 3        #true prior for Model 1
  kappaM1[2] <- 5        #puedo prior for Model 1

  omegaM2[1] <- 0.5      #psuedo prior
  omegaM2[2] <- 0.5      #true prior
  kappaM2[1] <- 5        #puedo  prior for Model 2
  kappaM2[2] <- 10        #true prior for Model 2

  for ( s in 1:Nsubj ) {

    mE1[s] ~ dbeta(omegaM1[m]*(kappaM1[m]-2)+1 , (1-omegaM1[m])*(kappaM1[m]-2)+1 )
    mE2[s] ~ dbeta(omegaM2[m]*(kappaM2[m]-2)+1 , (1-omegaM2[m])*(kappaM2[m]-2)+1 )

    mE[s] <- equals(m,1)*mE1[s] + equals(m,2)*mE2[s]

    z[s] ~ dbin( mE[s] , N[s] )

  }
}

当我运行这个模型时，MCMC将每一次迭代花费在

m=1

，而从不跳到

m=2

。我已经尝试了很多不同的先验和伪先验组合，并且似乎找不到MCMC会考虑<代码> M＝2 < /代码>的组合。我甚至尝试为模型1和模型2指定相同的先验和伪先验，但这没有帮助。在这种情况下，我预计MCMC会在模型之间相当频繁地跳跃，大约一半的时间用于考虑一种模型，一半的时间用于考虑另一种模型。然而，JAGS仍然将整个时间花在

m=1

上。我已经运行了6000次迭代，对于这样一个简单的模型来说，这应该足够长了

如果有人对如何解决这个问题有任何想法，我将不胜感激

干杯，

---

Tim

我还没有弄明白这一点，但我想其他任何从事这项工作的人都可能会喜欢下面的代码，它将用RJAG从头到尾重现问题（必须安装JAGS）

请注意，由于本例中只有两个相互竞争的模型，因此我将

m~dcat（）

更改为

m~dbern（）

，然后在代码中的其他任何地方将

m

替换为

m+1

。我希望这能改善这种行为，但事实并非如此。还要注意的是，如果我们为m指定初始值，无论我们选择哪个值，它都会停留在该值上，因此m无法正确更新（而不是奇怪地被一个模型或另一个模型吸引）。对我来说，这是一件令人头痛的事；可能值得在

库（rjags）
load.module（'glm'））
数据列表=列表(
z=c（81,59,36,18,28,59,63,57,42,28,47,55,38，
30, 22, 32, 31, 30, 32, 33, 32, 26, 13, 33, 30), 
N=代表（96,25），
Nsubj=25
)
接收器（“mymodel.txt”）
猫（“模型{
m~dbern（.5）
omegaM1[1]诀窍不是为模型分配一个固定的概率，而是基于一个统一的先验估计它（
phi
），然后你需要
phi
的后验分布，因为它告诉你选择模型2的概率（即，“成功”意味着m=1；Pr（模型1）=1-phi）

sink（“mymodel.txt”）
猫（“模型{
m~dbern（φ）
phi~dunif（0,1）
omegaM1[1]见我对Mark S答案的评论

这个答案是通过例子来说明为什么我们想要对m而不是对phi进行推理

假设我们有一个由

data <- c(-1, 0, 1, .5, .1)

m~dbern(phi)
data[i] ~ m*dnorm(0, 1) + (1-m)*dnorm(100, 1)

数据您应该假设我们不熟悉Kruschke的确切示例，因此最好参考一个简化示例和必要的数据来问这个问题，以便我们在结束时对其进行测试。感谢您的回答和建议。我现在编辑了这个问题，希望它更清晰。可能还值得链接到谷歌图书中的页面…看起来就是这样。我认为你需要将
m
移动到循环中，并用
s
为你所有的
m
s下标，例如m[I]~
m[s]~dcat（mPriorProb[]）；mE1[s]~dbeta（omegaM1[m[s]*（kappaM1[m]-2）+1，（1-omegaM1[m]]*（kappaM1[s]-2）+）；etc
。这将允许两个模型的后验概率因受试者而异（这似乎是您通过订阅
mE1/2
by
s
尝试的）。或者，将
theta1
、
theta2
和
theta
移出循环，并从这些行中删除
（估计每个模型的单一概率，对所有受试者通用）。如果我不清楚，很抱歉。我希望为所有受试者估算一个“m”-因此我正在为每个模型寻找一个单一的概率。但是，我希望参数“mE”随受试者而变化。你的两个建议我都有，但我认为两者都不能捕获我想要的结构。移动“m”会使该参数随受试者而变化。不是吗将mE1.mE2和mE从循环中排除，将“mE”参数固定为在受试者之间相等。有趣的是，这会运行，而在m上指定bernoulli优先级则不会。但是，请注意，在本例中，我们不寻求对phi的推断——我们仍然寻求对m的推断。请参见下面我的新答案。
library(rjags)
load.module('glm')

dataList = list(
  z = c(81, 59, 36, 18, 28, 59, 63, 57, 42, 28, 47, 55, 38, 
        30, 22, 32, 31, 30, 32, 33, 32, 26, 13, 33, 30), 
  N = rep(96, 25),
  Nsubj = 25
)

sink("mymodel.txt")
cat("model {

  m ~ dbern(.5)

  omegaM1[1] <- 0.5      #true prior
  omegaM1[2] <- 0.5      #psuedo prior 
  kappaM1[1] <- 3        #true prior for Model 1
  kappaM1[2] <- 5        #puedo prior for Model 1

  omegaM2[1] <- 0.5      #psuedo prior
  omegaM2[2] <- 0.5      #true prior
  kappaM2[1] <- 5        #puedo  prior for Model 2
  kappaM2[2] <- 10        #true prior for Model 2

    for ( s in 1:Nsubj ) {

    mE1[s] ~ dbeta(omegaM1[m+1]*(kappaM1[m+1]-2)+1 , (1-omegaM1[m+1])*(kappaM1[m+1]-2)+1 )
    mE2[s] ~ dbeta(omegaM2[m+1]*(kappaM2[m+1]-2)+1 , (1-omegaM2[m+1])*(kappaM2[m+1]-2)+1 )


    z[s] ~ dbin( (1-m)*mE1[s] + m*mE2[s] , N[s] )

    }
    }
    ", fill=TRUE)
sink()
inits <- function(){list(m=0)}

params <- c("m")

nc <- 1
n.adapt <-100
n.burn <- 200
n.iter <- 5000
thin <- 1
mymodel <- jags.model('mymodel.txt', data = dataList, inits=inits, n.chains=nc, n.adapt=n.adapt)
update(mymodel, n.burn)
mymodel_samples <- coda.samples(mymodel,params,n.iter=n.iter, thin=thin)
summary(mymodel_samples)

sink("mymodel.txt")
cat("model {

  m ~ dbern(phi)
  phi ~ dunif(0,1)

  omegaM1[1] <- 0.5      #true prior
  omegaM1[2] <- 0.5      #psuedo prior 
  kappaM1[1] <- 3        #true prior for Model 1
  kappaM1[2] <- 5        #puedo prior for Model 1

  omegaM2[1] <- 0.5      #psuedo prior
  omegaM2[2] <- 0.5      #true prior
  kappaM2[1] <- 5        #puedo  prior for Model 2
  kappaM2[2] <- 10       #true prior for Model 2

  for ( s in 1:Nsubj ) {

    mE1[s] ~ dbeta(omegaM1[m+1]*(kappaM1[m+1]-2)+1 , (1-omegaM1[m+1])*(kappaM1[m+1]-2)+1 )
    mE2[s] ~ dbeta(omegaM2[m+1]*(kappaM2[m+1]-2)+1 , (1-omegaM2[m+1])*(kappaM2[m+1]-2)+1 )

    z[s] ~ dbin( (1-m)*mE1[s] + m*mE2[s] , N[s] )

    }
  }
", fill=TRUE)
sink()
inits <- function(){list(m=0)}

params <- c("phi")

data <- c(-1, 0, 1, .5, .1)

m~dbern(phi)
data[i] ~ m*dnorm(0, 1) + (1-m)*dnorm(100, 1)