#fit model to non-stationary data including all covariates
fm.est1 <- RMC.mod( states=dataEG2[,2], chain.id=dataEG2[,1], X=dataEG2[,3:4], vcov=TRUE) #estimate the model
#perform predictions
pred1 <- RMC.pred( fit=fm.est1, fit2=NULL, pts=dataEG2[,3:4])
tmp <- cbind( table( dataEG2[,"state"]) / nrow( dataEG2), pred1$area, sqrt( diag( pred1$vcov)))
colnames( tmp) <- c( "observed", "predicted", "se")
rownames( tmp) <- paste( "cat",1:fm.est1$stuff$n.cats, sep="_")
print( tmp)
####Simulate and predict from bivariate non-stationary chained data
n.cats1 <- fm.est1$stuff$n.cats; n.cats2 <- 5; n.covars <- 2; n.covars2 <- n.covars*n.cats1 + n.covars
#fill in missing values (if any) for the previous outcomes that are now covariates
level1Probs <- MVfill( fm.est1, states=dataEG2[,2], chain.id=dataEG2[,1], X=dataEG2[,3:4])
#setting up design matrix -- note the order, it is important for RMC.pred
X2 <- matrix( rep( dataEG2[,3:4], n.cats1+1), nrow=nrow( dataEG2))
for( ii in 1:n.cats1)
X2[,ii*n.covars+1:n.covars] <- X2[,ii*n.covars+1:n.covars] * rep( level1Probs[,ii], n.covars)
colnames(X2) <- paste( c( "const", "rand"), rep(c("",1:n.cats1), each=2), sep="")
#specify parameter values, note that parameterisation gives state 1 as a reference state for all categories. This is for convenience only.
gamma <- matrix( rnorm( n.covars2*n.cats2, sd=0.5), nrow=n.covars2, ncol=n.cats2) #initial design matrix
for( ii in 1:n.cats2)
gamma[sample( 2:n.covars2, sample(n.covars2-1:4, 1)), ii] <- 0
beta <- matrix( rnorm( n.covars2*n.cats2, sd=0.5), nrow=n.covars2, ncol=n.cats2)
beta[n.covars+1:n.covars,] <- 0
beta[,n.cats2] <- 0
#simulate chains
chains2 <- sim.chain( n.chains=5, n.obs=rep( 1000, 5), n.cats=n.cats2, n.covars=n.covars2, beta=beta, gamma=gamma, X=X2) #simulate the chained categorical data
#specify RMC model to be estimated
my.phi.id <- ifelse( gamma!=0, 1, 0) #model controlling matrix
my.pi.id <- apply( beta, FUN=function(x){if( any( x!=0)) 1 else 0}, MARG=1) #model controlling matrix
#fit model
fm.est2 <- RMC.mod( states=chains2[,2], chain.id=chains2[,1], X=X2, phi.id=my.phi.id, pi.id=my.pi.id, vcov=TRUE) #estimate the model
#perform predictions
pred2cond <- RMC.pred( fit=fm.est2, fit2=NULL, pts=X2)
pred2marg <- RMC.pred( fit=fm.est2, fit2=fm.est1, pts=dataEG2[,3:4])
#check against empirical value
tmp <- cbind( table( chains2[,"state"]) / nrow( chains2), pred2cond$area, sqrt( diag( pred2cond$vcov)), pred2marg$area, sqrt( diag( pred2marg$vcov)))
colnames( tmp) <- c("observed","conditional prediction", "conditional se", "marginal prediction", "marginal se")
rownames( tmp) <- paste( "category", 1:n.cats2, sep="_")
print( tmp)
Run the code above in your browser using DataLab