ベイズの定理を使って「オオカミ少年」のシミュレーションをしてみた
松原望「意思決定の基礎」に、オオカミ少年が嘘つきであるという確信度の変化をベイズの定理を使って説明している章がある。おもしろそうだったので、この話をR言語を使ってシミュレーションしてみた。
この話は、「オオカミが来た!」という宣言が「嘘であった」()、「本当だった」()とし、元々「この少年が嘘つきである」とする確信度をとしたとき、嘘が続いたり、嘘と本当が交互に表れたりした時に、「この少年は嘘つきだ!」という確信度がどのように変化するかというシミュレーションである。
準備としては、最初の確信度は1/2であるとする。つまり半信半疑であるとする。さらに下表のように、この少年が嘘つきなら、本当の事を言う確率はであり、正直ものならば、嘘をつく確率はであるとする。
嘘であった | 本当だった | |
---|---|---|
この少年が嘘つきである | 3/4 | 1/4 |
この少年は正直者である | 1/4 | 3/4 |
この時、最初に少年が「オオカミが来た!」と言った宣言が「嘘だった」とすると、元々この少年が嘘つきである確率は
ランダムにデータを発生させて、この確率がどのように変化するかを見たのが左の図である。そして、そのRコードが以下である。
#----------------------------------- # 狼少年シミュレーション #----------------------------------- # 判断確率のデータを与える(これは当初から与えるデータ) # # 嘘だった(b1) 本当だった(b2) # ┌──────┬──────┐ # 嘘つき(t1)│ 3/4 │ 1/4 │ # ├──────┼──────┤ # 正直 (t2) │ 1/4 │ 3/4 │ # └──────┴──────┘ Pb1t1 <- 3/4 #嘘つきで、実際に嘘ついた確率 Pb2t1 <- 1/4 #嘘つきなのに、実際は本当の事を言った確率(つまり間違い) Pb2t2 <- 3/4 #正直者で、実際に本当の事を言った確率 Pb1t2 <- 1/4 #正直者なのに、実際は嘘ついた確率(つまり間違い) #シュミレーション回数 rep_n <- 50 # 嘘つきであると思う確信度を表す数値 dgree of belief dob <- 1/2 # rep_n回数分の事象データを発生させる # 1:嘘だった(b1) 2:本当だった(b2) # 3回に2回は嘘をつくもの(prob=c(2,1))としてデータを発生させている。 evnt <- sample(1:2,rep_n,rep=T,prob=c(2,1)) #事象毎に確信度を変えながら計算していく for ( i in 1:rep_n){ if (evnt[i] == 1) { dob[i+1] <- (Pb1t1 * dob[i] ) / (Pb1t1 * dob[i] + Pb1t2 * (1-dob[i])) } else { dob[i+1] <- (Pb2t1 * dob[i]) / (Pb2t1 * dob[i] + Pb2t2 * (1-dob[i])) } } plot(dob,type="l",ylim=c(0,1))
10回程度で確信度が1、つまり「完全にこの少年は嘘つきだ!」という結論になっている。しかし、何度も繰り返してみると、結構振幅が発生する場合もある。つまり「本当だった」という事象が続いた場合である。また、一度確信度が上がると、なかなか下がらない傾向もみえる。