- 昨日の話題の脇道
- 要因Xのありなしとともに、ある事象Yの生起の有無の集計をとったら
|
Y(+) |
Y(-) |
X(+)女 |
a |
b |
X(-)男 |
c |
d |
- だったという
- さて。新しいサンプルがX(+)だったときに、Yの生起確率に何を思うのか…
- X(+),X(-)で生起確率が違うのなら、(a,b)を用いてベータ分布
- X(+),X(-)で生起確率が同じなら、(a+c,b+d)を用いてベータ分布
- 問題は、X(+),X(-)で生起確率が同じなのか違うのかについて判然としないこと
- 判然とはしないけれど、事前確率として、X(+),X(-)で生起確率が同じ・違うが0.5,0.5だという「気持ち」はあるとする、『ベイズ』でやっているから
- X(+),X(-)で違うときは
- という要因別の生起確率の組が作る2次元正方形空間の座標の尤度(!)をとしておくと
- となる
- X(+)の生起確率だけが気になれば、ただのになるのは、2次元正方形空間をX(-)について積分してとしてもよいし、だよ考えなくても、ということにしてもよい
- X(+),X(-)で同じときには
- なので
- として
- になるようなを考えてやればよい
- 実際、であり、であるので、
- が任意のについて等しい値であって、それはベータ分布の定義式から
- で求められる
men <- c(20,4)
women <- c(2,4)
both <- men + women
p <- seq(from=0,to=1,length=50)
p <- p[-length(p)]
p <- p[-1]
p.men <- dbeta(p,men[1]+1,men[2]+1)
p.women <- dbeta(p,women[1]+1,women[2]+1)
p.both <- dbeta(p,both[1]+1,both[2]+1)
q.men <- exp(lgamma(sum(men)+1)-sum(lgamma(men+1))+men[1]*log(p)+men[2]*log(1-p))
q.women <- exp(lgamma(sum(women)+1)-sum(lgamma(women+1))+women[1]*log(p)+women[2]*log(1-p))
q.both <- p.men * p.women
qq.both <- diag(q.both)
qq.sep <- outer(p.men,p.women,"*")
my.k <- (q.both/p.both)
my.k
my.k.2 <- exp(-(lgamma(sum(both)+2)+sum(lgamma(c(men,women)+1)))+sum(lgamma(c(sum(men),sum(women))+2)+lgamma(both+1)))
my.k.2
pre.p <- c(0.5,0.5)
p.men.pre <- dbeta(p,1,1)
p.women.pre <- dbeta(p,1,1)
p.both.pre <- dbeta(p,1,1)
qq.both.pre <- diag(p.men.pre*p.women.pre)
qq.sep.pre <- outer(p.men.pre,p.women.pre,"*")
post.p <- pre.p * c(1,my.k.2)
post.p <- post.p/sum(post.p)
est.women <- p.women * post.p[1] + p.both * post.p[2]
est.women.pre <- p.women.pre * pre.p[1] + p.both.pre * pre.p[2]
par(mfcol=c(2,2))
matplot(p,cbind(est.women.pre,est.women),type="l",main="女予測、事前事後")
matplot(p,cbind(p.men.pre,p.women.pre,p.both.pre,est.women.pre),type="l",main="事前")
matplot(p,cbind(p.men,p.women,p.both,est.women),type="l",main="事後")
legend(max(p)*0.6,max(p.men)*0.9,c("men","women","both","est-women"),lty=1:4,col=1:4)
par(mfcol=c(1,1))