Introduction to the Problem

Assume that There are k people in a room, and that each person’s birthday is equally likely to be any of the 365 days of the year. Also, assume that People’s birthdays are independent.

What is the probabiliy that at least 2 people share the same birthday?

There are \(365^{k}\) ways to assign birthdays to the people in the room, since we can imagine the 365 days of the year being sampled times, with replacement. By assumption, all of these possibilities are equally likely, so the naive definition of probability applies.

Used directly, the naive definition says we just need to count the number of ways to assign birthdays to people such that there are two or more people who share a birthday. But this counting problem is hard, since it could be Emma and Steve who share a birthday, or Steve and Naomi, or all three of them, or the three of them could share a birthday while two others in the group share a different birthday, or various other possibilities.

Instead, let’s count the complement: the number of ways to assign birthdays to people such that no two people share a birthday. This amounts to sampling the 365 days of the year without replacement, so the number of possibilities is \(365.364........(365-k+1)\) for \(k \le 365\). Therefore the probability of no birthday matches in a group of \(k\) people is: \[ P(no\ birthday\ match) = 365.364........(365-k+1) / 365^k \],

and the probability of at at least one birthday match is: \[ P(at\ least\ one\ birthday\ match) = 1 - 365.364........(365-k+1) / 365^k \].

Probability that at least 2 people share the same birthday

# Initialize a probability vector with length k
k <- 100
p <- numeric(k)

for (i in 1:k) 
{
    # a vector that runs from 365 to 365 - k + 1
  v <- seq(365, 365 - i + 1)
  # Probability that there are no 2 people who have the same birthday
    q <- prod(v) / 365^i 
    # Probability that at least 2 people share the same birthday
    p[i] <- 1 - prod(q)
}
# Return the number of people at which the probability is greater than or equal 0.5
which(p >= 0.5)[1]
## [1] 23

Plot

plot(p, main = "Probability that at least 2 people share the same Birthday", xlab = "Number of People", ylab = "Probability", col = "blue", type='l')
n <- which(p >= 0.5)[1]
abline(h=0.5, v=n, lty=3, lwd=2, col="red")