# \donttest{
data(bear)
# plot length, sex, and weight of bears
ck <- c(4,3,2)
pairs(bear[,ck])
# response is weight
Y <- bear$weight
# Continuous Covariate is length of chest
# Categorical covariate is sex
X <- bear[,c("length", "sex")]
X$sex <- as.factor(X$sex)
# Randomly partition data into 44 training and 10 testing
set.seed(1)
trainObs <- sample(1:length(Y),44, replace=FALSE)
Ytrain <- Y[trainObs]
Ytest <- Y[-trainObs]
Xtrain <- X[trainObs,,drop=FALSE]
Xtest <- X[-trainObs,,drop=FALSE]
simParms <- c(0.0, 1.0, 0.1, 1.0, 2.0, 0.1)
modelPriors <- c(0, 100^2, 0.5*sd(Y), 100)
M <- 1.0
niter <- 100000
nburn <- 50000
nthin <- 50
nout <- (niter - nburn)/nthin
mh <- c(1,10)
# Run MCMC algorithm for Gaussian PPMx model
out1 <- gaussian_ppmx(y=Ytrain, X=Xtrain, Xpred=Xtest,
M=M, PPM=FALSE,
meanModel = 1,
similarity_function=1,
consim=1,
calibrate=0,
simParms=simParms,
modelPriors = modelPriors,
draws=niter, burn=nburn, thin=nthin,
mh=mh)
# plot a select few posterior distributions
plot(density(out1$mu[,1])) # first observation's mean
plot(density(out1$sig2[,1])) # first observation's variance
plot(table(out1$nc)/nout,type='h') # distribution
plot(density(out1$mu0), type='l')
plot(density(out1$sig20))
# The first partition iterate is used for plotting
# purposes only. We recommended using the salso
# R-package to estimate the partition based on Si
pairs(bear[trainObs,ck],col=out1$Si[1,], pch=out1$Si[1,])
# Compare fit and predictions when covariates are not included
# in the partition model. That is, refit data with PPM rather than PPMx
out2 <- gaussian_ppmx(y=Ytrain, X=Xtrain, Xpred=Xtest,
M=M, PPM=TRUE,
meanModel = 1,
similarity_function=1,
consim=1,
calibrate=0,
simParms=simParms,
modelPriors = modelPriors,
draws=niter, burn=nburn, thin=nthin,
mh=mh)
oldpar <- par(no.readonly = TRUE)
par(mfrow=c(1,2))
plot(Xtrain[,1], Ytrain, ylab="weight", xlab="length", pch=20)
points(Xtrain[,1], apply(out2$fitted,2,mean), col='red',pch=2, cex=1)
points(Xtrain[,1], apply(out1$fitted,2,mean), col='blue',pch=3, cex=1)
legend(x="topleft",legend=c("Observed","PPM","PPMx"),
col=c("black","red","blue", "green"),pch=c(20,2,3,4))
plot(Xtest[,1], Ytest, ylab="weight", xlab="length",pch=20)
points(Xtest[,1], apply(out2$ppred,2,mean), col='red',pch=2, cex=1)
points(Xtest[,1], apply(out1$ppred,2,mean), col='blue',pch=3, cex=1)
legend(x="topleft",legend=c("Observed","PPM","PPMx"),
col=c("black","red","blue","green"),pch=c(20,2,3,4))
par(oldpar)
# }
Run the code above in your browser using DataLab