# NOT RUN {
########################
# Simulate data
########################
nrec <- 500
x <- runif(nrec)
y <- rep(0,nrec)
for(i in 1:nrec)
{
y[i] <- ifelse(runif(1) < (0.8-0.5*x[i]^2),
rbeta(1,22-(x[i]^2)*20,5+x[i]*20),
rbeta(1,8+x[i]*5,20))
}
# true model
true.dens <- function(grid,x)
{
(0.8-0.5*x^2)*dbeta(grid,22-(x^2)*20,5+x*20)+
(0.2+0.5*x^2)*dbeta(grid,8+x*5,20)
}
true.mean <- function(x)
{
(0.8-0.5*x^2)*(22-(x^2)*20)/(22-(x^2)*20+5+x*20)+
(0.2+0.5*x^2)*(8+x*5)/(8+x*5+20)
}
# predictions
grid <- seq(0,1,len=100)
npred <- 25
xpred <- matrix(1,ncol=2,nrow=npred)
xpred[,2] <- seq(0,1,len=npred)
# prior
prior <- list(maxn = 25,
alpha = 1,
lambda = 25,
nu = 4,
psiinv = diag(1000,2),
m0 = rep(0,2),
S0 = diag(1000,2))
# mcmc
mcmc <- list(nburn = 5000,
nskip = 3,
ndisplay = 100,
nsave = 5000)
# state
state <- NULL
# fitting the model
fit <- LDBDPdensity(formula=y~x,xpred=xpred,
prior=prior,
mcmc=mcmc,
state=NULL,status=TRUE,
grid=grid,
compute.band=TRUE,type.band="PD")
fit
summary(fit)
plot(fit)
# Plots for some predictions
# (conditional density and mean function)
par(mfrow=c(2,2))
plot(fit$grid,fit$densp.h[7,],type="l",lwd=2,
xlim=c(0,1),ylim=c(0,4),xlab="y",ylab="density",lty=2)
lines(fit$grid,fit$densp.m[7,],lwd=2,lty=1)
lines(fit$grid,fit$densp.l[7,],lwd=2,lty=2)
lines(fit$grid,true.dens(fit$grid,fit$xpred[7,2]),lwd=2,col="red")
plot(fit$grid,fit$densp.h[13,],type="l",lwd=2,
xlim=c(0,1),ylim=c(0,4),xlab="y",ylab="density",lty=2)
lines(fit$grid,fit$densp.m[13,],lwd=2,lty=1)
lines(fit$grid,fit$densp.l[13,],lwd=2,lty=2)
lines(fit$grid,true.dens(fit$grid,fit$xpred[13,2]),lwd=2,col="red")
plot(fit$grid,fit$densp.h[19,],type="l",lwd=2,
xlim=c(0,1),ylim=c(0,4),xlab="y",ylab="density",lty=2)
lines(fit$grid,fit$densp.m[19,],lwd=2,lty=1)
lines(fit$grid,fit$densp.l[19,],lwd=2,lty=2)
lines(fit$grid,true.dens(fit$grid,fit$xpred[19,2]),lwd=2,col="red")
plot(x,y)
lines(fit$xpred[,2],fit$meanfp.m,lwd=2,lty=1)
lines(fit$xpred[,2],fit$meanfp.l,lwd=2,lty=2)
lines(fit$xpred[,2],fit$meanfp.h,lwd=2,lty=2)
lines(fit$xpred[,2],true.mean(fit$xpred[,2]),lwd=2,lty=1,col="red")
# }
Run the code above in your browser using DataLab