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
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
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)