- これは下書き
- 昨日の話題の脇道
- 要因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(-)で同じときには
- なので
- として
- になるようなを考えてやればよい
- ここでと2つの変数があるはX(+),X(-)で生起確率が同じであるという仮説の「事後確率」に当たる
- 「空間」で考えれば、2次元正方形空間の対角線部分に相当する1次元線分空間の積分
- 2つの確率密度関数は方や1次元、方や2次元なので、それが積分してある値(スカラー)になる、とは言ってもちょっと面倒くさい
- 『どのくらいの割合でおきるか』と考えると土俵が同じになるので、そうしてみよう
- の2点を対角点とする微小正方形の生起確率と
- の2点を両端とする線分〜の2点を対角点とする微小正方形の生起確率との多寡を比べることにしよう
- 前者は
- 後者は
- これをもとにの確率をX(+),X(-)が違う・同じの2仮説別に計算すると
- これを数値計算風にするべく、離散的に計算するなら
- 事前確率のことを考えると、X(+),X(-)が異なるという仮説では、すべての微小正方形が等確率であると考えていたなら、その確率は。同様にX(+),X(-)で等しいという仮説では、すべての微小正方形がとなる。
- となって、結局、X(+)の際にそうていするべき、事後の生起確率はこの事前の生起確率を加味して
- +
- なお、X(+),X(-)に異なる生起確率を想定するのがよいか、想定しないのがよいか、というのを仮説検定するのなら、それぞれのモデルでの最尤推定尤度を比較して、自由度の差(ここでは1)で検定する、ということになるが、今は、検定にはまったく興味がないので、それは放っておく
- 上のやり方と別の方法でもできそうだが、その方法と上の方法で値が合わない…どっちかが間違っている…
men <- c(1,5)*5
women <- c(4,2)
both <- men + women
p <- seq(from=0,to=1,length=100)
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)
par(mfcol=c(2,2))
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 <- q.men * q.women
qq.sep <- outer(q.men,q.women,"*")
qq.both <- diag(q.both)
pre.p <- c(0.5,0.5)
qq.sep.st <- qq.sep/((length(p)-1)^2)
qq.both.st <- qq.both/(length(p)-1)
image(qq.sep.st+qq.both.st)
contour(qq.sep.st+qq.both.st,add=TRUE)
a <- apply(qq.sep.st,2,sum)
b <- apply(qq.both.st,2,sum)
ab <- a+b
q.women.2 <- ab/sum(ab)
p.men.2 <- p.men/sum(p.men)
p.women.2 <- p.women/sum(p.women)
p.both.2 <- p.both/sum(p.both)
matplot(p,cbind(p.men.2,p.women.2,p.both.2,q.women.2),type="l")
legend(max(p)*0.6,max(p.men.2,p.women.2,p.both.2,q.women.2)*0.8,c("men","women","both","combination"),lty=1:4,col=1:4)
q.women.3 <- p.women*pre.p[1]+p.both*pre.p[2]
matplot(p,cbind(q.women.2/sum(q.women.2),q.women.3/sum(q.women.3)),type="l")
legend(max(p)*0.6,max(q.women.2/sum(q.women.2),q.women.3/sum(q.women.3))*0.9,c("combination","linear sum"),lty=1:2,col=1:2)
par(mfcol=c(1,1))