Problem 1 a.E(Y) = a/a+b V(Y) = ab/(a+b)^2(a+b+1) \(E(Y)=\frac{a}{a+b}\implies0.5=\frac{a}{a+b}\implies0.5(a+b)=a\implies0.5a+0.5b=a\implies0.5b=a-0.5a\)

Since \(a=b\).

\(\frac{a^2}{(2a)^2(2a+1)}=0.15^2\implies\frac{a^2}{(8a^3+4a^2)}=0.0225\implies\frac{a^2}{a^2(8a+4)}=0.0225\implies\frac{1}{0.0225}=8a+4\implies\frac{1}{0.0225}-4=8a \implies 8a=\frac{364}{9}\implies a=\frac{364\times1}{9\times8}\approx5.06\)

Thus, \(a=b=5.06\).

mean= 0.5 # mean of beta
variance = 0.0225 # variance of beta
betaparameters <- function(mean,variance){
  a <-((1-0.5)/0.0225-1/0.5)*0.5^2
  b <- a*(1/0.5-1)
  return(params=list(a=a,b=b))}
betaparameters(a,b)
## $a
## [1] 5.055556
## 
## $b
## [1] 5.055556
  1. beta(26.06 52.06)
a= 5.06
b= 5.06
s=21
f=47
prior <- c(a,b)
like <-c(s,f)
post <- prior+like
post
## [1] 26.06 52.06
  1. Plot both the prior and posterior distributions
p<- seq(0,1,length=1000)
a= 5.06
b= 5.06
s=21
f=47
prior <- dbeta(p,a,b)
like <- dbeta(p, s+1, f+1)
post <- dbeta(p, a+s, b+f)
plot(p, post, type = "l", ylab = "Density", lty=2, lwd=3)
lines(p, prior, lty=3, lwd=3)
legend(.7, 4, c("Prior","Posterior"), lty=c(3,2), lwd=c(3,3))

d.Construct and interpret a 90% credible interval for p. There is 90% chance or probability that the true proportion of students who support the current president is between 0.249 and 0.423.

ProbBayes::beta_interval(0.9,c(26.06,52.06))

Problem 2 a. Find a and b. a=5.1 b=5.1

library(ProbBayes)
## Loading required package: LearnBayes
## Loading required package: ggplot2
## Loading required package: gridExtra
## Loading required package: shiny
beta.select(list(x=0.393,p=0.25),
            list(x=0.607,p=0.75))
## [1] 5.1 5.1
p<- seq(0,1,length=1000)
a= 5.1
b= 5.1
s=21
f=47
prior <- c(a,b)
like <-c(s,f)
post <- prior+like
post
## [1] 26.1 52.1
prior <- dbeta(p,a,b)
like <- dbeta(p, s+1, f+1)
post <- dbeta(p, a+s, b+f)
plot(p, post, type = "l", ylab = "Density", lty=2, lwd=3)
legend(.7, 4, c("Posterior"), lty=2, lwd=3)

c.We will going to reject Sophie’s claim that at least 85% of the students support the current president as \(P(p\ge0.85)\) = 0.

beta_area(lo=0.85,hi=1, shape_par=c(s+a,f+b))

d. 100 sample

pred_p_sim <- rbeta(100, 26.1, 52.1)
pred_y_sim <- rbinom(100, 21, pred_p_sim)
print(mean(pred_y_sim))
## [1] 7.2
sim.p <- rbeta(100,26.1, 52.1)
sim.y <- rbinom(100, 21, sim.p)
hist(sim.y, xlab = "Simulated Y", main = " ")
abline(v = 7.16, col = "red", lwd = 3, lty = 2)

  1. Yes, it is approximately equal to the prediction in d which is more or less than 7(it varies). The posterior distribution shows the value of slightly more than 7.