モンティ・ホール問題(2)

ドアの選び方であなたの賢さが分かる!?——モンティ・ホール問題とは

 あなたはテレビ番組で商品当てゲームに挑戦しています。あなたの前には3枚のドア

があり、1枚のドアの先にはあなたが欲しい物が置いてあり（アタリ）、残る2枚のド

アの先には何も置いてありません（ハズレ）。もちろん、どのドアがアタリなのかは

あなたから見えません。

 

　あなたは、まず3枚のドアからアタリだと思うドアを1枚選びます。すると、アタリ

のドアを知っている番組司会者が、あなたが選ばなかった2つのドアのうち、ハズレ

のドアを開けて（2つのドアがどちらもハズレの時はコインを投げて開けるドアを決

めます）、そのドアがハズレであることを示します。そして、司会者はあなたに問い

かけます。

 

　「開いていないドアは2枚になりました。あなたには、もう一度ドアを選び直す

チャンスをあげましょう。始めに選んだドアのままで良いですか？ それとも、もう1

枚のドアに変更しますか？」

●練習に Haskell でシミュレーションしてみました。

import Array
import Random
 
data Symbol = Car | Goat deriving (Show, Read, Eq)
 
data Door = Door { present :: Symbol, player_open :: Bool,
                   hint ::Bool, new_open :: Bool}
                   deriving (Eq, Read, Show)
 
data Doors = Doors { doors :: Array Integer Door} deriving (Eq, Read, Show)
 
 
d = Doors { doors = listArray (0,2) (initDoors 3 [])}
                    where
                      initDoors :: (Num t) => t -> [Door] -> [Door]
                      initDoors 0 xs = xs
                      initDoors n xs = (makeDoor Goat False False False):(initDoors (n-1) xs)
                        where
                          makeDoor :: Symbol -> Bool -> Bool -> Bool -> Door
                          makeDoor p open h n = Door { present=p, 
                                                       player_open = open, 
                                                       hint = h,
                                                       new_open=n }
                      
-- 配列要素 pos のドアにプレゼントの有無、プレーヤ選択の有無
-- ホストのヒントの有無、プレーヤ最終選択の有無を設定する。
 setDoors :: Symbol -> Bool -> Bool -> Bool -> Integer -> Doors -> Doors
 setDoors pre op  h  n pos dr  = Doors { 
                                    doors = (doors dr) // 
                                              [(pos, Door { present     = pre , 
                                                            player_open = op,
                                                            hint        = h, 
                                                            new_open    = n })] }
getItem :: (Door -> t) -> Integer -> Doors -> t
getItem name pos dr = name ((doors dr ) ! pos)
 
 
-- 当たっているかどうか全部のドアをチェック。
checkWin _ 3 _ win = win
checkWin name n dr win = checkWin name (n+1) dr 
                             (win || ((getItem present n dr)==Car &&
                                     (getItem name n dr)))
 
-- ホストは0〜2の乱数によりプレゼントを設定
hostSetPresent :: Doors -> IO Doors
hostSetPresent d = do 
                   n <- getStdRandom (randomR (0,2))
                   return $ setPresent n d
                     where
                       setPresent :: Integer -> Doors -> Doors
                       setPresent pos dr = setDoors Car 
                                                 (getItem player_open pos dr)
                                                 (getItem hint        pos dr)
                                                 (getItem new_open    pos dr) pos dr
                   
-- プレーヤは0〜2の乱数により予想を設定
playerMark :: Doors -> IO Doors
playerMark d = do n <- getStdRandom (randomR (0,2))
                  return $ mark n d
                    where
                      mark :: Integer -> Doors -> Doors                                 
                      mark pos dr = setDoors (getItem present  pos dr)
                                             True
                                             (getItem hint     pos dr)
                                             (getItem new_open pos dr) pos dr
 
-- 当たっていたので乱数によりどちらかのヤギを開ける。
openGoatByRnadom :: Doors -> IO Doors
openGoatByRnadom d = do
                 n <- getStdRandom (randomR (0,1))
                 return (openGoat 2 1 n d)
 
-- n 番目のヤギを開ける。
openGoat :: Integer -> Integer -> Integer -> Doors -> Doors
openGoat (-1) _       _ d = d
openGoat pos  goatCnt n d = 
     if (getItem present pos d) == Goat
        then
          if goatCnt == n 
            -- n番目のヤギなので、
            -- ヒントにあける情報が True で他の情報が同じドアを作って返す。
            then setHint pos d
            -- ヤギだが、n番目でないとき、
            -- 位置とヤギカウンタを更新して再帰。
            else (openGoat (pos-1) (goatCnt-1) n d)
        -- 車のとき、位置を更新して再帰。
        else (openGoat (pos-1) goatCnt n  d)
 
-- はずれなので選ばれていないヤギを開ける。
openGoatNotChosen :: Integer -> Doors -> Doors
openGoatNotChosen (-1) d = d
openGoatNotChosen pos  d = 
     if (getItem present pos d) == Goat && (getItem player_open pos d) == False
            then setHint pos d
            else openGoatNotChosen (pos-1) d
 
-- ヒントにあける情報が True で他の情報が同じドアを作って返す。
setHint :: Integer -> Doors -> Doors            
setHint pos d = setDoors (getItem present  pos d)
                         (getItem player_open pos d)
                         True
                         (getItem new_open pos d) pos d
 
-- 当たっていれば乱数によりどちらかのヤギを開ける。
-- はずれのときは、選ばれていない方のヤギを開ける。
hosotSetHint d = if (checkWin player_open 0 d False)
                    then openGoatByRnadom  d
                    else return (openGoatNotChosen 2 d)
 
-- もう1つの閉じているドアに変更する
playerAnotherMark :: Integer -> Doors -> Doors
playerAnotherMark (-1) d = d
playerAnotherMark pos  d = 
     -- 最初に選択したものでも、ホストが開いたものでもないものにマーク
     if (getItem player_open pos d) == False && (getItem hint pos d) == False
            then setDoors (getItem present  pos d)
                          (getItem player_open pos d)
                          (getItem hint pos d)
                          True pos d
            else playerAnotherMark (pos-1) d
 
-- 選びなおさない場合のゲーム
exec :: Doors -> IO Bool
exec d = do
       d2 <- hostSetPresent d
       d3 <- playerMark d2
       return $ checkWin player_open 0 d3 False
 
-- ドアを変更する場合のゲーム
exec2 d = do
       d2 <- hostSetPresent d
       d3 <- playerMark d2
       d4 <- hosotSetHint d3
       let d5 = playerAnotherMark 2 d4
       return $ checkWin new_open 0 d5 False
 
-- exeゲームをn回実行して車を取得した回数を返す。
winCount 0 _   _ cnt = return $ cnt
winCount n exe d cnt = do
                  flag <- exe d                   
                  winCount (n-1) exe d (ifCnt cnt flag)
                    where
                      ifCnt c f = if f then (c+1) else c

始めに選んだドアのままのゲームを10000回やって当たる回数。

 Prelude> :load MontyHallProblem.hs

 [1 of 1] Compiling Main             ( MontyHallProblem.hs, interpreted )

 Ok, modules loaded: Main.

 *Main> winCount 10000 exec d 0

 3374

もう1枚のドアに変更するゲームを10000回やって当たる回数。

 *Main> winCount 10000 exec2 d 0

 6653