Steven Wolf

Best strategy for a fencing relay

2021-12-13T00:00:00+00:00

The riddle

You are the coach at Riddler Fencing Academy, where your three students are squaring off against a neighboring squad. Each of your students has a different probability of winning any given point in a match. The strongest fencer has a 75 percent chance of winning each point. The weakest has only a 25 percent chance of winning each point. The remaining fencer has a 50 percent probability of winning each point.

The match will be a relay. First, one of your students will face off against an opponent. As soon as one of them reaches a score of 15, they are both swapped out. Then, a different student of yours faces a different opponent, continuing from wherever the score left off. When one team reaches 30 (not necessarily from the same team that first reached 15), both fencers are swapped out. The remaining two fencers continue the relay until one team reaches 45 points.

As the coach, you can choose the order in which your three students occupy the three positions in the relay: going first, second or third. How will you order them? And then what will be your team’s chances of winning the relay?

Functions and background

We need a function that simulates a relay:

simulateRelay = function(pOrder){
    if(length(pOrder)!=3){
        stop("The number of participants is 3.")
    }
    ## Initialize
    matchResult = NULL
    myWins = 0
    oppWins = 0
    # First leg:
    while(max(myWins,oppWins)<15){
        if(runif(1) < pOrder[1]){
            matchResult = c(matchResult,'myTeam')
            myWins = myWins + 1
        }else{
            matchResult = c(matchResult,'opp')
            oppWins = oppWins + 1
        }
    }
    # Second leg:
    while(max(myWins,oppWins)<30){
        if(runif(1) < pOrder[2]){
            matchResult = c(matchResult,'myTeam')
            myWins = myWins + 1
        }else{
            matchResult = c(matchResult,'opp')
            oppWins = oppWins + 1
        }
    }
    # Final leg:
    while(max(myWins,oppWins)<45){
        if(runif(1) < pOrder[3]){
            matchResult = c(matchResult,'myTeam')
            myWins = myWins + 1
        }else{
            matchResult = c(matchResult,'opp')
            oppWins = oppWins + 1
        }
    }
    
    relayResult = ifelse(myWins==45,'My Team','The Opponent')
    res = list('rres'=relayResult,'myWins'=myWins,'oppWins'=oppWins,
               'allMatches'=matchResult)
    return(res)
}

Results

Before I present results, I’d like to state my idea of how this should work. My general thought is that the strongest player should go last. In general, I want my strongest player out for the longest time. If the order is from weakest to strongest, on average, we expect the following results:

Weakest player will win 25% of matches, opponent wins 75% of the matches. So this player will be out for 20 matches, and get 5 wins. Score 5-15.
Medium player will win 50% of matches, and should be out there for 30 matches total. Score 20-30.
Best player will win 75% of matches and needs to win 25 matches before other player wins 15. Given the win probability, this player would be expected to win 25 matches in 33 tries.

If I play my best player in any spot but the last one, the most matches that can be won are 15, and my sense is that we want the player who can gain wins most efficiently out for the longest time.

playerProbs = c(0.25,0.5,0.75)

Nsims=10000
relayResTab = NULL
for(p1 in playerProbs){
    otherProbs = playerProbs[playerProbs!=p1]
    for(p2 in otherProbs){
        p3 = otherProbs[otherProbs!=p2]
        pOrder = c(p1,p2,p3)
        relayWins = 0
        for(n in 1:Nsims){
            relaySim = simulateRelay(pOrder = pOrder)
            relayWins = relayWins + 
                ifelse(relaySim$rres=="My Team", 1, 0)
        }
        winPct = relayWins/Nsims*100
        orderTab = data.frame(p1,p2,p3,'WinPct'=winPct)
        if(is.null(relayResTab)){
            relayResTab = orderTab
        }else{
            relayResTab = rbind(relayResTab,orderTab)
        }
    }
}
## Order the table
relayResTab = relayResTab[order(-relayResTab$WinPct),]

The labels in this table p1, p2, and p3 are the win probabilities of the first, second, and third players respectively.

p1	p2	p3	WinPct
0.25	0.50	0.75	93.48
0.50	0.25	0.75	92.01
0.25	0.75	0.50	83.13
0.75	0.25	0.50	17.63
0.50	0.75	0.25	7.59
0.75	0.50	0.25	6.81

These results show that my intuition is correct, the strongest player going last is indeed optimal. In fact, any order that had the highest rated player after the lowest rated player made the team’s victory more than 80% probable.

Extensions

I thought it would be interesting to watch the win count change like a basketball game flow graph. This function will accomplish that goal.

plotMatchResult = function(matchResults){
  numMatches = length(matchResults)
  myRunWinTotal = c(0,cumsum(matchResults=="myTeam"))
  myScore = data.frame('match'=0:numMatches,'team'='My Team', 
                       'wins'=myRunWinTotal)
  oppRunWinTotal = c(0,cumsum(matchResults=="opp"))
  oppScore = data.frame('match'=0:numMatches,'team'='Opponent', 
                        'wins'=oppRunWinTotal)
  score = rbind(myScore,oppScore)
  score$team = factor(score$team)
  maxRunScore = pmax(myRunWinTotal,oppRunWinTotal)
  matchNum = 0:numMatches
  endFirst = matchNum[which(maxRunScore==15)[1]] + 0.5
  endSecond = matchNum[which(maxRunScore==30)[1]] + 0.5
  ggplot(data=score, aes(x=match, y=wins, group=team, color=team)) + 
    geom_step(aes(color=team), size=1.5) + 
    geom_hline(yintercept=15, linetype='dotted', color='red',size=1) + 
    geom_hline(yintercept=30, linetype='dotted', color='green',size=1) +
    geom_vline(xintercept=endFirst, linetype='dotted', color='red',size=1) + 
    geom_vline(xintercept=endSecond, linetype='dotted', color='green',size=1) +
    scale_color_brewer(palette='Dark2') +
    theme_classic() + theme(text=element_text(size=24))
}

plotWinner = function(pOrder){
  noWin = TRUE
  while(noWin){
    relayResult = simulateRelay(pOrder = pOrder)
    noWin = relayResult$rres!="My Team"
    i = 0
    maxIter = 100
    if(i>maxIter){
      stop(paste('The simulation could not find a loss after',maxIter,
                 'iterations.'))
    }
  }
  plotMatchResult(relayResult$allMatches)
}

plotLoser = function(pOrder){
  noLoss = TRUE
  maxIter = 100
  i = 1
  while(noLoss){
    relayResult = simulateRelay(pOrder = pOrder)
    noLoss = relayResult$rres!="The Opponent"
    i = i+1
    if(i>maxIter){
      stop(paste('The simulation could not find a loss after',maxIter,
                 'iterations.'))
    }
  }
  plotMatchResult(relayResult$allMatches)
}

Optimal strategy

This strategy works in most cases. As I predicted, the opponent rushes out to a lead, but the top player makes up the difference in the end.

set.seed(1234)
plotWinner(c(0.25,0.5,0.75))

Obviously, this strategy isn’t foolproof. Sometimes, the opponent wins. When that happens, the lower ranked players don’t get as many wins as expected, and then the best player can’t quite make up the difference.

set.seed(1234)
plotLoser(c(0.25,0.5,0.75))

Worst strategy

And now let’s look at what happens when the coach strategically throws the match.

set.seed(12345)
plotLoser(c(0.75,0.5,0.25))

This case is the inverse of what happens when the team loses despite applying the optimal strategy. The team builds a big lead, and then is able to bring it home despite the weakest player’s struggles at the end.

set.seed(1234)
plotWinner(c(0.75,0.5,0.25))

Rigging the game

Lastly, it occurs to me that if we came up with a rule like this:

You can distribute up to 1 point of win probability among your 3 players and deploy them as you see fit.

we can really rig the game. (I guess this team is “worse” than the team in question from an average match win probability perspective) In principle if you have players with win probabilities of 0, 0, and 1, you can always win the relay, or always lose the relay depending on your deployment. And the graphs look like this:

Always winning

45-30, every time.

plotWinner(c(0,0,1))

And never losing:

plotLoser(c(0,0,1))

## Error in plotLoser(c(0, 0, 1)): The simulation could not find a loss after 100 iterations.

Always losing

15-45, every time.

plotLoser(c(1,0,0))

Or if you put your ringer second, it’s 30-45 every time.

plotLoser(c(0,1,0))

How Clever am I

2021-08-16T00:00:00+00:00

The riddle

You are very clever when it comes to solving Riddler Express puzzles. You are so clever, in fact, that you are in the top 10 percent of solvers in Riddler Nation (which, as you know, has a very large population). You don’t know where in the top 10 percent you are — in fact, you realize that you are equally likely to be anywhere in the topmost decile. Also, no two people in Riddler Nation are equally clever.

One Friday morning, you walk into a room with nine members randomly selected from Riddler Nation. What is the probability that you are the cleverest solver in the room?

Results

Ok, so let’s start with some simple math. If I am cleverer than exactly 90% of people, which is my minimum cleverness percentile, if we pick one person from the general population, there is a 90% chance that I am cleverer than that person. If we pick 2 people, that would be \(0.9^2\) or a 81% chance that I am the cleverest. So for any number of people \(N\), I should be the cleverest with a probability of \(p=0.9^N\). For 9 people, that’s 38.7% of the time. This should be considered a lower bound on the correct answer.

Why is that a lower bound? Well, it’s because I know that I am at least in the 90th percentile of cleverness. There is some non-zero chance that I am cleverer than someone who is cleverer than 91% of people. Let’s see if we can figure this out by simulating this system. I’m going to write code which does this:

Estimate my probability to be a random number between 0.9 and 1.
Generate 9 random probabilities between 0 and 1 to simulate the room I’m walking into.
Determine if my probability is larger than all of these and keep track of the result.
Repeat a whole bunch of times and see where the probability stabilizes

simulateRoom = function(roomSize=9,myCleverBound=0.9){
    myClever = runif(1,min=myCleverBound,max=1)
    roomClever = runif(roomSize)
    cleverest = ifelse(all(myClever>roomClever),1,0)
    return(cleverest)
}

nSims = 10^5
roomResults = numeric(nSims)
for(i in 1:nSims){
    set.seed(100*i)
    roomResults[i] = simulateRoom()
}
cleverProb = cumsum(roomResults)/seq_along(roomResults)
cleverestProb = sum(roomResults)/nSims
plot(cleverProb,type='l',col='blue',ylim=c(0,1),xlab='simulation number',
     ylab='cumulative probability', log='x')
abline(h=cleverestProb, col='red', lty=2)

The value that this approaches is 65.1%.

Astronomical Enigma

2021-07-15T00:00:00+00:00

The riddle

The astronomers of Planet Xiddler are back!

This time, they have identified three planets that circularly orbit a neighboring star. Planet A is three astronomical units away from its star and completes its orbit in three years. Planet B is four astronomical units away from the star and completes its orbit in four years. Finally, Planet C is five astronomical units away from the star and completes its orbit in five years.

They report their findings to Xiddler’s Grand Minister, along with the auspicious news that all three planets are currently lined up (i.e., they are collinear) with their star. However, the Grand Minister is far more interested in the three planets than the star and wants to know how long it will be until the planets are next aligned.

How many years will it be until the three planets are again collinear (not necessarily including the star)?

Functions and background

This is a simple least common multiple (LCM) type problem. I’m not going to write code to do this since the numbers are relatively easy, and I’m lazy. The way to find the LCM is to find the prime factorization of all of the numbers, and then determine the LCM by taking the unique prime factors and raising them to the largest power observed in each term, and then multiplying them together. For example, if we want to determine the LCM of 4 and 6, we need to find the prime factorization of each number:

\[4 = 2^2\]
\[6 = 2^1 3^1\]

The unique primes are 2 and 3. 2 is squared to get 4, and 3^1 is required to get 6. So the LCM is \(2^2 3^1 = 4\times 3 = 12\). Fourth grade math.

Results

So, our orbital periods are 3 years, 4 years, and 5 years. 3 and 5 are both prime numbers so the LCM is \(2^2 \times 3^1 \times 5^1 = 60\) years.

Extensions

Ok, so I’m totally a physics professor, and I can’t leave the blatant violation of Kepler’s 3rd law alone, textual footnote aside.

Kepler’s Third Law assumes that the force maintaining the orbit is a central force (that is, it depends only on the distance between two objects and acts on the line connecting those objects) AND that the force obeys the inverse-square relation, for gravity acting between point objects, this is:

\[F = \frac{GMm}{r^2} \propto \frac{1}{r^2}\]

If we want to understand what is going on here, we need to relax the second assumption (inverse-square relation) and get a general statement of Kepler’s Third Law. If we assume that the central force is of the form of a power law:

\[F = \beta r^p\]

Here, \(\beta\) is a numeric constant, \(r\) is the distance between the objects, and \(p\) is an unknown power. For circular motion, we can also write:

\[F = mr\omega^2 = \frac{4\pi^2 m}{T^2}r\]

where \(m\) is the mass of the orbiting object and \(\omega = \frac{2\pi}{T}\) is the (constant) angular frequency of the rotation and \(T\) is the period of the motion. If we equate the two forces and solve for \(T\), we get:

\[T^2 = \frac{4\pi^2 m}{\beta} r^{1-p}\]

Since we observe a pattern of \(T \propto r\), we know that \(1-p = 2\) implying that \(p=-1\). If we consider that the star could be a non-spherical shape, we can then determine that the observed power suggests that the star is in the shape of a very long, thin rod.

Alternative ideas

One thing that we can note is that Kepler’s laws only apply to the two-body problem, and there are many ways that having multiple celestial bodies can influence orbital mechanics. Precession, for example, is an orbit changing the direction in which it is distorted as depicted by the figure below. The article that I pulled this figure from specifically discusses this in the context of a test of general relativity, and is worth a read if you are interested.

There is also the phenomenon of orbital resonance, whereby orbiting objects have orbital periods in a regular ratio with one another. These orbiting objects provide a regular gravitational “kick” which reinforces the resonance.

Interfering Cicada Populations

2021-07-09T00:00:00+00:00

The riddle

Earlier this year, a new generation of Brood X cicadas had emerged in many parts of the U.S. This particular brood emerges every 17 years, while some other cicada broods emerge every 13 years. Both 13 and 17 are prime numbers — and relatively prime with one another — which means these broods are rarely in phase with other predators or each other. In fact, cicadas following a 13-year cycle and cicadas following a 17-year cycle will only emerge in the same season once every 221 (i.e., 13 times 17) years!

Now, suppose there are two broods of cicadas, with periods of A and B years, that have just emerged in the same season. However, these two broods can also interfere with each other one year after they emerge due to a resulting lack of available food. For example, if A is 5 and B is 7, then B’s emergence in year 14 (i.e., 2 times 7) means that when A emerges in year 15 (i.e., 3 times 5) there won’t be enough food to go around.

If both A and B are relatively prime and are both less than or equal to 20, what is the longest stretch these two broods can go without interfering with one another’s cycle? (Remember, both broods just emerged this year.) For example, if A is 5 and B is 7, then the interference would occur in year 15.

Functions and background

First, we need to define what is meant by the term relatively prime. Two numbers are relatively prime, if the greatest common factor between the two numbers is 1. For example, 2 and 9 are relatively prime. The factors of 2 are 1 and 2, and the factors of 9 are 1, 3, and 9. The largest number common to both lists is 1. Fortunately, R has a package that lets you calculate the greatest common factor: It is the gcd() function in the FRACTION package. I’m going to code a function called isRelPrime() which takes two inputs a and b and returns TRUE/FALSE if the inputs are relatively prime.

library(FRACTION)

isRelPrime = function(a,b){
    gcd(a,b) == 1
}

Next, let’s think about the interference condition.

Case 1

We will observe interference if the \(B\) brood emerges the year after the \(A\) brood:

\[nB = mA+1\]

(where \(n\) and \(m\) are arbitrary integers). Now, if \((N,M)\) solve this equation, then \((N+A, M+B)\) will also solve this. Since we want a minimum interference time, we can restrict ourselves to \(n<A\) and \(m<B\).

Case 2

We can also observe interference if the \(A\) brood emerges the year after the \(B\) brood:

\[nA = mB + 1\]

We will put similar restrictions on \(n<B\) and \(m<A\).

minInterferenceTime = function(a,b){
    if(!isRelPrime(a,b)){
        return(NULL)
    }
    ## Case 1 nB = mA + 1
    case1left = (1:a)*b
    case1right = (1:b)*a + 1
    case1 = case1left[which(case1left %in% case1right)]
    ## Case 2 nA = mB + 1
    case2left = (1:b)*a
    case2right = (1:a)*b + 1
    case2 = case2left[which(case2left %in% case2right)]
    mIT = min(c(case1,case2))
    return(mIT)
}

Note, this whole \(A\) and \(B\) are relatively prime is relatively important…pardon the pun…For example, 2 and 4 are not relatively prime. For example, if \(A=2\) and \(B=4\), then they will never interfere, because they will always emerge in even years, and not one year before or after an even year.

Results

Given the constraints of the problem, I think writing a few short loops is appropriate

longestTime = 0
for(a in 2:19){
    for(b in (a+1):20){
        if(isRelPrime(a,b)){
            t = minInterferenceTime(a,b)
            longestTime = max(c(longestTime,t))
        }
    }
}

So, the longest time from this year (when both broods emerge) is going to be 153 years. This occurs if \(A=17\) and \(B=19\) or vice versa.

Enigmerica Election – Mea Culpa

2021-07-02T00:00:00+00:00

In one of my previous posts, I was incorrect about my solution. In brief, the riddle is this:

In an election where two candidates both expect to get 50% of the votes, 80% of the votes will be counted on election night, and the remaining 20% will be counted later. What is the probability that the leader on election night will lose?

Where the old solution went right

There was some text about random and independent trials, and the number of voters being very large. The first bit allows us to assume that these are Bernoulli trials and follow the binomial distribution. For example, if I give you a fair coin, what is the probability that you flip heads? If you said 50%, give yourself a pat on the back. Now, what if I tell you that before I handed you the coin, I flipped it 3 times and got 3 tails, does that change your answer? If you said no, have a cookie too (after you are done patting yourself on the back). The coin has no memory, and past results don’t influence future flips.

The fact that we have large numbers of voters means that the Central Limit Theorem applies. In short, we can assume the binomial probability distribution can be estimated using the normal distribution. (That’s our friends dnorm and pnorm again…if you don’t remember, look back a the old post.)

Where the old solution went wrong

Right here:

Note, that we can simply use the standard \(\mu = 0\) and \(\sigma = 1\) choices for the normal distribution as the actual percent margins can be normalized, and the scaling factor drops out of the margin inequality above.

The variance in the distribution should depend on the number of trials that we run. For example, let’s just consider flipping a coin \(N\) times. What is the probability that I have at least 5 more heads than tails for different values of \(N\)? This condition is met when the number of heads that I flip \(k\) obeys this inequality:

\[k \geq \frac{N}{2} + 2.5\]

Note, the pbinom function is much like the pnorm function noted previously. Let’s look at how probable a margin of 5 heads is as \(N\) increases:

N = round(10^(seq(1,5,by=0.5)), 0)
kmin = N/2 + 2.5
pMargin5 = pbinom(kmin, N, 0.5, lower.tail = FALSE)
par(cex=2)
plot(N,pMargin5,log='x',xlab='Number of trials', 
     ylab='Probability to have at least 5 more heads than tails',
     ylim=c(0,0.6))
abline(h=0.5,col='red',lty=2)

Now, while you might think that this is fine since we are in a large \(N\) regime, this is a close race, and marginal differences shouldn’t be neglected.

Let’s fix things

I want to reframe this a bit. Let’s start by looking at the probability distribution that a candidate will get \(x\) votes in a given counting of \(n\) votes. For the binomial distribution, we know that the mean \(\mu = np\) and the variance \(\sigma^2 = np(1-p)\) are well-defined. Now, we can use these to approximate a normal distribution (this is that Central Limit Theorem I mentioned earlier):

\[d(x;n,p) = {n \choose x} p^x \left(1-p\right)^{n-x} \approx \frac{1}{\sqrt{2\pi np(1-p)}} \exp\left(-\frac{1}{2}\frac{\left(x-np\right)^2}{np(1-p)}\right)\]

We can again change \(x\) from an absolute vote count to a marginal vote count. Instead of having a mean of \(np\), it will simply have a mean of zero:

\[d(x;n,p) = \frac{1}{\sqrt{2\pi np(1-p)}} \exp\left(-\frac{1}{2} \frac{x^2}{np(1-p)}\right)\]

On the first night, \(n = 0.8N\), let’s call that margin \(x_1\):

\[d(x_1;0.8N,p) = \frac{1}{\sqrt{2\pi 0.8 N p(1-p)}} \exp\left(-\frac{1}{2} \frac{x_1^2}{0.8 N p(1-p)}\right)\]

And on the subsequent count:

\[d(x_2;0.2N,p) = \frac{1}{\sqrt{2\pi 0.2 N p(1-p)}} \exp\left(-\frac{1}{2} \frac{x_2^2}{0.2 N p(1-p)}\right)\]

So for the result to flip, one of two conditions needs to be met:

\(x_1 > 0\) and \(x_2 < -x_1\)
\(x_1 < 0\) and \(x_2 > -x_1\)

Ok, now we are getting close. We just need to figure out what to put in for sigma. Again, the absolute number shouldn’t matter. Let’s define:

\[\sigma^2 \equiv 0.2 Np(1-p)\]

and use this to scale out the \(N\) from these distributions, which we don’t know anyway:

\[d(x_1;0.8) = \frac{1}{2\sigma\sqrt{2\pi}} \exp\left(-\frac{1}{2} \left(\frac{x_1}{2\sigma}\right)^2\right)\]

and

\[d(x_2;0.2) = \frac{1}{\sigma\sqrt{2\pi}} \exp\left(-\frac{1}{2} \left(\frac{x_2}{\sigma}\right)^2\right)\]

So the standard deviation for the vote margin on election night is double what it will be for the mail in vote. Let’s put that in the code and integrate numerically:

dm = 0.0001
margins = seq(0,1000,dm)
probFlip = 2*sum(dm * dnorm(margins,sd=2) * pnorm(-margins,sd=1))

(Note, I’m multiplying by 2 in the last line above to take care of the fact that we don’t care which candidate starts out ahead on election night.) The probability that the result flips is 14.76%. (Here’s more digits if you want them: 0.1475936.)

Extensions:

There was a really cool heatmap on the Riddler Solution page that I totally want to copy. For this, we need to create the 2D probability function

\[P(x_1,x_2) = d(x_1;0.8) d(x_2;0.2)\]

And now let’s create that function in R and make a heatmap:

electionProbDensity = function(x,y){
    epd = dnorm(x,sd=2) * dnorm(y,sd=1)
    return(epd)
}
plotMax = 5
plotRange = seq(-plotMax,plotMax,length.out=1000)
plotDat = expand.grid(X=plotRange, Y=plotRange)
plotDat$electionProbDen = electionProbDensity(x=plotDat$X, y=plotDat$Y)
ggplot(plotDat, aes(X,Y,fill=electionProbDen)) + geom_tile() + 
    scale_fill_viridis(discrete = FALSE,option="A") +
    xlab('Election night margin') + ylab('Mail vote margin') + 
    theme(axis.text=element_blank(),text = element_text(size=28)) + 
    coord_fixed() + geom_vline(xintercept=0, color='white', lwd=2, lty=2) + 
    geom_abline(slope = -1, intercept=0, color='white', lwd=2, lty=2)

We are integrating over those triangular regions marked out between the dashed lines.

Counting my marbles before I lose them

2021-06-25T00:00:00+00:00

The riddle

From Matt Enlow comes an original puzzle of his that previously appeared in Math Horizons. (At first it may seem like there’s information missing, but I assure you that is not the case.). A bag contains 100 marbles, and each marble is one of three different colors. If you were to draw three marbles at random, the probability that you would get one of each color is exactly 20 percent.

How many marbles of each color are in the bag?

Functions and background

I’m sure that there is an analytic solution to this. But, BRUTE FORCE will work too. We can be a little smart. I’m going to assume that we have red, green, and blue marbles and denote their numbers to be \((n_R, n_G, n_B)\) respectively, and I’m going to define \(N \equiv n_R + n_G + n_B = 100\). There are six ways that we can draw marbles of each color, so the probability to get one marble of each color for any bag with three colors of marbles is:

\[6 \frac{n_R n_B n_G}{N(N-1)(N-2)}\]

Let’s code this up in a function:

probAllThree = function(k,l,m){
    N = k + l + m
    prob = 6 * k * l * m/(N*(N-1)*(N-2))
    return(prob)
}

Results

Let’s just loop through all the possibilities:

output = NULL
for(nRed in 0:100){
    nBlueMax = 100 - nRed
    for(nBlue in 0:nBlueMax){
        nGreen = 100 - nBlue - nRed
        prob = probAllThree(nRed, nBlue, nGreen)
        tst = data.frame(nRed, nBlue, nGreen, prob)
        output = rbind(output, tst)
    }
}

Now let’s look at the cases where the probability is equal to 20%

output[output$prob==0.2, ]

##      nRed nBlue nGreen prob
## 1947   21    35     44  0.2
## 1956   21    44     35  0.2
## 2962   35    21     44  0.2
## 2985   35    44     21  0.2
## 3520   44    21     35  0.2
## 3534   44    35     21  0.2

So, we have to have 21, 35, and 44 marbles of each color for this to work. Of course, the colors you choose are up to you.

Extensions

I’m just curious, what’s the maximum probability and when does it happen? My intuition is that there should be some sort of symmetry like \(n_R = n_G = n_B\), but not quite since 100/3 is not an integer.

maxProb = max(output$prob)
output[output$prob==maxProb, ]

##      nRed nBlue nGreen      prob
## 2839   33    33     34 0.2289796
## 2840   33    34     33 0.2289796
## 2907   34    33     33 0.2289796

So my intuition is right, the answer is to make the number of marbles as equal as possible.

I also want to see a heatmap of what this probability looks like. It should be quite symmetrical. (Indeed it should be able to be reflected about a line with slope = 1.)

ggplot(output, aes(nRed, nBlue, fill=prob)) + geom_tile() +
    scale_fill_viridis(discrete=FALSE) +
    theme(aspect.ratio=1, axis.title=element_text(size=20), axis.text = element_text(size=16)) + 
    coord_fixed()

This makes sense. The probability is low when we have very few reds (left edge of triangle), very few blues (bottom edge of triangle), or very few greens (hypotenuse of triangle).

Just for fun, does the same ratio of marbles hold for larger values of \(N\)? (For example if I have 210, 350, and 440 marbles, is there still a 20% chance we get one from each color?)

probAllThree(210,350,440)

## [1] 0.1946235

Not quite…I didn’t think so. I can’t easily change marble numbers into probabilities in the above expression. We just have too many -1’s and -2’s running around in the expression to say that it should just scale up. If the denominator was directly proportional to \(N^3\) in the above expression, I would expect this to scale since I could then define \(p = \frac{n}{N}\) and have things cancel out of the expression. As it stands, we can do that to some degree:

\[6 \frac{n_R n_B n_G}{N(N-1)(N-2)} = 6 \frac{n_R n_B n_G}{N^3} \left(1-\frac{3}{N} + \frac{2}{N^2}\right)^{-1} = 6 p_R p_B p_G \left(1-\frac{3}{N} + \frac{2}{N^2}\right)^{-1}\]

The term in the parentheses will approach 1 as \(N\) gets very large. As the number of marbles grows this term can be ignored, and the probability will just be \(6 p_R p_B p_G\). If we further restrict ourselves to the case where the number of marbles from each color is equal, then we can set \(p_R = p_B = p_G = \frac{1}{3}\), and the probability becomes:

\[\frac{2}{9} \left(1-\frac{3}{N} + \frac{2}{N^2}\right)^{-1}\]

This is indeed 1 for \(N=3\), and below is a plot of how it changes. The red line on the plot below is at \(\frac{2}{9}\) for reference. (Note the log scale on the x-axis).

n = 1:10000
p = probAllThree(n,n,n)
ggplot(data.frame(n,p), aes(n,p)) + geom_point(color='blue') + scale_x_continuous(trans='log10') +
    geom_hline(yintercept=2/9, linetype='dashed', color='red') + 
    theme(axis.title=element_text(size=20), axis.text = element_text(size=16)) + 
    xlab('Number of marbles of each color in the bag') + ylim(0,1) +
    ylab('Probability')

Solving a simple puzzle

2021-06-24T00:00:00+00:00

I caught this article in my feed this morning and it got me thinking. It discusses a simple problem:

Take the numbers 1 to 100, square them, and add all the even numbers while subtracting the odd ones!

The article itself lays out 7 ways to solve the puzzle. One is quite boring (just type everything in by hand like a calculator). I think the point of the article is cool - specifically, that there are often many ways to solve a problem. It did make me think about how I would work with a student to solve this problem though. I feel like the article is focused on experienced R users (note the general lack of comments in the code) rather than to a new user.

I think my favorite solution is somewhat similar to the first solution that he immediately thought of…well, the one right after the boring one…with a few extra steps. I can imagine a dialog with a student looking like this…(Note, I’m a physics professor by trade, so when I’m teaching students to code, I’m often pointing them in the direction of useful functions so that they can solve the physics)

Solving the problem

Me: Ok, so what do we need to solve this problem?

Student: Well, it would be really nice if we had all of the even numbers in one vector and all of the odd numbers in another vector.

Me: Great! Let’s check out the seq() function. Put these lines into your interpreter and see what pops out:

seq(from=1,to=10,by=2)

## [1] 1 3 5 7 9

seq(from=2,to=10,by=2)

## [1]  2  4  6  8 10

Can we use these to generate what you want?

Student: Yes! I think I can do this:

odds = seq(from=1,to=100,by=2)
evens = seq(from=2,to=100,by=2)

Ok, now can I just square these things?

Me: Whenever I’m unsure of something, I like to try it out on a shorter vector that I can check by hand. Like this:

x = 1:5
x^2

## [1]  1  4  9 16 25

Does, \(x^2\) produce what you expect?

Student: Yes, I think it does! From here, I think I can just square, sum, and then find the difference. I’ll try that out:

sum(evens^2) - sum(odds^2)

## [1] 5050

I get 5050, does that make sense?

Me: That’s what I have too.

Challenge accepted

I’ll end by noting that the author points out that the answer to this problem is identical to “What’s the sum of all numbers 1 to 100?” I thought that I’d prove that for fun.

So, we are looking for the sum of all the even numbers squared between 1 and 100, subtracted by the sum of all the odd numbers squared on the same interval. We can write the solution \(S\) as:

\[S = \sum_{n=1}^{50} (2n)^2 - \sum_{n=1}^{50} (2n-1)^2 = \sum_{n=1}^{50} \left[(2n)^2 - (2n-1)^2\right]\]

The term in the square brackets matches the form for the difference of squares. Let’s use that to re-write:

\[S = \sum_{n=1}^{50} \left[\left(2n - (2n-1)\right)\left(2n + (2n-1)\right) \right]\]

This simplifies to:

\[S = \sum_{n=1}^{50} \left[\left(1\right)\left(2n + (2n-1)\right) \right]\]

The 1 can just go away, and let’s split the sum apart again:

\[S = \sum_{n=1}^{50} 2n + \sum_{n=1}^{50} (2n-1)\]

The first term is just the sum of all even numbers between 1 and 100, and the second term is the sum of all odd numbers between 1 and 100. Therefore:

\[S = \sum_{n=1}^{100} n = \frac{100(100+1)}{2} = 5050\]

I should note that this result requires that the maximum term must be even. For example, the sum of all numbers from 1 to 99 is 4950. But, the same question (evens^2 - odds^2) for 1:99 is somewhat different:

sum(seq(2,99,2)^2) - sum(seq(1,99,2)^2)

## [1] -4950

To re-cast the proof for an odd max value, I’d have to include zero as a term for the evens:

\[S' = \sum_{n=0}^{49} (2n)^2 - \sum_{n=0}^{49} (2n+1)^2 = \sum_{n=0}^{49} \left[(2n)^2 - (2n+1)^2\right]\]

And note that the left hand term simplifies to -1…

\[S' = \sum_{n=0}^{49} \left[\left(-1\right)\left(2n + (2n+1)\right) \right]\]

So, for an odd max value, the answer is just -1 times the sum of all values up to that max value.

\[S' = - \sum_{n=0}^{99} n = - \frac{99(99+1)}{2} = -4950\]

This was just too cool not to write up.

Three Strikes and score

2021-06-21T00:00:00+00:00

The riddle

Scoring in bowling can be a tricky matter. There are 10 frames, and in each frame you get two chances to knock down as many of the 10 pins as you can. Each pin knocked down is worth 1 point, and the pins are reset after each frame. Your score is then the sum of the scores across all 10 frames.

If only it were that simple. There are special rules for spares (when you’ve knocked down all 10 pins with the second ball of a frame) and strikes (when you knock down all 10 pins with your first ball). Whenever you bowl a strike, that frame is scored as 10 plus the scores of your next two rolls. This can lead to some dependency issues at the end of the game, which means the final frame has its own set of rules that I won’t go into here.

For example, if you bowled three strikes and missed every subsequent shot (i.e., they were gutter balls), your third frame would be worth 10 points, your second frame would be worth 20 and your first frame 30. Your final score would be 30 + 20 + 10, or 60 points.

This week, Magritte is going bowling, and the bowling gods have decided that he will bowl exactly three strikes in three randomly selected frames. All the other frames will consist of nothing but gutter balls. Magritte also lacks patience for bowling’s particular rules. If one of his three strikes comes on the 10th and final frame and he is prompted to bowl further to complete the game, he will bowl gutter balls out of frustration.

What score can Magritte expect to achieve? (That is, with three randomly placed strikes, what is his average score?)

Functions and background

Some of the assumptions that we have made (either a frame is a strike, or a double gutter ball) make coding a bowling score calculator that can handle other cases superflouous. What we will do first is generate all possible “games” that Magritte could have. Basically, we need to calculate all possible permutations of this “game”:

(baseGame = c(rep('S',3),rep('G',7)))

##  [1] "S" "S" "S" "G" "G" "G" "G" "G" "G" "G"

Here each letter is the result from a frame, where “S” indicates a strike and “G” indicates a gutter ball. Let’s generate permutations:

gamePerms = function(nStrike, nGutter){
    nTot = nStrike + nGutter
    if(nStrike < 1){
        return(matrix(rep('G',nGutter),nrow=1))
    }else if(nGutter < 1){
        return(matrix(rep('S',nStrike),nrow=1))
    }else{
        res = matrix(nrow = 0, ncol = nTot)
        res = rbind(res, cbind('S',gamePerms(nStrike = nStrike - 1, nGutter = nGutter)))
        res = rbind(res, cbind('G',gamePerms(nStrike = nStrike, nGutter = nGutter - 1)))
        return(res)
    }
}

Next, I’m going to parse each string looking for the following patterns:

SSS will be replaced by TDS. (Triple, Double, Single)
SS will be replaced by DS. (Double, Single)

Note: This substitution pattern won’t work if there is a chance that there can be 4 strikes in a row.

scoreStrings = function(scoStr){
    scoStr = gsub('SSS','TDS',scoStr)
    scoStr = gsub('SS','DS',scoStr)
    return(scoStr)
}

This way, we can make scores by counting a T as 30 points, a D as 20 points, a S as 10 points, and a G as 0 points. Then we add.

scoreSubs = function(scoLett){
    sco = ifelse(scoLett=='T',30,
                 ifelse(scoLett=='D',20,
                        ifelse(scoLett=='S',10,0)))
    return(sco)
}

Results

Let’s generate all of the possible games and convert them into strings:

possGames = gamePerms(nStrike = 3, nGutter = 7)
possGameStr = apply(possGames, 1, function(x) paste(x,collapse=""))

Now, let’s make the substitutions:

adjStrings = scoreStrings(possGameStr)
frameScores = matrix(scoreSubs(unlist(strsplit(adjStrings,''))),ncol=10,byrow = TRUE)
gameScores = rowSums(frameScores)

The average game score is: 36.6666667.

There are three different scores that can be achieved:

60 (all three strikes in a row) occurs 8 times. (TDS pattern)
40 (two strikes in a row, third strike not consecutive) occurs 56 times. (DS - S or S - DS pattern)
30 (all three strikes have at least one gutter-ball between them) occurs 56 times.

Learning some Scratch in a week

2021-05-20T21:10:43+00:00

This post is aimed at my son, David, and his friend, Andrew who have some free time in school after testing is done. I think they’ll have some fun getting to know how to use the different Scratch things, and figuring out how to solve some fun problems. Depending on how much time you have, try accomplishing 1 or 2 goals per day.

Goal #1: Make a scene

I want you to make a scene with a custom background and custom sprite. It should not be one of the pre-made scenes or sprites that you have access to. I also want you to put the sprite in motion. Be creative and make something cool. Here are some ideas:

Make a scene from an old western movie, a dusty town with a tumbleweed blowing through.
Make a “family portrait” with an action component. (Maybe you are doing something to bug a sibling or giving your parent bunny ears and then hiding them)
Make a scene where a car crashes into the side.
Make a house with a sun traveling across the sky.
Pick something else that is more creative!

Here’s a tutorial that shows you how to create your own background and sprite.

Goal #2: Draw some shapes!

Write a code where the sprite (whatever you want) draws the following shapes:

If you press 1, draw a equilateral triangle
If you press 2, draw a square
If you press 3, draw a (regular) pentagon (5 sides)
If you press 4, draw a (regular) hexagon (6 sides)
If you press 5, draw a (regular) heptagon (7 sides)
If you press 6, draw a (regular) octagon (8 sides)
If you press 7, draw a triangular squiral (see tutorial)
If you press 8, draw a square squiral (see tutorial)
If you press 9, draw a star

(A hint about the star. There is a pentagon hidden on the inside. What happens if you take the code you used to make the pentagon, copy it for the star, but change the turning angle and make it bigger?)

Goal #3: Make a version of the “Dog and Crab” game described in this video.

Change the characters and make a cooler scene!

Goal #4: Make your own version of pong (part 1)

Make a version of pong. Don’t worry about keeping score. To do this, you’ll need to:

Create a paddle that is controlled by the arrows for player 1
Create a paddle that is controlled by other keys for player 2 (Often we use wasd keys as they sort-of resemble the arrow pad)
Create a ball that bounces off of the paddles. (Don’t worry about the walls yet, we’ll do that tomorrow)

Goal #5: Variables

Make a simple jumping game!

Goal #6: Make your own version of pong (part 2)

Now let’s finish the pong game:

Stop the game when the ball hits the side wall
Keep score! First one to 10 wins!!!

Goal #7: Make a Game of your own design

Make a game of your own design. Some ideas:

Make a maze game
Make a sequence memory game
Make a concentration game
Make a SNAKE game. This page has code that shows you how to make the snake not run into itself.
Shoot some hoops!
Make Asteroids!

Finish at least one of these before you make a different type of game. If you make a game of your own, make a picture (on paper) like the one below that helps you identify what all you will need in order to make the game work.

Enigmerica election

2021-04-26T00:00:00+00:00

Erratum: See my new post where I fix a glaring error.

The riddle

This week’s riddle:

Riddler Nation’s neighbor to the west, Enigmerica, is holding an election between two candidates, A and B. Assume every person in Enigmerica votes randomly and independently, and that the number of voters is very, very large. Moreover, due to health precautions, 20 percent of the population decides to vote early by mail.

On election night, the results of the 80 percent who voted on Election Day are reported out. Over the next several days, the remaining 20 percent of the votes are then tallied.

What is the probability that the candidate who had fewer votes tallied on election night ultimately wins the race?

Functions and background

I’m not going to use many custom functions to solve this one. Essentially, the fact that votes are random and independant suggests that we should use the normal distribution. So let’s do that. In R, the functions are in the norm family. I will use two in particular:

dnorm(x,mu,sigma) is the probability to have a value \(x\), drawn from the normal distribution with mean \(\mu\) and standard deviation \(\sigma\). This is often referred to as a probability density.

\[d(x) = \frac{1}{\sigma \sqrt{2\pi}} \exp\left(-\frac{1}{2}\frac{\left(x-\mu\right)^2}{\sigma^2}\right)\]

pnorm(x,mu,sigma) is the probability that a value drawn from a distribution with the same mean and standard deviation as before is less than or equal to \(x\).

\[p(x) = \int_{-\infty}^{x} d(x') dx'\]

Results

Let’s define a few variables:

\(m_1\), this is the percent margin of the leading candidate on election night, based on election night results. (Therefore, \(m_1>0\) by definition.)
\(m_2\), this is the percent margin of the leading candidate on election night, based on mail-in voting results. (In general, this can be both, positive and negative)
\(m\) is the overall margin.

Based on the problem definition, we can say:

\[m = 0.8 m_1 + 0.2 m_2\]

If \(m<0\), we can say that the election night result flipped. In order for that to happen,

\[m_2 < -4 m_1\]

So, to determine the probability to flip, I need to know the probability for a candidate to have a margin \(m_1>0\) on election night and a margin \(m_2 < -4m_1\) in the mail-in voting, integrated over all possible voting margins \(m_1\).

\[P_{\text{flip}} = \int_0^\infty d(m_1) p(-4m_1) dm_1\]

Note, that we can simply use the standard \(\mu = 0\) and \(\sigma = 1\) choices for the normal distribution as the actual percent margins can be normalized, and the scaling factor drops out of the margin inequality above. Let’s just integrate numerically.

dm = 0.0001
margins = seq(0,1000,dm)
probFlip = sum(dm * dnorm(margins) * pnorm(-4*margins))

The probability that the result flips is 3.9%. (Here’s more digits if you want them: 0.0389995.) Not incredibly likely, but not so infrequent that it’s occurrence should instigate an investigation culminating in a 39+ minute youtube video into what is not likely. Suffice it to say, this is nowhere near the 10 billion human second century threshhold Matt Parker discusses in that video (also below).

Note: In a previous version of this post, I inverted the meaning of the dnorm and pnorm functions. I ran a quick check to convince myself that I was right, and got a result that I didn’t expect. Note the output of these calculations:

dnorm(1000)

## [1] 0

pnorm(1000)

## [1] 1

The first line shows that the distribution falls off to zero at \(x=\mu + 1000 \sigma\), and that the probability for \(x \leq \mu + 1000\sigma\) is 1 (to the standard floating point precision available in R).