次のコード (Gelman および Hill's Book に記載されているコードから適応) を使用して、Jags の可変係数/切片順序付きプロビット モデルを推定しようとしています。ただし、「初期化時に観察されていない親と矛盾する観察されたノード。適切な初期値を設定してください」というメッセージが表示されます。どこが間違っていますか?誰か助けてくれませんか?前もって感謝します !!
rm(list=ls(all=TRUE));
options(warn=-1)
library(mvtnorm)
library(arm)
library(foreign)
library("R2jags")
library(MCMCpack)
set.seed(1)
standardizeCols = function( dataMat ) {
zDataMat = dataMat
for ( colIdx in 1:NCOL( dataMat ) ) {
mCol = mean( dataMat[,colIdx] )
sdCol = sd( dataMat[,colIdx] )
zDataMat[,colIdx] = ( dataMat[,colIdx] - mCol ) / sdCol
}
return( zDataMat )
}
keep<-1
nobs = 150;
nis<-sample(1:40,nobs,replace=T) # number obs per subject
id<-rep(1:nobs,nis)
N<-length(id)
corr_beta = 0.6;
Sigma_beta = matrix(c(1, corr_beta, corr_beta, corr_beta,
corr_beta, 1, corr_beta, corr_beta,
corr_beta, corr_beta, 1, corr_beta,
corr_beta, corr_beta, corr_beta, 1), ncol=4);
betas <- rmvnorm(n=N, mean=c(-1.45, 0.90, 0.25, -2.3), sigma=Sigma_beta);
#Generate the data
x3 = matrix(0, nrow=N,ncol=3);
y3 = matrix(0, nrow=N,ncol=1);
for (i in 1:N) {
error_v = rnorm(1,0,1);
x3[i,1] = rnorm(1,0,1);
x3[i,2] = rnorm(1,0,1);
x3[i,3] = rnorm(1,0,1);
y3[i,1] = betas[id[i], 1] + betas[id[i], 2]*x3[i,1] + betas[id[i], 3]*x3[i,2] + betas[id[i], 4]*x3[i,3] + error_v;
}
cutoff=c(-100, 0, 1.5, 2.4, 100)
k=length(cutoff)-1;
Y3<-cut(y3, br = cutoff, right=TRUE, include.lowest = TRUE, labels = FALSE)
Y3=Y3
X3=x3
m1=max(Y3)
y = as.vector( Y3 )
n = length(y)
J<-length(unique(id))
X = cbind(1, standardizeCols( X3 ))
nPred = NCOL(X)
subjects<-as.vector(as.numeric(id))
K=nPred
W <- diag (K)
# MCMC settings
ni <- 5000; nb <- 2500; nt <- 6; nc <- 3
tau1u=c(0,1,2)
jags_data <- list ("n", "J", "K", "y", "subjects", "X", "W", "m1")
inits <- function (){
list (B.raw=array(rnorm(J*K),c(J,K)), mu.raw=rnorm(K), sigma.y=runif(1), Tau.B.raw=rwish(K+1,diag(K)), xi=runif(K))
}
params <- c ("B", "mu", "sigma.B", "rho.B", "tau1u")
cat("model {
for (i in 1:n){
y.hat[i] <- inprod(B[subjects[i],],X[i,])
y[i] ~ dcat(p[i,])
estar[i]~dnorm (y.hat[i], tau.y);
for (j in 1:(m1-1)) {
Q1[i,j]<-pnorm(tau1[j]-estar[i],0,1)
}
p[i,1] <- Q1[i,1]
for(j in 2:(m1-1)) {
p[i,j] <- Q1[i,j] - Q1[i,j-1]
}
p[i,m1] <- 1 - Q1[i,m1-1]
}
tau.y <- pow(sigma.y, -2)
sigma.y ~ dunif (0, 100)
# thresholds (unordered priors)
for(j in 1:(m1-1)){
tau1u[j] ~ dnorm(0,.01)
}
# ordered thresholds
tau1 <- sort(tau1u)
for (j in 1:J){
for (k in 1:K){
B[j,k] <- xi[k]*B.raw[j,k]
}
B.raw[j,1:K] ~ dmnorm (mu.raw[], Tau.B.raw[,])
}
for (k in 1:K){
mu[k] <- xi[k]*mu.raw[k]
mu.raw[k] ~ dnorm (0, .0001)
xi[k] ~ dunif (0, 100)
}
Tau.B.raw[1:K,1:K] ~ dwish (W[,], df)
df <- K+1
Sigma.B.raw[1:K,1:K] <- inverse(Tau.B.raw[,])
for (k in 1:K){
for (k.prime in 1:K){
rho.B[k,k.prime] <- Sigma.B.raw[k,k.prime]/sqrt(Sigma.B.raw[k,k]*Sigma.B.raw[k.prime,k.prime])
}
sigma.B[k] <- abs(xi[k])*sqrt(Sigma.B.raw[k,k])
}
}", fill=TRUE, file="wishart2.txt")
# Start Gibbs sampler
outj <- jags(jags_data, inits=inits, parameters.to.save=params, model.file="wishart2.txt", n.thin=nt, n.chains=nc, n.burnin=nb, n.iter=ni)