How to model the probability of each horse to win in each horse race?

Question

Given a series of past horse races results, and the attributes of each horse which participate in a race, I would like to how to fit the data model to something like glm() in R so as to predict the probability of a horse winning a race. Obviously, in a race, there will be only one winning horse and all the remaining horses are losers. I wonder if I need a hierarchical model using lmer() to fit the properties of the race conditions such as distances, as well as the attributes of a horse participating in the race, such as age, weight-carrying and etc. Any suggestions?

Answer 1

I think you need a two step process. First, estimate the speed of each horse and have distance as one of the factors in the model.

You can then use a multilevel model (hence lmer) with repeated measures on the horses.

Then you have a set of projected speeds for each race (one for each horse). These projected speeds can be used in step 2 to model the probabilities of winning the race. Each speed will have estimated errors, so you could use those.

Answer 2

I have implemented a piece of code which provides me with coefficients later plugged into the logistic equation to create theoretical odds. It is inspired from Developing Statistical Models Of Horse Racing Outcomes Using R written by Dr Alun Owen from the SmartSigger uk magazine starting January 2014

Below the R code :

library(mlogit)

horse.data<-read.csv("TROTforRSansInedit.csv")
horse.data$sexe<-as.factor(horse.data$sexe)
horse.data$deferre<-as.factor(horse.data$deferre) ‘  

unshoed harness horse ………………………………..

model.data<-horse.data[horse.data$raceid<=8000,] 
h.dat<-mlogit.data(data=model.data,choice="win",chid.var="raceid",alt.var="noChev",shape="long")
mul.model<-mlogit(win~sexe+age+nbVic+nbPlac+.........+oDiffAlloc|0|0,data=h.dat)
summary(mul.model)

which provides :

Frequencies of alternatives:
         1          2          3          4          5          6          7          8          9         10 
0.05183612 0.06257807 0.06557582 0.06832376 0.07556832 0.07669248 0.07406945 0.07819136 0.07007245 0.06907320 
        11         12         13         14         15         16         17         18         19         20 
0.06657507 0.06107919 0.05296028 0.04871346 0.03235074 0.02810392 0.00924307 0.00811891 0.00037472 0.00049963 
nr method
5 iterations, 0h:1m:7s     g'(-H)^-1g = 6.38E-07       gradient close to zero 

Coefficients :
                   Estimate  Std. Error  t-value  Pr(>|t|)    
sexe2           -4.0103e-01  4.4405e-02  -9.0312 < 2.2e-16 ***
sexe3           -1.4602e-01  3.7419e-02  -3.9021 9.535e-05 ***
age             -2.7558e-01  2.7615e-02  -9.9794 < 2.2e-16 ***
nbVic            4.6575e-02  6.3964e-03   7.2814 3.304e-13 ***
nbPlac          -2.0636e-02  4.8074e-03  -4.2926 1.766e-05 
pcVict           7.3494e-01  1.1072e-01   6.6377 3.185e-11 *
deferre1         3.9375e-01  1.1473e-01   3.4320 0.0005991 ***
……………………………..
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Log-Likelihood: -17661

Then, using the most significant coefficients, I plug them with the following vba code (excerpt):

Private Sub ComputeCteThForOneRace(ByVal idebCourse As Long, ByVal ifinCourse As Long)
    Dim wfd As Worksheet
    Dim icol, irow, i, j, k, m, n, t, v
    Dim Vtemp, tmp1, nbEmptyLines, musique
    Dim curParam As String
    Dim totExpV, ExpV
    Set wfd = Worksheets("Fdata")
    For i = idebCourse To ifinCourse
          v = 0
          If wfd.Cells(i, iChevMusique) <> "Inédit" Then ‘ has never raced
             For j = iChevSexe To ioDiffAlloc
              ‘ Vtemp is assigned with significant coefficient values found earlier  
Vtemp = 0
                 curParam = wfd.Cells(i, j)  ‘ current parameter
                 Select Case j
                     Case iChevSexe
                         Select Case curParam
                             Case "F"
                                 Vtemp = -0.40105
                             Case "H"
                                 Vtemp = -0.14503
                             Case Else
                         End Select
                     Case iChevAge
                          If IsNumeric(curParam) Then
                                 Vtemp = -0.27329 * curParam
                          End If
                     Case iChevNbVict
                          If IsNumeric(curParam) Then
                                 Vtemp = 0.04659 * curParam
                          End If
    …………………………………………..
                       Case Else
                         End Select
                 End Select
                 wfd.Cells(i, iV) = Vtemp  
                 v = v + Vtemp  ‘ logistic equation is built 
             Next

             wfd.Cells(i, iV) = v
             wfd.Cells(i, iexpV) = Exp(v)
             totExpV = totExpV + Exp(v)
          Else  ' Inédit (new horse)
             wfd.Cells(i, iexpV) = 0.1
          End If
    Next
    For i = idebCourse To ifinCourse
         wfd.Cells(i, iexpV + 1) = wfd.Cells(i, iexpV) / totExpV
         wfd.Cells(i, iCteTh) = 1 + (1 - wfd.Cells(i, iexpV + 1)) / wfd.Cells(i, iexpV + 1)
         If wfd.Cells(i, iCteTh) > 900 Then wfd.Cells(i, iCteTh) = 900
    Next
    For i = idebCourse To ifinCourse  ' ranking cteTh
wfd.Cells(i, ioCteTh) = Application.WorksheetFunction.Rank(wfd.Cells(i, iCteTh),   wfd.Range(wfd.Cells(idebCourse, iCteTh), wfd.Cells(ifinCourse, iCteTh)), 1)
    Next

Finally, the wfd.Cells(i, iCteTh) and wfd.Cells(i, ioCteTh) columns contain the Theoretical odds and their rank At the last minute, the wfd.Cells(i, iCteLive) column is filled with the odds (done by a program) before the race starts. Only horses whose wfd.Cells(i, iCteLive) / wfd.Cells(i, iCteTh) ratio is at least >1 are considered for a bet.