2013-02-22

自分の決断の仕方

対戦ゲームをしているとする
自分と相手とはそれぞれ赤・青の札を１枚ずつ持っている
どちらを出すかを２人とも自分で決められる
同じ色が出たら自分の勝ちで、違う色が出たら相手の勝ち、と言うルールにする
もちろん、２人とも勝ち数を増やしたいと思っているものとしよう
自分は、自分が何色を出して、その結果、勝ったか負けたかだけを知りえるとする(札は「裁定者」のみが見られる『場』に出して、裁定者が勝ち負けを記録して、報告してくれる、みたいな感じ)
こんなゲームをやっているものと想定して、どんな展開になるかを想像して作ってみることにした
●は赤を出して勝ち、○は赤を出して負け、■は青を出して勝ち、□は青を出して負けとした

●●○○■○■■■□●●□●○○■■□□□●

この記号列は、「それらしく作ったもの」
これを解釈してみよう
全部で22回の勝負があって、トータル、12勝(黒が12個)10敗
赤を出したのが11回で6勝5敗、青を出したのも11回で6勝5敗
22回の勝負の前の段階で、勝負の情報はどうなっていたかと言うと
- 初回：赤0:0、青0:0
- 第2回：赤1:0、青0:0
- 同様に、(2:3,0:0),(2:4,0:0),(2:4,1:1),(2:5,1:1),(2:5,2:2),(2:5,3:3),(2:5,4:4),(2:5,4:5),(3:6,4:5),(4:7,4:5),(5:8,4:6),(5:9,4:6),(5:10,4:6),(5:10,4:6),(5:10,5:7),(5:10,6:8),(5:10,6:9),(5:10,6:10),(5:10,6:11),(6:11,6:11)
さて、こんな風に「それらしく作っている心のうち」はどうなっているのだろう？
相手が自分と同じような人で色々考えている、という想定で始めたが、少しその設定を変えてみる
- まず、第１の設定では、相手は、赤を出すか青を出すかはランダムに決めている。ただし、どちらかの色を高頻度に出しているかもしれなくて、その頻度は一定であるという場合
- 第２の設定では、相手は、実はずるをしていて、「私」が赤を出したときには、確率pで「私」に勝たせてくれて、「私」が青を出したときには、確率qで「私」に勝たせてくれているという場合
「私」の判断基準も２通り作ってみる
- 第(1)の設定では、次回の勝負までの情報を使って、赤・青どちらを出したらどれくらいの割合で勝ったかを計算しそれをr,bとしてr/(r+b)の割合で赤を出し、それ以外で青を出す、というような戦略としてみる
- 第(2)の設定では、次回の勝負までの情報を使って、赤を出した場合と青を出した場合のそれぞれでの、勝率の推定分布をベータ分布で予想してやる。そうすると、赤出しの場合の勝率の方が青出しの場合の勝率より高くなるか低くなるかの確率が出る。赤出しの方が勝率が高くなる確率が計算できたら、その割合で赤を出し、残りの割合で青を出し、どちらを出すかは(重みはつけるが、ランダムに出す。ただし、ベータ分布の厳密な計算はできないが、ベータ乱数は出せるものとして、赤出し有利・青出し有利の割合推定は、それほど多くない乱数で決するものとしてみる
相手のパターン１，２、私のパターン(1),(2)とで１−(1)、２−(1)、２−(2)の３通りでやってみる
私のパターン(2)は結構、「気持ち」に近そうだが…
これをやっている本当の「気持ち」は、治療法が２つある。１つ目の治療法では10人が治療されて7人が奏功、２つ目の治療法では5人が治療されて3人が奏功、というようなときに、どちらを選ぶか、ということと、そんな経験を積み上げて、もちろん、きちんとしたトライアルになっていないけれど、その情報を使うしかないときの、その「気持ち」のシミュレーション、の、つもり。
だたし、確率的選択は、「重み付けランダム割り付け」なので、受け入れられるかどうかというハードルもありそう
初めは試行錯誤するけれど、最終的には、「良い治療法」が選択されている？
ここでベータ分布を使っている→ベータ関数を使ってる、けれど、 $B(x,y)=\frac{\Gamma(x)\Gamma(y)}{\Gamma(x+y)}$ だし、組み合わせのお化けのようなもので、これをシナプスで説明できたり(神経系を用いた判断の場合)、化学受容体で説明できたり(化学走性の場合)すれば、比較的単純な仕組みといえるようだ。

p <- 0.9

n.iter <- 1000

z <- sample(0:1,n.iter,replace=TRUE,prob=c(p,1-p))
w <- rep(NA,n.iter)
w2 <- w
x <- y <- matrix(NA,n.iter,2)

x[1,] <- y[1,] <- rep(0,2)

for(i in 2:n.iter){
	x[i,] <- x[i-1,]
	y[i,] <- y[i-1,]
	tmpx <- (x[i,1]+1)/(sum(x[i,])+2)
	tmpy <- (y[i,1]+1)/(sum(y[i,])+2)
	print(tmpx)
	print(tmpy)
	if(tmpx/(tmpx+tmpy) > runif(1)){
		w[i] <- 0
		if(z[i]==0){
			x[i,1] <- x[i,1]+1
			w2[i] <- 0
		}else{
			x[i,2] <- x[i,2]+1
			w2[i] <- 1
		}
	}else{
		w[i] <- 1
		if(z[i]==1){
			y[i,1] <- y[i,1]+1
			w2[i] <- 0
		}else{
			y[i,2] <- y[i,2]+1
			w2[i] <- 1
		}
	}
}
print(w)
print(w2)

matplot(cbind(x,y),type="l")

x[,1]+y[,1]

##############
p <- 0.5
q <- 0.6
n.iter <- 1000

z <- sample(0:1,n.iter,replace=TRUE,prob=c(p,1-p))
w <- rep(NA,n.iter)
w2 <- w
x <- y <- matrix(NA,n.iter,2)

x[1,] <- y[1,] <- rep(0,2)

for(i in 2:n.iter){
	x[i,] <- x[i-1,]
	y[i,] <- y[i-1,]
	tmpx <- (x[i,1]+1)/(sum(x[i,])+2)
	tmpy <- (y[i,1]+1)/(sum(y[i,])+2)
	print(tmpx)
	print(tmpy)
	if(tmpx/(tmpx+tmpy) > runif(1)){
		w[i] <- 0
		if(runif(1) < p){
			x[i,1] <- x[i,1] + 1
			w2[i] <- 0
		}else{
			x[i,2] <- x[i,2] + 1
			w2[i] <- 1
		}
	}else{
		w[i] <- 1
		if(runif(1) < q){
			y[i,1] <- y[i,1] + 1
			w2[i] <- 0
		}else{
			y[i,2] <- y[i,2] + 1
			w2[i] <- 1
		}
	}
}
print(w)
print(w2)

matplot(cbind(x,y),type="l")

x[,1]+y[,1]


##############
p <- 0.5
q <- 0.6
n.iter <- 10000

z <- sample(0:1,n.iter,replace=TRUE,prob=c(p,1-p))
w <- rep(NA,n.iter)
w2 <- w
x <- y <- matrix(NA,n.iter,2)

x[1,] <- y[1,] <- rep(0,2)
N <- 10
for(i in 2:n.iter){
	x[i,] <- x[i-1,]
	y[i,] <- y[i-1,]
	#tmpx <- (x[i,1]+1)/(sum(x[i,])+2)
	#tmpy <- (y[i,1]+1)/(sum(y[i,])+2)
	#print(tmpx)
	#print(tmpy)
	rx <- rbeta(N,x[i,1]+1,x[i,2]+1)
	ry <- rbeta(N,y[i,1]+1,y[i,2]+1)
	if(length(which(rx>ry))/N >runif(1)){
	#if(tmpx/(tmpx+tmpy) > runif(1)){
		w[i] <- 0
		if(runif(1) < p){
			x[i,1] <- x[i,1] + 1
			w2[i] <- 0
		}else{
			x[i,2] <- x[i,2] + 1
			w2[i] <- 1
		}
	}else{
		w[i] <- 1
		if(runif(1) < q){
			y[i,1] <- y[i,1] + 1
			w2[i] <- 0
		}else{
			y[i,2] <- y[i,2] + 1
			w2[i] <- 1
		}
	}
}
print(w)
print(w2)

matplot(cbind(x,y),type="l")

x[,1]+y[,1]