Lecture 6

HW 2, Question 2

• There are \(a\) boxes, and slips of paper with the numbers \(1,...,a\). The slips of paper are randomly added to the boxes.
• Each player \(i = 1,...,a\) is going to try to find their slip of paper (the one with their number)
• Each player randomly selects \(a/2\) boxes to open
• What is the probability that all players find their slip of paper when opening the boxes?

Tips on where to start

• There are \(a\) boxes, and slips of paper with the numbers \(1,...,a\). The slips of paper are randomly added to the boxes.
• Each player \(i = 1,...,a\) is going to try to find their slip of paper (the one with their number)
• Each player randomly selects \(a/2\) boxes to open
• What is the probability that all players find their slip of paper when opening the boxes?

Making a plan

Imagine we were doing this with real people. What would we do?

Step 1: create the slips of paper

a <- 10
slips <- 1:a

Step 2: randomly assign the slips to boxes

a <- 10
slips <- 1:a

Question: How do I randomly shuffle the entries in a vector?

Step 2: randomly assign the slips to boxes

a <- 10
slips <- 1:a
boxes <- sample(slips, a, replace=F)
boxes

 [1]  7  5  1  6  3  8  9  4  2 10

Question: What does boxes[i] represent?

Step 3: a player randomly chooses boxes

a <- 10
slips <- 1:a
boxes <- sample(slips, a, replace=F)

Question: how should we randomly select which boxes to open?

Step 3: a player randomly chooses boxes

a <- 10
slips <- 1:a
boxes <- sample(slips, a, replace=F)

opened_boxes <- sample(1:a, a/2, replace = F)
opened_boxes

[1] 9 6 4 1 5

Question: how do we see which slips of paper were in these boxes?

Step 3: a player randomly chooses boxes

a <- 10
slips <- 1:a
boxes <- sample(slips, a, replace=F)
opened_boxes <- sample(1:a, a/2, replace = F)

boxes[opened_boxes]

[1] 2 8 6 7 3

Step 4: check if players number is in the opened boxes

Suppose Player 1 has opened the boxes:

a <- 10
slips <- 1:a
boxes <- sample(slips, a, replace=F)
opened_boxes <- sample(1:a, a/2, replace = F)

boxes[opened_boxes]

[1] 2 8 6 7 3

1 %in% boxes[opened_boxes]

[1] FALSE

Step 4: repeat for all the players

a <- 10
slips <- 1:a
boxes <- sample(slips, a, replace=F)
opened_boxes <- sample(1:a, a/2, replace = F)
1 %in% boxes[opened_boxes]

Question: How do I repeat this process for all \(a\) players?

Step 4: repeat for all the players

a <- 10
slips <- 1:a
boxes <- sample(slips, a, replace=F)

for(player in 1:a){
  opened_boxes <- sample(1:a, a/2, replace = F)
  player %in% boxes[opened_boxes]
}

Question: How do we check whether all players saw their number?

Step 4: repeat for all the players

a <- 10
slips <- 1:a
boxes <- sample(slips, a, replace=F)
player_results <- rep(NA, a)

for(player in 1:a){
  opened_boxes <- sample(1:a, a/2, replace = F)
  player_results[player] <- player %in% boxes[opened_boxes]
}
player_results

 [1]  TRUE  TRUE FALSE  TRUE  TRUE  TRUE  TRUE FALSE FALSE  TRUE

sum(player_results) == a

[1] FALSE

Question: How do we repeat this code many times to estimate a probability?

Step 5: repeat the whole game many times

set.seed(27)
a <- 10
slips <- 1:a
ngames <- 1000
game_results <- rep(NA, ngames)

for(i in 1:ngames){
  boxes <- sample(slips, a, replace=F)
  player_results <- rep(NA, a)
  for(player in 1:a){
    opened_boxes <- sample(1:a, a/2, replace = F)
    player_results[player] <- player %in% boxes[opened_boxes]
  }
  game_results[i] <- sum(player_results) == a
}

mean(game_results)

[1] 0.002

HW 2, Question 3: modifying the game

• Each slip is labeled \(1,...,a\) and randomly colored red or blue
• Each player \(i = 1,...,a\) is going to try to find their slip of paper (the one with their number)
• Each player randomly selects \(a/2\) boxes to open
• If the player does not see their slip, they randomly guess a color
• What is the probability that all players correctly announce their color?

Activity

Work with a neighbor to discuss how we could modify the code from Question 2 for this new scenario.

HW 2, Question 3

set.seed(27)
a <- 10
slips <- 1:a
ngames <- 1000
game_results <- rep(NA, ngames)

for(i in 1:ngames){
  boxes <- sample(slips, a, replace=F)
  player_results <- rep(NA, a)
  for(player in 1:a){
    opened_boxes <- sample(1:a, a/2, replace = F)
    player_results[player] <- player %in% boxes[opened_boxes]
  }
  game_results[i] <- sum(player_results) == a
}

mean(game_results)

Question: What needs to change?

Modifying the logic

• Randomly assign a color to each slip
• Store whether each player correctly identifies their color
• If a player sees their slip, do they also see their color?

Modifying the logic

• Randomly assign a color to each slip
• Store whether each player correctly identifies their color
• If a player sees their slip, do they also see their color? Yes!
• If a player does not see their slip, what happens?

Modifying the logic

boxes <- sample(slips, a, replace=F)
slip_colors <- sample(c("red", "blue"), a, replace=T)
player_results <- rep(NA, a)

for(player in 1:a){
  opened_boxes <- sample(1:a, a/2, replace = F)
  if(player %in% boxes[opened_boxes]){
    ...
  } else {
    ...
  }
}

Question: How do we fill in the if...else... here?

Modifying the logic

boxes <- sample(slips, a, replace=F)
slip_colors <- sample(c("red", "blue"), a, replace=T)
player_results <- rep(NA, a)

for(player in 1:a){
  opened_boxes <- sample(1:a, a/2, replace = F)
  if(player %in% boxes[opened_boxes]){
    player_results[player] <- TRUE
  } else {
    random_guess <- sample(c("red", "blue"), 1)
    player_results[player] <- random_guess == slip_colors[player]
  }
}

Putting it all together

set.seed(27)
a <- 10
slips <- 1:a
ngames <- 1000
game_results <- rep(NA, ngames)

for(i in 1:ngames){
  boxes <- sample(slips, a, replace=F)
  slip_colors <- sample(c("red", "blue"), a, replace=T)
  player_results <- rep(NA, a)
  
  for(player in 1:a){
    opened_boxes <- sample(1:a, a/2, replace = F)
    if(player %in% boxes[opened_boxes]){
      player_results[player] <- TRUE
    } else {
      random_guess <- sample(c("red", "blue"), 1)
      player_results[player] <- random_guess == slip_colors[player]
    }
  }
}