B.12 - Reshaping by an informative prior the posterior distribuition obtained starting from a flat prior (see Sec. )

pause <- function() { cat ("\n >> press Enter to continue\n"); scan() }

call.jags <- function(model, data, nr) {
  jm <- jags.model(model, data)
  update(jm, 100)
  chain <- coda.samples(jm, 'p', n.iter=nr)
  print(summary(chain))
  chain.df <- as.data.frame( as.mcmc(chain) )
  return(chain.df$p)
}

library(rjags)
model = "tmp_model.bug"    # name of the model file ('temporary')
write("
model {
  n ~ dbin(p, N)
  p ~ dbeta(r0,s0)   
}
", model)

nr = 100000
N = 10; n = 3 
r0 = s0 = 1    # flat prior

# First call to JAGS
data <- list(N=N, n=n, r0=r0, s0=s0)
p <- call.jags(model, data, nr)
pause()

h <- hist(p, freq=FALSE, nc=100, col='cyan', xlim=c(0,1), ylim=c(0,4))
p.m <- sum(h$mids*h$counts)/sum(h$counts)
p.s <- sqrt(sum(h$mids^2*h$counts)/sum(h$counts) - p.m^2)
cat(sprintf(">>> JAGS:  %.4f +- %.4f\n", p.m, p.s))
pause()

# overimpose the posterion got from a Beta conjugate
curve(dbeta(x,r0+n,s0+(N-n)), col='blue', add=TRUE)
pause()

# Not-flat prior used to reshape the JAGS result
curve(dbeta(x,r,s), col='magenta', add=TRUE)
pause()

# reweighing
w <- dbeta(h$mids, r, s)
f.p.w <- h$density*w
f.p.w <- f.p.w/sum(f.p.w)/(h$mids[2]-h$mids[1])
points(h$mids, f.p.w, col='blue', ty='l', lwd=2)     
p.w.m <- sum(h$mids*f.p.w)/sum(f.p.w)
p.w.s <- sqrt(sum(h$mids^2*f.p.w)/sum(f.p.w) - p.w.m^2)
cat(sprintf(">>> Reweighed:  %.4f +- %.4f\n\n", p.w.m, p.w.s))
pause()

# second call to JAGS, with the new prior
data <- list(N=N, n=n, r0=r, s0=s)
p1 <- call.jags(model, data, nr)
h1 <-  hist(p1, nc=100, plot=FALSE)
points(h1$mids, h1$density, col='red', ty='l', lwd=1.5)  
p1.m <- sum(h1$mids*h1$counts)/sum(h1$counts)
p1.s <- sqrt(sum(h1$mids^2*h1$counts)/sum(h1$counts) - p1.m^2)
cat(sprintf(">>> JAGS(%d,%d):  %.4f +- %.4f\n", r,s, p1.m, p1.s))
pause()

# New Beta obtained by the well known updating rule
curve(dbeta(x,r+n,s+(N-n)), col='green', add=TRUE)