Responding to my question about graphing horse race results, Megan Pledger writes:
While waiting up late to snipe at an internet auction, I put together some simple data of a horse race and used ggplot to plot it. It’s discrete time race data rather than continuous time and has very simple choice options for the horse. The graph is a starting point!
[The picture doesn’t fully fit on the blog window here; right-click and select “view image” to see the whole thing.]
My reply: Very nice–thanks! I won’t look a gift horse in the mouth . . . but if I were to be picky, I’d suggest making the tods smaller, the lines thinner, and the colors of the five horses more distinct. All these tricks should make the lines easier to follow. I’d also suggest gray rather than black for the connecting lines.
I think I’d also supplement it with a blown-up version of the last bit (from 80-100 on the x-axis), since that’s where some interesting things are happening.
And here’s the code:
library(ggplot2)
set.seed(1)
race.track<-matrix(0,10,100) #x,y pos of every point on track
horse.pos<-matrix(0,5,2) #x,y pos of 5 horses
race<-matrix(0,800,4) #keeps the time and position of each horse
race.pos<-0 #indexes the race matrix
close<-matrix(0,5,1) #distance to objective for setting who moves first
timeh<-1 #start at time 1
# can go 1 or 2 moves straight ahead at one time point
# more likely to go 1 move on a bend
go.straight<-function(race.track,old.pos,bend) {
if (bend) dist<-rbinom(1,1,prob=0.25)
if (!bend) dist<-rbinom(1,1,prob=0.75)
new.pos<-old.pos+matrix(c(0,1+dist),1,2)
if (new.pos[1,2]>100) new.pos[1,2]<-100
new.pos
}
#head for the rail, only 1 move diag
go.inside<-function(race.track,old.pos) {
new.pos<-old.pos+matrix(c(-1,1),1,2)
if (new.pos[1,1]<1 ) new.pos[1,1]<-1
new.pos
}
#head for space, only 1 move diag
go.outside<-function(race.track,old.pos) {
new.pos<-old.pos+matrix(c(1,1),1,2)
if (new.pos[1,1]>10 ) new.pos[1,1]<-10
new.pos
}
# set starting pos of horses and put them on the track
for (i in 1:5) {
horse.pos[i,]<-c(i*2,1)
race.track[horse.pos[i,]]<-1
race.pos<-race.pos+1
race[race.pos,1]<-timeh
race[race.pos,2]<-i
race[race.pos,3:4]<-horse.pos[i,]
}
#while noone is at the finish line do
while (sum(race.track[,100])==0){
#is any horse on a bend?
bend<-(horse.pos[,2]>30&horse.pos[,2]<40)|(horse.pos[,2]>70&horse.pos[,2]<80)
#update time
timeh<-timeh+1
# should the horse be cutting the corner on a bend or charging for the finish line
for (j in 1:5) {
if (bend[j]) close[j]<-((horse.pos[j,1]-1)^2+(horse.pos[j,2]-100)^2)^.5
if (!bend[j]) close[j]<- 100-horse.pos[j,2]
ord<-order(close)
}
#update each horses position starting with the one nearest the objective
for (i in 1:5) {
old.pos<-matrix(horse.pos[ord[i],],1,2)
# on a straight - go straight, if noone is in the way
if (!bend[ord[i]]) {
new.pos<-go.straight(race.track,old.pos,bend[ord[i]])
if (race.track[new.pos]==1) new.pos<-go.outside(race.track,old.pos)
if (race.track[new.pos]==1) new.pos<-go.inside(race.track,old.pos)
}
# on a bend - go to the rail, if noone is in the way
if (bend[ord[i]]) {
new.pos<-go.inside(race.track,old.pos)
if (race.track[new.pos]==1) new.pos<-go.straight(race.track,old.pos,bend[ord[i]])
if (race.track[new.pos]==1) new.pos<-go.outside(race.track,old.pos)
}
#move if not blocked
if (race.track[new.pos]!=1) {
race.track[new.pos]<-1
race.track[old.pos]<-0
horse.pos[ord[i],]<-new.pos
}
#update race details
race.pos<-race.pos+1
race[race.pos,1]<-timeh
race[race.pos,2]<-ord[i]
race[race.pos,3:4]<-horse.pos[ord[i],]
}
}
#keep the actual race movements
mini<-min((1:800)[race[,1]==0])-1
# convert race data to a data frame, jitter across positions so can see all horses "on the rail"
race.df<-data.frame(along=race[1:mini,4],across=jitter(race[1:mini,3]),
timeh=race[1:mini,1],horse=race[1:mini,2])
#sort for plotting paths
race1.df<-race.df[order(race.df$timeh, race.df$across),]
#keep for plotting every 5 time points
race2.df<- race1.df[(round((race1.df$timeh-1)/5)== (race1.df$timeh-1)/5),]
#keep for plotting final position
race3.df<- race1.df[race1.df$timeh==max(race1.df$timeh),]
#do plot
ggplot(race1.df, aes(x = along, y = across, colour =horse)) +
geom_line(aes(group = horse, colour = horse), size = 1.25) +
geom_path(aes(group = timeh), data=race2.df, colour = "grey40", size = 1 )+
geom_path(aes(group = timeh), data=race3.df, colour = "gold", size = 1.5 )+
geom_point(size=3) +
geom_point(data=race3.df,size=5)