Why the jags result and depmixS4 are sometimes different? - hidden-markov-models

Question

I have a data set like the following simulated data:
Pi = matrix(c(0.9,0.1,0.3,0.7),2,2,byrow=TRUE)
delta = c(.5,.5)
z = sample(c(1,2),1,prob=delta)
T = 365
for( t in 2:T){
z[t] = sample(x=c(1,2),1,prob=Pi[z[t-1],])
}
x <- sample(x=seq(-1, 1.5, length.out=T),T,replace=TRUE)
alpha = c(-1, -3.2)
Beta = c(-4,3)
y<-NA
for(i in 1:T){
y[i] = rbinom(1,size=10,prob=1/(1+exp(-Beta[z[i]]*x[i]-alpha[z[i]])))
}
SimulatedBinomData <- data.frame('y' = y, 'x' = x , size=rep(10,T), 'z' = z)
yy<-NA
xx<-NA
for(i in 1:dim(SimulatedBinomData)[1]){
yy<-c(yy,c(rep(1,SimulatedBinomData$y[i]),rep(0,(SimulatedBinomData$size[i]-SimulatedBinomData$y[i]))))
xx<-c(xx,rep(SimulatedBinomData$x[i],SimulatedBinomData$size[i]))
}
yy<-yy[-1]
xx<-xx[-1]
SimulatedBernolliData<-data.frame(y=yy,x=xx, tt=rep(c(1:T),rep(10,T)))
This is a HMM problem with two states meaning that the Hidden Markov chain z_t belongs to {1,2}. To estimate alpha and Beta in two different states I can use the package 'depmixS4' and find the Maximum Likelihood estimates or I can use MCMC in 'rjags' package.
I expect that these two estimations be almost the same while when I run the following program for different simulated data, in several times, the answers are not the same and very different!!
library("rjags")
library("depmixS4")
mod <- depmix(cbind(y,(size-y))~x, data=SimulatedBinomData, nstates=2, family=binomial(logit))
fm <- fit(mod)
getpars(fm)
n<-length(SimulatedBernolliData$y)
T<-max(SimulatedBernolliData$tt)
cat("model {
# Transition Probability
Ptrans[1,1:2] ~ ddirch(a)
Ptrans[2,1:2] ~ ddirch(a)
# States
Pinit[1] <- 0.5 #failor
Pinit[2] <- 0.5 #success
state[1] ~ dbern(Pinit[2])
for (t in 2:T) {
state[t] ~ dbern(Ptrans[(state[t-1]+1),2])
}
# Parameters
alpha[1] ~ dunif(-1.e10, 1.e10)
alpha[2] ~ dunif(-1.e10, 1.e10)
Beta[1] ~ dunif(-1.e10, 1.e10)
Beta[2] ~ dunif(-1.e10, 1.e10)
# Observations
for (i in 1:n){
z[i] <- state[tt[i]]
y[i] ~ dbern(1/(1+exp(-(alpha[(z[i]+1)]+Beta[(z[i]+1)]*x[i]))))
}
}",
file="LeftBehindHiddenMarkov.bug")
jags <- jags.model('LeftBehindHiddenMarkov.bug', data = list('x' = SimulatedBernolliData$x, 'y' = SimulatedBernolliData$y, 'tt' = SimulatedBernolliData$tt, T=T, n = n, a = c(1,1) ))
res <- coda.samples(jags,c('alpha', 'Beta', 'Ptrans','state'),1000)
res.median = apply(res[[1]],2,median)
res.median[1:8]
res.mean = apply(res[[1]],2,mean)
res.mean[1:8]
res.sd = apply(res[[1]],2,sd)
res.sd[1:8]
res.mode = apply(res[[1]],2,function(x){as.numeric(names(table(x))
[which.max(table(x))]) })
res.mode[1:8]

Answer 1

You are having a problem of label switching in your JAGS code, that is, states z[i]=1 is not bounded to the lower posterior value for Beta and z[i]=2 to the higher Beta. Therefore, for each iteration of the MCMC they can switch. There are several ways to solve this problem. One of them is the partial reordering, that is, for every MCMC iteration, draw two independent values for Beta and order them so that Beta[1] < Beta[2].
You can do that by substituting
Beta[1] ~ dunif(-1.e10, 1.e10)
Beta[2] ~ dunif(-1.e10, 1.e10)
for
Beta[1:2] <- sort(Betaaux)
Betaaux[1] ~ dunif(-1.e10, 1.e10)
Betaaux[2] ~ dunif(-1.e10, 1.e10)
Of course, the ordering could also be done on the alpha parameters instead. The election of which parameter to use for the partial reordering depends on the problem.