Simulate a game show

Rules

3 players
3 doors, prize is behind one of the doors
1st player chooses a door
If 1st player chooses the winning door, then game ends
If 1st player does not choose the winning door, then game continues
2nd player chooses a door
If 2nd player chooses the winning door, then game ends
If 2nd player does not choose the winning door, then game continues
3rd player opens remaining door

Simulation

library(checkpoint)
checkpoint("2019-04-01")
library(magrittr)
library(dplyr)
library(knitr)

S <- 15e6

Initialize test data. Simulation will simulate 1.5e+07 games.

doors <- LETTERS[1:3]
df <-
  expand.grid(games = S,
              s = seq(1, S)) %>%
  mutate(winningDoor = sample(doors, S, replace = TRUE)) %>%
  inner_join(expand.grid(s = seq(1, S),
                         round = seq(1, length(doors))))

## Joining, by = "s"

df %>%
  select(s, winningDoor) %>%
  unique() %>%
  group_by(winningDoor) %>%
  summarize(freq = n()) %>%
  mutate(prop = freq / sum(freq)) %>%
  kable()

winningDoor	freq	prop
A	4998205	0.3332137
B	5001267	0.3334178
C	5000528	0.3333685

Round 1

Player 1 has the option to choose any of the 3 doors. Their unconditional probability of winning is 1/3.

df1 <-
  df %>%
  filter(round == 1) %>%
  mutate(pick = sample(doors, S, replace = TRUE)) %>%
  mutate(isWin = case_when(pick == winningDoor ~ TRUE,
                           TRUE ~ FALSE))
df1 %>%
  group_by(round, isWin) %>%
  summarize(freq = n()) %>%
  mutate(prop = freq / sum(freq)) %>%
  kable()

round	isWin	freq	prop
1	FALSE	9997071	0.6664714
1	TRUE	5002929	0.3335286

Round 2

If Player 1 fails to choose the winning door, then the game simplifies to a choice of 2 doors for Player 2. Their unconditional probability of winning is 1/2.

doors <- LETTERS[1:2]
df2 <-
  df1 %>%
  filter(!isWin) %>%
  select(s) %>%
  inner_join(df) %>%
  filter(round == 2) %>%
  mutate(winningDoor = sample(doors, nrow(.), replace = TRUE),
         pick        = sample(doors, nrow(.), replace = TRUE)) %>%
  mutate(isWin = case_when(pick == winningDoor ~ TRUE,
                           TRUE ~ FALSE))

## Joining, by = "s"

df2 %>%
  group_by(round, isWin) %>%
  summarize(freq = n()) %>%
  mutate(prop = freq / sum(freq)) %>%
  kable()

round	isWin	freq	prop
2	FALSE	4999505	0.500097
2	TRUE	4997566	0.499903

Round 3

If both Players 1 and 2 fail to choose the winning door, then Player 3 has no choice and automatically wins.

df3 <-
  df2 %>%
  filter(!isWin) %>%
  select(s) %>%
  inner_join(df) %>%
  filter(round == 3) %>%
  mutate(isWin = TRUE)

## Joining, by = "s"

df3 %>%
  group_by(round, isWin) %>%
  summarize(freq = n()) %>%
  mutate(prop = freq / sum(freq)) %>%
  kable()

round	isWin	freq	prop
3	TRUE	4999505	1

Summarize

results <-
  df %>%
  left_join(df1 %>% select(s, round, isWin), by = c("s", "round")) %>%
  left_join(df2 %>% select(s, round, isWin), by = c("s", "round"), suffix = c("1", "2")) %>%
  mutate(isWin = coalesce(isWin1, isWin2)) %>%
  select(-c(isWin1, isWin2)) %>%
  left_join(df3 %>% select(s, round, isWin), by = c("s", "round"), suffix = c("12", "3")) %>%
  mutate(isWin = coalesce(isWin12, isWin3)) %>%
  select(-c(isWin12, isWin3))
results %>%
  group_by(games, round) %>%
  summarize(wins = sum(isWin, na.rm = TRUE)) %>%
  mutate(prop = wins / sum(wins)) %>%
  kable()

games	round	wins	prop
1.5e+07	1	5002929	0.3335286
1.5e+07	2	4997566	0.3331711
1.5e+07	3	4999505	0.3333003

Player 1 has an unconditional winning probability of $\frac{1}{3}$
Player 2 has a conditional winning probability of $\frac{2}{3} \times \frac{1}{2} = \frac{1}{3}$
Player 3 has a conditional winning probability of $1 - \frac{1}{3} - \frac{1}{3} = \frac{1}{3}$

sessionInfo()

## R version 3.5.3 (2019-03-11)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 17134)
## 
## Matrix products: default
## 
## locale:
## [1] LC_COLLATE=English_United States.1252 
## [2] LC_CTYPE=English_United States.1252   
## [3] LC_MONETARY=English_United States.1252
## [4] LC_NUMERIC=C                          
## [5] LC_TIME=English_United States.1252    
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] dplyr_0.8.0.1    magrittr_1.5     checkpoint_0.4.5 knitr_1.22      
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_1.0.1       crayon_1.3.4     assertthat_0.2.1 R6_2.4.0        
##  [5] evaluate_0.13    highr_0.8        pillar_1.3.1     rlang_0.3.3     
##  [9] stringi_1.4.3    tools_3.5.3      stringr_1.4.0    glue_1.3.1      
## [13] purrr_0.3.2      xfun_0.6         compiler_3.5.3   pkgconfig_2.0.2 
## [17] tidyselect_0.2.5 tibble_2.1.1

benjamin-chan/simulation.md