World Series Home Team Losing Streaks

According to the Riddler, “the home team actually wins about 54 percent of the time in baseball.” Using this, and assuming independent games, we can calculate that the probability of the home team losing 7 games in a row is .004358, or about 1 in 229 chances.

p7 <- (0.46)^7
p7 
## [1] 0.004358177
trunc(1/p7)
## [1] 229

To lose at least six games in row means that the home team could lose all seven (included in the calculation above), or lose only six in a row. This means the home team would have to pull out a win on the first or last game. The probability of this occuring is about 0.01459, or about 1 in 68 chances.

p6 <- p7 + 2*(0.46)^6*(0.54)
p6 
## [1] 0.01459042
trunc(1/p6)
## [1] 68

To lose at least five games in a row includes the values above along with those outomes in which you have an exact 5 game losing streak. You can have an exact 5 game losing streak and still lose 6 games (as long as the second or sixth game is a win), so one needs to be careful here.

The ways to get exactly 5 consecutive losses with exactly 5 losses is * LLLLLWW * WLLLLLW * WWLLLLL

and the ways to get 5 consecutive losses with exactly 6 losses is * LWLLLLL * LLLLLWL

Thus, the probability of getting at least five consecutive losses is 0.04284 or about 1 in 23 chances.

p5 <- p6 + 3*(0.46)^5*(0.54)^2+2*(0.46)^6*(0.54)
p5
## [1] 0.0428403
trunc(1/p5)
## [1] 23

Finally, to analyze how we lose at least four consecutive games, we include the above calculation and look at the ways to get exactly 4 consecutive losses.

Using 4 losses and 3 wins: * LLLLWWW * WLLLLWW * WWLLLLW * WWWLLLL

Using 5 losses and 2 wins: * LLLLWWL * LLLLWLW * WLLLLWL * LWLLLLW * LWWLLLL * WLWLLLL

Using 6 losses and 1 win: * LLLLWLL * LLWLLLL

Summing those probabilities up and aggregating the previous result, we find that the probability of the home team losing at least 4 consecutive games is 0.1173, or about 1 in 8 chances.

p4 <- p5 + 4*(0.46)^4*(0.54)^3+6*(0.46)^5*(0.54)^2 + 2*(0.46)^6*(0.54)
p4
## [1] 0.1173093
trunc(1/p4)
## [1] 8

The Lottery

We start with the 70 possible lottery numbers.

lotteryNums <- 1:70

Then, we employ the sieve of Eratosthenes:

sieveOfEratosthenes <- function(num){
  values <- rep(TRUE, num)
  values[1] <- FALSE
  prev.prime <- 2
  for(i in prev.prime:sqrt(num)){
    values[seq.int(2 * prev.prime, num, prev.prime)] <- FALSE
    prev.prime <- prev.prime + min(which(values[(prev.prime + 1) : num]))
  }
  return(which(values))
}

eliminate <- sieveOfEratosthenes(70)
eliminate
##  [1]  2  3  5  7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67

Combining this vector with all the powers of itself up to 6, and keeping only those values less than 70, we obtain what we need to eliminate from the lottery.

eliminate <- union(eliminate,
                   union(eliminate^2, 
                         union(eliminate^3, 
                               union(eliminate^4,
                                     union(eliminate^5,eliminate^6)))))
eliminate <- eliminate[eliminate<=70]
lotteryNums <- lotteryNums[-eliminate]
lotteryNums
##  [1]  1  6 10 12 14 15 18 20 21 22 24 26 28 30 33 34 35 36 38 39 40 42 44
## [24] 45 46 48 50 51 52 54 55 56 57 58 60 62 63 65 66 68 69 70

We can eliminate 1 from the list, which leaves us with 41 values to work with.

lotteryNums <- lotteryNums[-1]
lotteryNums
##  [1]  6 10 12 14 15 18 20 21 22 24 26 28 30 33 34 35 36 38 39 40 42 44 45
## [24] 46 48 50 51 52 54 55 56 57 58 60 62 63 65 66 68 69 70

The product of each of their 5 numbers is the same

This means we can eliminate 26, 39, 52, and 65 from the list, since these are the only four numbers divisible by 13. Likewise, we can remove 34, 51, and 68 since these are the only three numbers divisible by 17. Analagously, remove 38 and 57 (only two divisible by 19), 46 and 69 (only two divisible by 23), 58 (only one divisible by 29), 62 (only one divisible by 31).

lotteryNums <- setdiff(lotteryNums, 
                       c(26,39,52,65,34,51,68,38,57,46,69,58,62))
lotteryNums
##  [1]  6 10 12 14 15 18 20 21 22 24 28 30 33 35 36 40 42 44 45 48 50 54 55
## [24] 56 60 63 66 70

This leaves us with 28 numbers. We need to get down to 25. Let’s use a prime.factor function from the ‘schoolmath’ package, and obtain a list of all the primes that are used in every one of these numbers.

library(schoolmath)
primeList <- sort(unlist(lapply(lotteryNums, prime.factor)))
primeList
##  [1]  2  2  2  2  2  2  2  2  2  2  2  2  2  2  2  2  2  2  2  2  2  2  2
## [24]  2  2  2  2  2  2  2  2  2  2  2  2  2  3  3  3  3  3  3  3  3  3  3
## [47]  3  3  3  3  3  3  3  3  3  3  3  3  5  5  5  5  5  5  5  5  5  5  5
## [70]  5  7  7  7  7  7  7  7  7 11 11 11 11 11
sum(primeList==2)
## [1] 36
sum(primeList==3)
## [1] 22
sum(primeList==5)
## [1] 12
sum(primeList==7)
## [1] 8
sum(primeList==11)
## [1] 5

The above numbers should all be divisible among the five friends. For this to be possible, we need to remove 1 or 6 two’s, 2 three’s, 2 five’s, and 3 seven’s by removing only three numbers! With a little deduction, you can see that this can be done by removing 35, 63, and 70.

lotteryNums <- setdiff(lotteryNums, c(35,63,70))
length(lotteryNums)
## [1] 25
P <- prod(lotteryNums)^(1/5)
P 
## [1] 19958400
## Should be same as...  
2^(35/5)*3^(20/5)*5^(10/5)*7^(5/5)*11^(5/5)
## [1] 19958400
prime.factor(as.integer(P))
##  [1]  2  2  2  2  2  2  2  3  3  3  3  5  5  7 11

This is the answer to our riddle!