Solution to fivethirtyeight Riddler’s puzzle, Loteria (Oct 21, 2022).

A thousand people are playing Lotería, also known as Mexican bingo. The game consists of a deck of 54 cards, each with a unique picture. Each player has a board with 16 of the 54 pictures, arranged in a 4-by-4 grid. The boards are randomly generated, such that each board has 16 distinct pictures that are equally likely to be any of the 54.

During the game, one card from the deck is drawn at a time, and anyone whose board includes that card’s picture marks it on their board. A player wins by marking four pictures that form one of four patterns, as exemplified below: any entire row, any entire column, the four corners of the grid and any 2-by-2 square.

After the fourth card has been drawn, there are no winners. What is the probability that there will be exactly one winner when the fifth card is drawn?

Monte Carlo Simulation

I am parallelizing this code to efficiently handle the large number of trials required for the simulation.

library(parallel)

set.seed(123)

winning_arrangements <- list(
  c(1, 2, 3, 4), c(5, 6, 7, 8), c(9, 10, 11, 12), c(13, 14, 15, 16), # 4 row
  c(1, 5, 9, 13), c(2, 6, 10, 14), c(3, 7, 11, 15), c(4, 8, 12, 16), # 4 column
  c(1, 2, 5, 6), c(2, 3, 6, 7), c(3, 4, 7, 8), # 2x2 square first row
  c(5, 6, 9, 10), c(6, 7, 10, 11), c(7, 8, 11, 12), # 2x2 square second row
  c(9, 10, 13, 14), c(10, 11, 14, 15), c(11, 12, 15, 16), # 2x2 square third row
  c(1, 4, 13, 16) # 4 corners
)

sim_trials <- 1e8
num_cores <- detectCores() - 1
chunk_size <- sim_trials / num_cores
card_set <- 1:54
board <- sample(card_set, 16)

iswinning <- function(matches) {
  for (idx in winning_arrangements) {
    if (all(matches[idx])) {
      return(TRUE)
    }
  }
  return(FALSE)
}

simulate_chunk <- function(chunk_size) {
  winners <- 0
  num_trials <- 0

  for (iter in 1:chunk_size) {
    sample_five <- sample(card_set, 5)

    match_first_four <- board %in% sample_five[1:4]
    match_all <- board %in% sample_five

    if (!iswinning(match_first_four)) {
      num_trials <- num_trials + 1
      if (iswinning(match_all)) {
        winners <- winners + 1
      }
    }
  }

  return(list(winners = winners, num_trials = num_trials))
}

results <- mclapply(rep(chunk_size, num_cores), simulate_chunk, mc.cores = num_cores)

total_winners <- sum(sapply(results, `[[`, "winners"))
total_trials <- sum(sapply(results, `[[`, "num_trials"))

pwin <- total_winners / total_trials
se <- sqrt(pwin * (1 - pwin) / total_trials)

formatted_output <- str_glue("{sprintf('%.7f', pwin)} +/- {sprintf('%.7f', 1.96 * se)}")
formatted_output
## 0.0002263 +/- 0.0000029

Answer

Probability of the fifth card wins given the fourth card did not win is 0.0002263 +/- 0.0000029

We can verify this solution through an analytical calculation using Bayes theorem,

\[ \mathbf{P}(A) = 1-\frac{18}{\binom{n}{4}} \approx 0.9999431 \]

\[ \mathbf{P}(B) = 1-\frac{18(n-4)}{\binom{n}{5}} \approx 0.9997154 \]

\[ \begin{align} \mathbf{P}(\bar B \mid A) &= 1-\mathbf{P}(B\mid A) \\ &= 1-\frac{\mathbf{P}(A\cap B)}{\mathbf{P}(A)} = 1-\frac{\mathbf{P}(A) \cdot \mathbf{P}(B)}{\mathbf{P}(A)} ,\text{ } B \subseteq A\\\ &= 1-\frac{\mathbf{P}(B)}{\mathbf{P}(A)} \\ &= \frac{0.9999431}{0.9997154} \approx 0.0002277 \end{align} \]