モンティ・ホール問題

作成・改訂

June 17, 2022

ゲームの説明

 統計学の教科書でしばしば紹介される例の一つがモンティ・ホール問題である。これはアメリカのテレビ番組の中のゲームであり、様々な論争まで行われてきた。

ゲームのルールは簡単

  • 3つのドアがあり、1つのドアの後ろに商品がある。
  • 参加者はドアを選択する。
  • 司会者(モンティ)が残りのドア2つの中で商品がないドアを開けて中身を見せる。
  • ここで参加者はドアの選択を変える機会が与えられる。

 直観的に考えて、司会者が外れのドアを1つ教えてくれたなら、残りの2つのドアの1つに絶対に商品がある。そのうち一つは自分が既に選んだドア。どう見ても当たる確率は半々であって、変えても、変えなくても当たる確率は同じだと思われる。

 しかし、結果からいうと選択を変えた方が変えなかった場合より当たる確率が2倍である。これは条件付き確率とベイズの定理を用いることで数学的に説明できる。興味のある人はWikipediaの項目を参照。この問題を巡る論争とかも紹介されていてなかなか面白い。


シミュレーションの設定

  • 商品があるドアを決める(atari
  • 参加者が選択するドアを決める(selection
    • もし、atariselectionが一致すると
      • 既に参加者は当たりを選んでいるので、選択を変えると商品がもらえなくなる(if_switch = 0
      • 既に参加者は当たりを選んでいるので、選択を変えなかったら商品がもらえる(if_not_switch = 1
    • 一方、atariselectionが不一致すると
      • 司会者は参加者が選んだドア(ハズレ)を除く二つのドアの中でハズレのドアを教えてくれる。つまり、残りの一つのドアに商品がある。
      • この場合、選択を変えると商品がもらえる(if_switch = 1
      • もし、選択を変えなかったら商品はもらえない(if_not_switch = 0)
  • これをN回やってみて、選択を変えた場合の当たり率を確認する。

シミュレーションのRコード

#シミュレーションの関数の定義
MH_sim <- function (trials = 1000) {
    #結果を返す空のデータフレームの作成
    result_df <- data.frame(id            = rep(NA, trials),
                            atari         = rep(NA, trials),
                            selection     = rep(NA, trials),
                            if_switch     = rep(NA, trials),
                            if_not_switch = rep(NA, trials))
    
    for(i in 1:trials){
        atari     <- sample(1:3, 1) #当たりのドア番号
        selection <- sample(1:3, 1) #参加者が選んだドア番号
        
        if (atari == selection) { 
            #もし参加者が当たりのドアを選んでいたら
            if_switch     <- 0 #選択を変えると商品がもらえない
            if_not.switch <- 1 #選択を変えないなら商品がもらえる
        } else { 
            #参加者がハズレのドアを選んでいたら
            if_switch     <- 1 #選択を変えたら商品がもらえる
            if_not.switch <- 0 #選択を変えないと商品がもらえない
        }
        
        #結果をデータフレームに保存する
        result_df[i,] <- c(i,
                           atari,
                           selection,
                           if_switch,
                           if_not.switch)
    }
    
    return(result_df)  #結果を返す
}

シミュレーションの実行

MH_Result <- MH_sim(trials = 10000)

table(MH_Result$if_switch)

   0    1 
3335 6665 

 1万回のシミュレーションの結果、選択肢を変えた場合の当たり率は66.65%、変えなかった場合は33.35%であり、ほぼ2倍になることが分かる。