The Kentucky Derby is on Saturday, and a field of 20 horses is slated to run “the fastest two minutes in sports” in pursuit of the right to be draped with a blanket of roses. But let’s consider, instead, the Lucky Derby, where things are a little more bizarre:

The bugle sounds, and 20 horses make their way to the starting gate for the first annual Lucky Derby. These horses, all trained at the mysterious Riddler Stables, are special. Each second, every Riddler-trained horse takes one step. Each step is exactly one meter long. But what these horses exhibit in precision, they lack in sense of direction. Most of the time, their steps are forward (toward the finish line) but the rest of the time they are backward (away from the finish line). As an avid fan of the Lucky Derby, you’ve done exhaustive research on these 20 competitors. You know that Horse One goes forward 52 percent of the time, Horse Two 54 percent of the time, Horse Three 56 percent, and so on, up to the favorite filly, Horse Twenty, who steps forward 90 percent of the time. The horses’ steps are taken independently of one another, and the finish line is 200 meters from the starting gate.

Handicap this race and place your bets! In other words, what are the odds (a percentage is fine) that each horse wins?

Extra credit: Animate this derby. I’ll broadcast the highlights next week.

This week I only had time to do the extra credit.

library(tidyverse)
library(gganimate)

horses <- 1:20

f <- function(horse){
  weights = c(0.5 + 0.02*horse, 0.5 - 0.02*horse)
  step = sample(c(1,-1), 1, prob = weights)
  return(step)
}

raceDf <- function(){
  pos <- replicate(20,0)
  race <- list(pos)
  
  while (max(unlist(race)) < 200){
    step <- c()
    for (horse in horses){
      step <- c(step,f(horse))
    }
    pos <- pos + step
    race <- c(race,list(pos))
  }
  names(race) <- 0:(length(race)-1)
  return(data.frame(race))
}

Here I simulate a race and plot it.

race <- raceDf()

race <- (data.frame(t(race)))

colnames(race) <- 1:20
rownames(race) <- 1:length(rownames(race))
race$Step <- as.numeric(rownames(race))

raceGathered <- gather(race, key = 'horse', value ='Distance', -Step)

ggplot(raceGathered, aes(x = Step, y = Distance, group = factor(horse, levels = as.numeric(horse)), 
                         color = factor(horse, levels = as.numeric(horse) ) )) + 
  geom_line() +
  theme(legend.position = 'bottom') +
  guides(colour = guide_legend(nrow = 2, title = 'Horse')) 

And we can also animate the race. Go banana!

p <- ggplot(raceGathered, aes(x = factor(horse, levels = as.numeric(horse)),
                              y = Distance, 
                              frame = Step,
                              color = factor(horse, levels = as.numeric(horse)))) +
  geom_point(size = 5) + 
  theme(legend.position = 'none') + 
  labs(x = 'Horse')#, y = 'Position')

gganimate(p, interval = 0.1)