割り付けるときと割り付けないとき

  • 昨日の続き
  • ごく簡単に。
  • 2人に限定
  • 2人が目の出方の違うサイコロを振った
  • 出た目の数を紙に書いて、胴元に提出した
  • 胴元が2人が提出した紙に順序を付けた
  • 胴元が1番をつけた紙を提出したのは、2人のうちどちらかを当てよう
  • 胴元が紙に書いてある数字を明かさないときには、2人のうちどちらが1番かは50:50
  • 胴元が1番をつけた紙に書いてある数字を明かすと、2人のどちらが1番かは、2人のそれぞれのサイコロがその数字を出す確率p1,p2に応じて、尤度比はp1/p2
  • 1番がどちらかの尤度比がp1/p2である今、2番がどちらかの尤度比はp2/p1
  • 胴元が2番をつけた紙に書いてある数字を明かしても、同様に1番・2番がどちらかについての尤度比は求まる
  • ここで、胴元が、1番・2番の両方の数字を明かすと、それぞれのサイコロで、1番の紙の数字を出す確率p1,p2、2番の紙の数字を出す確率q1,q2について、1番がどちらかの尤度比は(p1q2)/(p2q1)
  • ここで、「サイコロ」が1と2しか出ない(コインのようなもの、いかさまコイン)の場合にはq1=1-p1,q2=1-p2であって、(p1q2)/(p2q1)=(p1(1-p2))/((1-p1)p2)となる
  • この値は、p1>p2であるとき、必ずp1/p2<(p1(1-p2))/((1-p1)p2)という関係にあって、尤度比が上がることがわかる
  • ベルヌーイ試行をRでやって、確かめてみる
p1<-0.9
p2<-0.6

N<-100000
X1<-sample(0:1,N,prob=c(p1,1-p1),replace=TRUE)
X2<-sample(0:1,N,prob=c(p2,1-p2),replace=TRUE)

first<-sample(1:2,N,prob=c(0.5,0.5),replace=TRUE)

x.first<-rep(0,N)
X.sorted<-matrix(0,N,2)
X<-as.matrix(cbind(X1,X2))
for(i in 1:N){
	X.sorted[i,1]<-X[i,first[i]]
	if(first[i]==1){
		X.sorted[i,2]<-X[i,2]
	}else{
		X.sorted[i,2]<-X[i,1]
	}
}
selected.1<-which(X.sorted[,1]==0)
selected.1.2<-which(X.sorted[,1]==0 & X.sorted[,2]==1)
selected.first<-first[selected.1]
selected.firstsecond<-first[selected.1.2]
table(selected.first)
table(selected.firstsecond)

y.1<-c(length(which(selected.first==1)),length(which(selected.first==2)))
y.1.2<-c(length(which(selected.firstsecond==1)),length(which(selected.firstsecond==2)))

y.1
y.1.2

y.1[1]/y.1[2]
y.1.2[1]/y.1.2[2]