# NOT RUN {
##########################################################
# Simulated data:
# Here we replicate the results reported with
# simulated data by Dunson, Pillai and Park (2007,
# JRSS Ser. B, 69: 163-183, pag 177) where a different
# approach is proposed.
##########################################################
dtrue <- function(grid,x)
{
exp(-2*x)*dnorm(grid,mean=x,sd=sqrt(0.01))+
(1-exp(-2*x))*dnorm(grid,mean=x^4,sd=sqrt(0.04))
}
nobs <- 500
x <- runif(nobs)
y1 <- x + rnorm(nobs, 0, sqrt(0.01))
y2 <- x^4 + rnorm(nobs, 0, sqrt(0.04))
u <- runif(nobs)
prob <- exp(-2*x)
y <- ifelse(u<prob,y1,y2)
# Prior information
w <- cbind(y,x)
wbar <- apply(w,2,mean)
wcov <- var(w)
prior <- list(a0=10,
b0=1,
nu1=4,
nu2=4,
s2=0.5*wcov,
m2=wbar,
psiinv2=2*solve(wcov),
tau1=6.01,
tau2=2.01)
# Initial state
state <- NULL
# MCMC parameters
mcmc <- list(nburn=5000,
nsave=5000,
nskip=3,
ndisplay=100)
# fitting the model
xpred <- c(0.00,0.05,0.10,0.15,0.20,0.25,
0.30,0.35,0.40,0.45,0.49,0.55,
0.60,0.65,0.70,0.75,0.80,0.85,
0.88,0.95,1.00)
fit <- DPcdensity(y=y,x=x,xpred=xpred,ngrid=100,
prior=prior,
mcmc=mcmc,
state=state,
status=TRUE,
compute.band=TRUE,type.band="PD")
# true model and estimates
par(mfrow=c(2,3))
plot(fit$grid,fit$densp.h[3,],lwd=1,type="l",lty=2,
main="x=0.10",xlab="values",ylab="density",ylim=c(0,4))
lines(fit$grid,fit$densp.l[3,],lwd=1,type="l",lty=2)
lines(fit$grid,fit$densp.m[3,],lwd=2,type="l",lty=1)
lines(fit$grid,dtrue(fit$grid,xpred[3]),lwd=2,
type="l",lty=1,col="red")
plot(fit$grid,fit$densp.h[6,],lwd=1,type="l",lty=2,
main="x=0.25",xlab="values",ylab="density",ylim=c(0,4))
lines(fit$grid,fit$densp.l[6,],lwd=1,type="l",lty=2)
lines(fit$grid,fit$densp.m[6,],lwd=2,type="l",lty=1)
lines(fit$grid,dtrue(fit$grid,xpred[6]),lwd=2,
type="l",lty=1,col="red")
plot(fit$grid,fit$densp.h[11,],lwd=1,type="l",lty=2,
main="x=0.49",xlab="values",ylab="density",ylim=c(0,4))
lines(fit$grid,fit$densp.l[11,],lwd=1,type="l",lty=2)
lines(fit$grid,fit$densp.m[11,],lwd=2,type="l",lty=1)
lines(fit$grid,dtrue(fit$grid,xpred[11]),lwd=2,type="l",
lty=1,col="red")
plot(fit$grid,fit$densp.h[16,],lwd=1,type="l",lty=2,
main="x=0.75",xlab="values",ylab="density",ylim=c(0,4))
lines(fit$grid,fit$densp.l[16,],lwd=1,type="l",lty=2)
lines(fit$grid,fit$densp.m[16,],lwd=2,type="l",lty=1)
lines(fit$grid,dtrue(fit$grid,xpred[16]),lwd=2,type="l",
lty=1,col="red")
plot(fit$grid,fit$densp.h[19,],lwd=1,type="l",lty=2,
main="x=0.75",xlab="values",ylab="density",ylim=c(0,4))
lines(fit$grid,fit$densp.l[19,],lwd=1,type="l",lty=2)
lines(fit$grid,fit$densp.m[19,],lwd=2,type="l",lty=1)
lines(fit$grid,dtrue(fit$grid,xpred[19]),lwd=2,type="l",
lty=1,col="red")
# data and mean function
plot(x,y,xlab="x",ylab="y",main="")
lines(xpred,fit$meanfp.m,type="l",lwd=2,lty=1)
lines(xpred,fit$meanfp.l,type="l",lwd=2,lty=2)
lines(xpred,fit$meanfp.h,type="l",lwd=2,lty=2)
# }
Run the code above in your browser using DataLab