# Beta-binomial design code, by Sparks and Carlin, 10/10/01
#   (last update:  2/12/02)
# Here the priors are all of the "weighted" form, 
#    ie Beta(110w,7w), 0 < w < 1

# NOTE:  New data is generated from the assumed prior!
#   (We *could* generate it from some other distribution...)

set.seed(99)
w <- c(1,.5,.1)
N <- c(20,50)
C <- c(.85,.86,.87,.88,.89,.90)
x <- seq(from=.8,to=.998,length=50);  Nrep <- 100

par(mfcol=c((length(N)+1),length(w)),oma=c(1,0,4,0))
pct <- matrix(0,length(C),length(w)*length(N)+1);  pct[,1] <- C

#  HERE IS CHRONICLE "A" DATA:
no.ae <- 110;  ae <- 7

#  NOW START MAIN SIMULATION LOOPS:

for(j in 1:length(w)){

  alpha <- no.ae*w[j]
  beta <- ae*w[j]
  cb.prior <- rbeta(Nrep,alpha,beta)

#  PLOT PRIORS SO WE CAN LOOK AT THEM:
  plot(x,dbeta(x,alpha,beta),type="l",ylim=c(0,80),xlab="",ylab="")
  title(sub=paste("Beta(110w,7w) prior with w =",w[j]),cex=1.05)

for(k in 1:length(N)){
	
cb.x <- rbinom(Nrep,N[k],cb.prior)

#  HERE IS THE CALCULATION OF THE LOWER .025 POINT OF THE POSTERIOR:
cb.post <- rep(NA,Nrep)
cb.post <- qbeta(0.025,cb.x + alpha,N[k] - cb.x + beta)

plot(x,dbeta(x,cb.x[1] + alpha,N[k] - cb.x[1] + beta),type="l",ylim=c(0,80),
  xlab="",ylab="")
for(i in 2:Nrep){
  lines(x,dbeta(x,cb.x[i] + alpha,N[k] - cb.x[i] + beta),lty=i)}
title(sub=paste("Nrep=",Nrep,", N=",N[k],", w =",w[j]),cex=1.05)


cat(paste("\n N = ", N[k], "   w = ", w[j]))
for(i in 1:length(C)){
  pct[i,1+(j-1)*length(N)+k] <- sum((cb.post > C[i])==T)/Nrep
  cat(paste("\n Percent of lower .025 points >",C[i]," is", 
    round(pct[i,1+(j-1)*length(N)+k],3)))
}
#cat("\n Hit enter for more...\n")
#readline()

}  # end of N[k] loop

}  # end of w[j] (prior) loop

mtext(side=3,line=1,cex=1.4,outer=TRUE,
  "Priors and simulated posteriors, Chronicle B study, beta-binomial design")
mtext(side=3,line=-2,cex=1.4,outer=TRUE,
  "using weighted Beta(a,b) priors (target->downweighted)")

cat(paste("\n\nHere is sample size table for Beta(110w,7w) prior:\n"))
print(pct)

cat("\nThat's all!\n")
