[精品图书下载]Bayesian Methods for Data Analysis 3rd Edition 2008

请问这本书下载如何获取论坛比？

1. postplot <- function(mu, tau, ybar, sigma, n){
   
2.   denom <- sigma^2/n + tau^2
   
3.   mu <- (sigma^2/n*mu + tau^2*ybar)/denom
   
4.   stdev <- sqrt(sigma^2/n*tau^2/denom)
   
5.   return(c(mu,stdev))
   
6.   }
   
7. 
   
8. x <- seq(-2,8,length.out=100)
   
9. plot(x, dnorm(x, mean=2, sd=1), ylim=c(0, 1.3),
   
10.   xlab=expression(theta), ylab="density", type= "l")
    
11. 
    
12. param1 <- postplot(2,1,6,1,1)
    
13. lines(x, dnorm(x, mean=param1[1], sd=param1[2]), lty=2)
    
14. param10 <- postplot(2,1,6,1,10)
    
15. lines(x, dnorm(x, mean=param10[1], sd=param10[2]), lty=3)
    
16. legend(-2, 1.3, legend=c("prior", "posterior with n=1",
    
17.   "posterior with n=10"), lty=1:3, ncol=1)
    
18. 
    
19. y1 <- rnorm(2000, mean=param1[1], sd=param1[2])
    
20. ## param1: [1] 4.0000000 0.7071068
    
21. r1 <- hist(y1, freq=F, breaks=20, plot=F)
    
22. lines(r1, lty=2, freq=F, col="gray90")

复制代码

1. alpha<-5
   
2. beta<-6
   
3. theta<-seq(0, 100, length.out=101)
   
4. prior <- dgamma(theta, shape=alpha, scale=beta)
   
5. x<-42
   
6. posterior <- dgamma(theta, shape=x+alpha, scale=1/(1+1/beta) )
   
7. 
   
8. plot(theta, posterior, xlab=expression(theta), ylab="density", type="l")
   
9. lines(theta, prior, lty=3)
   
10. 
    
11. postdraw <- rgamma(2000, shape=x+alpha, scale=1/(1+1/beta))
    
12. r1<-hist(postdraw, freq=F, breaks=20, plot=F)
    
13. lines(r1, lty=3, freq=F, col="gray90")

复制代码

1. par(mfrow=c(1,2))
   
2. 
   
3. x <- seq(.01,.99,length=99);  top <- 3.25
   
4. plot(x,dbeta(x,.5,.5),type="l",xlab=expression(theta),
   
5.   ylab="prior density",ylim=c(0,top))
   
6. lines(x,dbeta(x,1,1),lty=2)
   
7. lines(x,dbeta(x,2,2),lty=3)
   
8. legend(.2,top,cex=1.2,legend =c("Beta(.5,.5)  (Jeffreys prior)",
   
9.   "Beta(1,1)  (uniform prior)",
   
10.   "Beta(2,2)  (skeptical prior)"),lty=1:3)
    
11. 
    
12. x <- seq(0,1,length=100);
    
13. plot(x,dbeta(x,13.5,3.5),type="l",lty=1,xlab=expression(theta),
    
14.   ylab="posterior density")
    
15. lines(x,dbeta(x,14,4),lty=2)
    
16. lines(x,dbeta(x,15,5),lty=3)
    
17. legend(0.1 ,3.5,cex=1.2,legend =c(
    
18. "Beta(13.5,3.5)", "Beta(14,4)", "Beta(15,5)"),lty=1:3)
    
19. 
    
20. a <- 0.025 ; b <- 0.5; d <- 0.975
    
21. a1 <- qbeta(a,13.5,3.5); a2 <- qbeta(b,13.5,3.5)
    
22. a3 <- qbeta(d,13.5,3.5); a4 <- pbeta(0.6,13.5,3.5); a5 <- 1-a4
    
23. b1 <- qbeta(a,14,4); b2 <- qbeta(b,14,4)
    
24. b3 <- qbeta(d,14,4); b4 <- pbeta(0.6,14,4); b5 <- 1-b4
    
25. e1 <- qbeta(a,15,5); e2 <- qbeta(b,15,5)
    
26. e3 <- qbeta(d,15,5); e4 <- pbeta(0.6,15,5); e5 <- 1-e4
    
27. 
    
28. cat("q_.025    q_.50     q_.975    P(theta >.6)\n")
    
29. prob <- c( a1,a2,a3,a5,b1,b2,b3,b5,e1,e2,e3,e5)
    
30. p <- t(matrix(prob,4,3))
    
31. print(round(p,3))

复制代码

1. ###########################
   
2. #  MAC fraility example -- R code to arrange the dataset
   
3. #    Weibull survival model -- Example 2.15
   
4. ###########################
   
5. 
   
6. 
   
7. # Our dataset is unbalanced, as the number of subjects differs from site to site:
   
8. # nsub=c(4,2,1,10,8,12,6,6,13,4,3), i.e. there are 4 subjects in site 1, 2 in site 2, etc.
   
9. #
   
10. # We use "offset" to hold the position in the dataset at which each person's data starts.
    
11. # Here is a snippet of R code to calculate offset from nsub:
    
12. 
    
13.     nsub<-c(4,2,1,10,8,12,6,6,13,4,3)
    
14.     temp<-1
    
15.     offset<-rep(0,(length(nsub)+1))
    
16.     for(i in 1:length(nsub)){offset[i]<-temp; temp<-temp+nsub[i]}
    
17.     offset[ (length(nsub)+1)] <-sum(nsub)+1

复制代码

1. ####################
   
2. #   R CODE TO ILLUSTRATE THE BAYESIAN CENTRAL LIMIT THEOREM
   
3. #    USING BETA/BINOMIAL (HAMBURGER PATTIES) EXAMPLE
   
4. ####################
   
5. 
   
6. x <- seq(0,1,length=100);
   
7. plot(x,dbeta(x,14,4),type="l",lty=1,xlab=expression(theta),
   
8.   ylab="posterior density")
   
9. phat <- 13/16;  var <- phat*(1-phat)/16
   
10. lines(x,dnorm(x,phat,sqrt(var)),lty=2)
    
11. legend(0 ,3.5,cex=1.2,legend =c(
    
12. "exact (beta)", "approximate (normal)"),lty=1:2)

复制代码

1. ###############
   
2. #  R code for 2-stage Bayesian GLM (Lindley and Smith, 1972)
   
3. #  See Example 4.1 in Carlin and Louis (2008)
   
4. ###############
   
5. 
   
6. X <-cbind(rep(1,n),lgage)
   
7. mu <- c(0,0)
   
8. R <- matrix(c(0.001,0,0,0.001), nrow=2)
   
9. tau <- c(1,100)
   
10. 
    
11. postfn <- function(Y, X, mu, R, tau){
    
12.   p <- dim(X)[2]
    
13.   D <- solve( tau*t(X)%*%X + R)
    
14.   d <- tau*t(X)%*%Y + R%*%diag(rep(1,p))%*%mu
    
15.   postmean <- D%*%d
    
16.   postsd <- sqrt(diag(D))
    
17.   return(list(mean= D%*%d, sd=sqrt(diag(D)) ))
    
18.   }
    
19. 
    
20. post1 <- postfn(Y, X, mu, R, tau[1]) # posterior for tau=1
    
21. beta <- post1$mean[2]
    
22. postsd <- post1$sd[2]
    
23. CI1 <- c(beta+qnorm(0.025)*postsd , beta+qnorm(0.975)*postsd)
    
24. 
    
25. post2 <- postfn(Y, X, mu, R, tau[2]) # posterior for tau=100
    
26. beta <- post1$mean[2]
    
27. postsd <- post1$sd[2]
    
28. CI2 <- c(beta+qnorm(0.025)*postsd , beta+qnorm(0.975)*postsd)
    
29. 
    
30. theta <- seq(-0.2,0.6,length.out=100)
    
31. dens1<-dnorm(theta, mean=post1$mean[2], sd=post1$sd[2] )
    
32. dens2<-dnorm(theta, mean=post2$mean[2], sd=post2$sd[2] )
    
33. plot(theta, dens1, xlab=expression(beta), xlim=c(-0.2, 0.6),
    
34.   ylim=c(0,20), ylab="posterior density", type="n")
    
35. lines(theta, dens1, lty=1)        # posterior density for tau=1
    
36. lines(theta, dens2, lty=2)        # posterior density for tau=100
    
37. 
    
38. postdraw <- rnorm(2000, mean=post2$mean[2], sd=post2$sd[2] )
    
39. r1<-hist(postdraw,freq=F,breaks=20, plot=F)
    
40. lines(r1,lty=3, freq=F, col="gray90")   #posterior draws, tau=100
    
41. legend(-0.2, 20, legend=c(expression(paste(tau,"=1", sep="")),
    
42.   expression(paste(tau,"=100", sep=""))), lty=c(1,2), ncol=1)
    
43.   

复制代码

2100