## Not run:
# ####################################
# # A simulated Data Set
# ####################################
#
# grid <- seq(-4,4,0.01)
#
# dtrue1 <- function(grid)
# {
# 0.6*dnorm(grid,-1,0.4)+
# 0.3*dnorm(grid,0,0.5)+
# 0.1*dnorm(grid,1,0.5)
# }
#
# dtrue2 <- function(grid)
# {
# 0.5*dnorm(grid,-1,0.5)+
# 0.5*dnorm(grid,1,0.5)
# }
#
# dtrue3 <- function(grid)
# {
# 0.1*dnorm(grid,-1,0.5)+
# 0.3*dnorm(grid,0,0.5)+
# 0.6*dnorm(grid,1,0.4)
# }
#
# rtrue1 <- function(n)
# {
# ind <- sample(x=c(1,2,3),
# size=n,replace =TRUE,
# prob =c(0.6,0.3,0.1))
# x1 <- rnorm(n,-1,0.4)
# x2 <- rnorm(n, 0,0.5)
# x3 <- rnorm(n, 1,0.5)
# x <- rep(0,n)
# x[ind==1] <- x1[ind==1]
# x[ind==2] <- x2[ind==2]
# x[ind==3] <- x3[ind==3]
# return(x)
# }
#
# rtrue2 <- function(n)
# {
# ind <- sample(x=c(1,2),
# size=n,replace=TRUE,
# prob =c(0.5,0.5))
# x1 <- rnorm(n,-1,0.5)
# x2 <- rnorm(n, 1,0.5)
# x <- rep(0,n)
# x[ind==1] <- x1[ind==1]
# x[ind==2] <- x2[ind==2]
# return(x)
# }
#
# rtrue3 <- function(n)
# {
# ind <- sample(x=c(1,2,3),
# size=n,replace=TRUE,
# prob =c(0.1,0.3,0.6))
# x1 <- rnorm(n,-1,0.5)
# x2 <- rnorm(n, 0,0.5)
# x3 <- rnorm(n, 1,0.4)
# x <- rep(0,n)
# x[ind==1] <- x1[ind==1]
# x[ind==2] <- x2[ind==2]
# x[ind==3] <- x3[ind==3]
# return(x)
# }
#
# b1 <- rtrue1(n=200)
# hist(b1,prob=TRUE,xlim=c(-4,4),ylim=c(0,0.7))
# lines(grid,dtrue1(grid))
#
# b2 <- rtrue2(n=200)
# hist(b2,prob=TRUE,xlim=c(-4,4),ylim=c(0,0.7))
# lines(grid,dtrue2(grid))
#
# b3 <- rtrue3(n=200)
# hist(b3,prob=TRUE,xlim=c(-4,4),ylim=c(0,0.7))
# lines(grid,dtrue3(grid))
#
# nsubject <- 600
# theta <- c(b1,b2,b3)
# trt <- as.factor(c(rep(1,200),rep(2,200),rep(3,200)))
# nitem <- 40
#
# y <- matrix(0,nrow=nsubject,ncol=nitem)
# dimnames(y)<-list(paste("id",seq(1:nsubject)),
# paste("item",seq(1,nitem)))
#
# beta <- c(0,seq(-4,4,length=nitem-1))
#
# for(i in 1:nsubject)
# {
# for(j in 1:nitem)
# {
# eta <- theta[i]-beta[j]
# prob <- exp(eta)/(1+exp(eta))
# y[i,j] <- rbinom(1,1,prob)
# }
# }
#
# ##############################
# # design's prediction matrix
# ##############################
#
# zpred <- matrix(c(1,0,0,
# 1,1,0,
# 1,0,1),nrow=3,ncol=3,byrow=TRUE)
#
# ###########################
# # prior
# ###########################
#
# prior <- list(alpha=1,
# beta0=rep(0,nitem-1),
# Sbeta0=diag(1000,nitem-1),
# mu0=rep(0,3),
# S0=diag(100,3),
# tau1=6.01,
# taus1=6.01,
# taus2=2.01,
# nu=5,
# psiinv=diag(1,3))
#
# ###########################
# # mcmc
# ###########################
# mcmc <- list(nburn=5000,
# nskip=3,
# ndisplay=100,
# nsave=5000)
#
# ###########################
# # fitting the model
# ###########################
#
# fitLDDP <- LDDPrasch(formula=y ~ trt,
# prior=prior,
# mcmc=mcmc,
# state=NULL,
# status=TRUE,
# zpred=zpred,
# grid=grid,compute.band=TRUE)
#
# fitLDDP
#
# summary(fitLDDP)
#
# #########################################
# # plots
# #########################################
# plot(fitLDDP)
#
# plot(fitLDDP,param="prediction")
#
# #########################################
# # plot the estimated and true densities
# #########################################
#
# par(cex=1.5,mar=c(4.1, 4.1, 1, 1))
# plot(fitLDDP$grid,fitLDDP$dens.m[1,],xlim=c(-4,4),ylim=c(0,0.8),
# type="l",lty=1,lwd=3,xlab="Ability",ylab="density",col=1)
# lines(fitLDDP$grid,fitLDDP$dens.u[1,],lty=2,lwd=3,col=1)
# lines(fitLDDP$grid,fitLDDP$dens.l[1,],lty=2,lwd=3,col=1)
# lines(grid,dtrue1(grid),lwd=3,col="red",lty=3)
#
# par(cex=1.5,mar=c(4.1, 4.1, 1, 1))
# plot(fitLDDP$grid,fitLDDP$dens.m[2,],xlim=c(-4,4),ylim=c(0,0.8),
# type="l",lty=1,lwd=3,xlab="Ability",ylab="density",col=1)
# lines(fitLDDP$grid,fitLDDP$dens.u[2,],lty=2,lwd=3,col=1)
# lines(fitLDDP$grid,fitLDDP$dens.l[2,],lty=2,lwd=3,col=1)
# lines(grid,dtrue2(grid),lwd=3,col="red",lty=3)
#
# par(cex=1.5,mar=c(4.1, 4.1, 1, 1))
# plot(fitLDDP$grid,fitLDDP$dens.m[3,],xlim=c(-4,4),ylim=c(0,0.8),
# type="l",lty=1,lwd=3,xlab="Ability",ylab="density",col=1)
# lines(fitLDDP$grid,fitLDDP$dens.u[3,],lty=2,lwd=3,col=1)
# lines(fitLDDP$grid,fitLDDP$dens.l[3,],lty=2,lwd=3,col=1)
# lines(grid,dtrue3(grid),lwd=3,col="red",lty=3)
#
# #########################################
# # Extract random effects
# #########################################
# DPrandom(fitLDDP)
# plot(DPrandom(fitLDDP))
# DPcaterpillar(DPrandom(fitLDDP))
#
# ## End(Not run)
Run the code above in your browser using DataLab