Exercise 1.1 — Problem 1.2, Cowles (2013)

What if the result of the mammogram instead had been negative? Write out a table like table1.3 for a negative mammogram. What is the posterior probability that my friend will be diagnosed with breast cancer in this case?

Solution

Mammogram test is negative (M-)，P(D+ | M-)=0.0013

Model Prior Likelihood for M- lik \(\times\) Prior Posterior
D+ 0.0045 0.276 0.012 0.0013
D- 0.9955 0.973 0.9686 0.9987 
post <- numeric(2)
post.test <- function(prior, lik){
  post[1] = prior * lik[1]/(prior*lik[1] + (1-prior)*lik[2])
  post[2] = (1-prior) * lik[2]/(prior*lik[1] + (1-prior)*lik[2])
  return(post)
}
prior <- 0.0045
lik =c(0.276, 0.973)
post.test(prior, lik)
[1] 0.001280593 0.998719407

table1.3

prior <- 0.0045
lik =c(0.724, 0.027)
post.test(prior, lik)
[1] 0.1081081 0.8918919
Model Prior Likelihood for M+ Lik \(\times\) Prior Posterior
D+ 0.0045 0.724 0.0033 0.108
D- 0.9955 0.027 0.0269 0.892

Exercise 1.2—– Problem 1.3, Cowles (2013)

What if the results of both the mammogram and the SCNB had been positive? Write out a table like Table 1.4 for a positive SCNB. What is the posterior probability that my friend has breast cancer in this case?

Solution

prior <- 0.108
lik =c(0.89, 0.06)
post.test(prior, lik)
[1] 0.6423416 0.3576584
Model Prior Likelihood for M+ Lik \(\times\) Prior Posterior
D+ 0.108 0.89 0.096 0.642
D- 0.892 0.06 0.054 0.358

Table1.4

prior <- 0.108
lik =c(0.11, 0.94)
post.test(prior, lik)
[1] 0.01397055 0.98602945
Model Prior Likelihood for M+ Lik \(\times\) Prior Posterior
D+ 0.108 0.11 0.012 0.014
D- 0.892 0.94 0.838 0.986

Exercise 2.1——-Problem 3.1, Cowles (2013)

For the beta density with parameters \(\alpha=2\) and \(\beta=7\), do the following:

  1. Calculate the mean and mode as functions of the parameters.

  2. Use an \(\mathrm{R}\) function to determine the median and a \(90 \%\) central interval.

  3. Plot the density.

My answer for Exercise 1.3

  1. mean = \(\alpha / (\alpha + \beta)=2/9\); mode = \((\alpha - 1) / (\alpha + \beta - 2)=1/7\)

  2. 0.2011;(0.0464,0.4707)

 # a.
alpha <- 2#定义参数
beta <- 7
mean <- alpha / (alpha + beta)
mode <- (alpha - 1) / (alpha + beta - 2)
print(paste0("Mean: ", mean))
[1] "Mean: 0.222222222222222"
print(paste0("Mode: ", mode)) 
[1] "Mode: 0.142857142857143"
# b.
qbeta(c(0.5),2,7)
[1] 0.2011312
qbeta(c(0.05,0.95),2,7)
[1] 0.04638926 0.47067941

c.Plot the density

x<-seq(0.005,0.995,length=100)
y<-dbeta(x,2,7)
 plot(x,y,"l")

Exercise 2.2—Problem 3.2, Cowles (2013)

To see some of the different shapes that beta densities may take on, plot each of the following densities:

  1. \(\operatorname{beta} (0.5,0.5)\)

  2. \(\operatorname{beta}(10.2,1.5)\)

  3. \(\operatorname{beta}(1.5,10.2)\)

  4. \(\operatorname{beta}(100,62)\)

par(mfrow=c(2,2))
curve(dbeta(x, 0.5,0.5), xlim=c(0,1), 
      main='Beta(0.5,0.5)', xlab='p', 
      ylab='prior density',cex.lab=1.5, cex.axis=1.5)
curve(dbeta(x, 10.2,1.5), xlim=c(0,1), 
      main='Beta(10.2,1.5)',  xlab='p', ylab='prior density',
      cex.lab=1.5, cex.axis=1.5)
curve(dbeta(x, 1.5,10.2), xlim=c(0,1), 
      main='Beta(1.5,10.2)', xlab='p', ylab='prior density',
      cex.lab=1.5, cex.axis=1.5)
curve(dbeta(x, 100,62), xlim=c(0,1),
      main='Beta(100,62)', xlab='p', ylab='prior density',
      cex.lab=1.5, cex.axis=1.5)

Exercise 2.3—Exercise 2.1, Albert (2013)

Estimating a proportion with a discrete prior Bob claims to have ESP. To test this claim, you propose the following experiment. You will select one card from four large cards with different geometric figures, and Bob will try to identify it. Let \(p\) denote the probability that Bob is correct in identifying the figure for a single card. You believe that Bob has no ESP ability \((p=.25)\), but there is a small chance that \(p\) is either larger or smaller than .25. After some thought, you place the following prior distribution on \(p\) :

p 0 .125 .250 .375 .500 .625 .750 .875 1
g(p) .001 .001 .950 .008 .008 .008 .008 .008 .008

Suppose that the experiment is repeated ten times and Bob is correct six times and incorrect four times.Using the function pdisc, find the posterior probabilities of these values of \(p\). What is your posterior probability that Bob has no ESP ability?

My answer for Exercise 2.3

Bob has no ESP ability \((p=0.73)\)

p <- c(0,0.125,0.25,.375,.500,.625,.750,.875,1)
prior<-c(.001,.001,.950,.008,.008,.008,.008,.008,.008)
data<-c(6,4)
#rbind(p,prior)
library(LearnBayes)
post<-pdisc(p,prior,data)
round(rbind(p,prior,post),3)
       [,1]  [,2] [,3]  [,4]  [,5]  [,6]  [,7]  [,8]  [,9]
p     0.000 0.125 0.25 0.375 0.500 0.625 0.750 0.875 1.000
prior 0.001 0.001 0.95 0.008 0.008 0.008 0.008 0.008 0.008
post  0.000 0.000 0.73 0.034 0.078 0.094 0.055 0.009 0.000

自行编写一个函数计算离散型变量的后验概率

# 计算后验概率的函数
calculate_posterior <- function(p, prior, data) {
  likelihood <- dbinom(data[1], sum(data), p)
  unnormalized_posterior <- likelihood * prior
  posterior <- unnormalized_posterior / sum(unnormalized_posterior)
  return(posterior)
}

# 使用自定义函数计算后验概率
p <- c(0, 0.125, 0.25, 0.375, 0.500, 0.625, 0.750, 0.875, 1)
prior <- c(.001, .001, .950, .008, .008, .008, .008, .008, .008)
data <- c(6, 4)

post <- calculate_posterior(p, prior, data)
round(rbind(p, prior, post), 3)
       [,1]  [,2] [,3]  [,4]  [,5]  [,6]  [,7]  [,8]  [,9]
p     0.000 0.125 0.25 0.375 0.500 0.625 0.750 0.875 1.000
prior 0.001 0.001 0.95 0.008 0.008 0.008 0.008 0.008 0.008
post  0.000 0.000 0.73 0.034 0.078 0.094 0.055 0.009 0.000