# NOT RUN {
set.seed(1001)
## define mean-centered covariates
G <- 12
z1 <- sample(c(0,1), size=G, replace=TRUE)
z2 <- 0.5*z1 + rnorm(G)
Z <- cbind(z1 - mean(z1), z2 = z2 - mean(z2))
## define true parameters dependent on covariates
beta_m <- c(0.3, 0.8)
beta_s <- c(0.1, -0.1)
mug <- Z[,1]*beta_m[1] + Z[,2]*beta_m[2] + rnorm(G, sd=0.3)
sigmag <- exp(0.3 + Z[,1]*beta_s[1] + Z[,2]*beta_s[2] + 0.2*rt(G, df=7))
cutpoints <- c(-1.0, 0.0, 1.2)
## generate data
ng <- rep(200,G)
ngk <- gendata_hetop(G, K = 4, ng, mug, sigmag, cutpoints)
print(ngk)
## fit FH-HETOP model including covariates
## NOTE: using an extremely small number of iterations for testing,
## so that convergence is not expected
m <- fh_hetop(ngk, fixedcuts = c(-1.0, 0.0), p = c(10,10),
m = c(100, 100), gridL = c(-5.0, log(0.10)),
gridU = c(5.0, log(5.0)), Xm = Z, Xs = Z,
n.iter = 100, n.burnin = 50)
print(m)
print(names(m$fh_hetop_extras))
s <- m$BUGSoutput$summary
print(data.frame(truth = c(beta_m, beta_s), s[grep("beta", rownames(s)),]))
print(cor(mug, s[grep("mu", rownames(s)),"mean"]))
print(cor(sigmag, s[grep("sigma", rownames(s)),"mean"]))
## manual calculation of WAIC (see help file for waic_hetop)
tmp <- waic_hetop(ngk, m$BUGSoutput$sims.matrix)
identical(tmp, m$fh_hetop_extras$waicinfo)
# }
Run the code above in your browser using DataLab