To cite the hyper2 package in publications, please use Hankin (2017).
x <- readLines("grid_2025.txt")
drivers <- function(i){strsplit(x[i], " ")[[1]][-1]}
venue <- function(i){strsplit(x[i], " ")[[1]][ 1]}
drivers(11)
## [1] "Norris" "Leclerc" "Piastri" "Hamilton" "Russell"
## [6] "Lawson" "Verstappen" "Bortoleto" "Antonelli" "Gasly"
## [11] "Alonso" "Albon" "Hadjar" "Colapinto" "Bearman"
## [16] "Stroll" "Ocon" "Tsunoda" "Sainz" "Hulkenberg"
allvenues <- sapply(1:24,venue)
alldrivers <- NULL
for(i in 1:24){alldrivers <- c(alldrivers,drivers(i))}
alldrivers <- sort(unique(alldrivers))
M <- matrix(0,nrow=24, ncol=length(alldrivers))
colnames(M) <- alldrivers
rownames(M) <- allvenues
for(i in 1:24){M[i,] <- alldrivers %in% drivers(i) }
M
## Albon Alonso Antonelli Bearman Bortoleto Colapinto Doohan Gasly Hadjar
## AUS 1 1 1 1 1 0 1 1 1
## CHN 1 1 1 1 1 0 1 1 1
## JPN 1 1 1 1 1 0 1 1 1
## BHR 1 1 1 1 1 0 1 1 1
## SAU 1 1 1 1 1 0 1 1 1
## MIA 1 1 1 1 1 0 1 1 1
## EMI 1 1 1 1 1 1 0 1 1
## MON 1 1 1 1 1 1 0 1 1
## ESP 1 1 1 1 1 1 0 1 1
## CAN 1 1 1 1 1 1 0 1 1
## AUT 1 1 1 1 1 1 0 1 1
## GBR 1 1 1 1 1 1 0 1 1
## BEL 1 1 1 1 1 1 0 1 1
## HUN 1 1 1 1 1 1 0 1 1
## NED 1 1 1 1 1 1 0 1 1
## ITA 1 1 1 1 1 1 0 1 1
## AZE 1 1 1 1 1 1 0 1 1
## SIN 1 1 1 1 1 1 0 1 1
## USA 1 1 1 1 1 1 0 1 1
## MXC 1 1 1 1 1 1 0 1 1
## SAP 1 1 1 1 1 1 0 1 1
## LVG 1 1 1 1 1 1 0 1 1
## QAT 1 1 1 1 1 1 0 1 1
## ABU 1 1 1 1 1 1 0 1 1
## Hamilton Hulkenberg Lawson Leclerc Norris Ocon Piastri Russell Sainz Stroll
## AUS 1 1 1 1 1 1 1 1 1 1
## CHN 1 1 1 1 1 1 1 1 1 1
## JPN 1 1 1 1 1 1 1 1 1 1
## BHR 1 1 1 1 1 1 1 1 1 1
## SAU 1 1 1 1 1 1 1 1 1 1
## MIA 1 1 1 1 1 1 1 1 1 1
## EMI 1 1 1 1 1 1 1 1 1 1
## MON 1 1 1 1 1 1 1 1 1 1
## ESP 1 1 1 1 1 1 1 1 1 1
## CAN 1 1 1 1 1 1 1 1 1 1
## AUT 1 1 1 1 1 1 1 1 1 1
## GBR 1 1 1 1 1 1 1 1 1 1
## BEL 1 1 1 1 1 1 1 1 1 1
## HUN 1 1 1 1 1 1 1 1 1 1
## NED 1 1 1 1 1 1 1 1 1 1
## ITA 1 1 1 1 1 1 1 1 1 1
## AZE 1 1 1 1 1 1 1 1 1 1
## SIN 1 1 1 1 1 1 1 1 1 1
## USA 1 1 1 1 1 1 1 1 1 1
## MXC 1 1 1 1 1 1 1 1 1 1
## SAP 1 1 1 1 1 1 1 1 1 1
## LVG 1 1 1 1 1 1 1 1 1 1
## QAT 1 1 1 1 1 1 1 1 1 1
## ABU 1 1 1 1 1 1 1 1 1 1
## Tsunoda Verstappen
## AUS 1 1
## CHN 1 1
## JPN 1 1
## BHR 1 1
## SAU 1 1
## MIA 1 1
## EMI 1 1
## MON 1 1
## ESP 1 1
## CAN 1 1
## AUT 1 1
## GBR 1 1
## BEL 1 1
## HUN 1 1
## NED 1 1
## ITA 1 1
## AZE 1 1
## SIN 1 1
## USA 1 1
## MXC 1 1
## SAP 1 1
## LVG 1 1
## QAT 1 1
## ABU 1 1
rowSums(M)
## AUS CHN JPN BHR SAU MIA EMI MON ESP CAN AUT GBR BEL HUN NED ITA AZE SIN USA MXC
## 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
## SAP LVG QAT ABU
## 20 20 20 20
colSums(M)
## Albon Alonso Antonelli Bearman Bortoleto Colapinto Doohan
## 24 24 24 24 24 18 6
## Gasly Hadjar Hamilton Hulkenberg Lawson Leclerc Norris
## 24 24 24 24 24 24 24
## Ocon Piastri Russell Sainz Stroll Tsunoda Verstappen
## 24 24 24 24 24 24 24
Above we see that Colapinto and Doohan were the only drivers that did not compete at every venue. We will have to remove these two drivers from the data:
grid_order <- list()
unwanted <- c("Colapinto", "Doohan")
for(i in 1:24){
jj <- drivers(i)
grid_order[[i]] <- jj[!(jj %in% unwanted)]
}
grid_order
## [[1]]
## [1] "Norris" "Piastri" "Verstappen" "Russell" "Tsunoda"
## [6] "Albon" "Leclerc" "Hamilton" "Gasly" "Sainz"
## [11] "Hadjar" "Alonso" "Stroll" "Bortoleto" "Antonelli"
## [16] "Hulkenberg" "Lawson" "Ocon" "Bearman"
##
## [[2]]
## [1] "Piastri" "Russell" "Norris" "Verstappen" "Hamilton"
## [6] "Leclerc" "Hadjar" "Antonelli" "Tsunoda" "Albon"
## [11] "Ocon" "Hulkenberg" "Alonso" "Stroll" "Sainz"
## [16] "Gasly" "Bearman" "Bortoleto" "Lawson"
##
## [[3]]
## [1] "Verstappen" "Norris" "Piastri" "Leclerc" "Russell"
## [6] "Antonelli" "Hadjar" "Hamilton" "Albon" "Bearman"
## [11] "Gasly" "Alonso" "Lawson" "Tsunoda" "Sainz"
## [16] "Hulkenberg" "Bortoleto" "Ocon" "Stroll"
##
## [[4]]
## [1] "Piastri" "Leclerc" "Russell" "Gasly" "Antonelli"
## [6] "Norris" "Verstappen" "Sainz" "Hamilton" "Tsunoda"
## [11] "Hadjar" "Alonso" "Ocon" "Albon" "Hulkenberg"
## [16] "Lawson" "Bortoleto" "Stroll" "Bearman"
##
## [[5]]
## [1] "Verstappen" "Piastri" "Russell" "Leclerc" "Antonelli"
## [6] "Sainz" "Hamilton" "Tsunoda" "Gasly" "Norris"
## [11] "Albon" "Lawson" "Alonso" "Hadjar" "Bearman"
## [16] "Stroll" "Hulkenberg" "Ocon" "Bortoleto"
##
## [[6]]
## [1] "Verstappen" "Norris" "Antonelli" "Piastri" "Russell"
## [6] "Sainz" "Albon" "Leclerc" "Ocon" "Tsunoda"
## [11] "Hadjar" "Hamilton" "Bortoleto" "Lawson" "Hulkenberg"
## [16] "Alonso" "Stroll" "Bearman" "Gasly"
##
## [[7]]
## [1] "Piastri" "Verstappen" "Russell" "Norris" "Alonso"
## [6] "Sainz" "Albon" "Stroll" "Hadjar" "Gasly"
## [11] "Leclerc" "Hamilton" "Antonelli" "Bortoleto" "Lawson"
## [16] "Hulkenberg" "Ocon" "Bearman" "Tsunoda"
##
## [[8]]
## [1] "Norris" "Leclerc" "Piastri" "Verstappen" "Hadjar"
## [6] "Alonso" "Hamilton" "Ocon" "Lawson" "Albon"
## [11] "Sainz" "Tsunoda" "Hulkenberg" "Russell" "Antonelli"
## [16] "Bortoleto" "Gasly" "Stroll" "Bearman"
##
## [[9]]
## [1] "Piastri" "Norris" "Verstappen" "Russell" "Hamilton"
## [6] "Antonelli" "Leclerc" "Gasly" "Hadjar" "Alonso"
## [11] "Albon" "Bortoleto" "Lawson" "Stroll" "Bearman"
## [16] "Hulkenberg" "Ocon" "Sainz" "Tsunoda"
##
## [[10]]
## [1] "Russell" "Verstappen" "Piastri" "Antonelli" "Hamilton"
## [6] "Alonso" "Norris" "Leclerc" "Albon" "Hulkenberg"
## [11] "Hadjar" "Bearman" "Ocon" "Bortoleto" "Sainz"
## [16] "Stroll" "Tsunoda" "Lawson" "Gasly"
##
## [[11]]
## [1] "Norris" "Leclerc" "Piastri" "Hamilton" "Russell"
## [6] "Lawson" "Verstappen" "Bortoleto" "Antonelli" "Gasly"
## [11] "Alonso" "Albon" "Hadjar" "Bearman" "Stroll"
## [16] "Ocon" "Tsunoda" "Sainz" "Hulkenberg"
##
## [[12]]
## [1] "Verstappen" "Piastri" "Norris" "Russell" "Hamilton"
## [6] "Leclerc" "Alonso" "Gasly" "Sainz" "Antonelli"
## [11] "Tsunoda" "Hadjar" "Albon" "Ocon" "Lawson"
## [16] "Bortoleto" "Stroll" "Bearman" "Hulkenberg"
##
## [[13]]
## [1] "Norris" "Piastri" "Leclerc" "Verstappen" "Albon"
## [6] "Russell" "Tsunoda" "Hadjar" "Lawson" "Bortoleto"
## [11] "Ocon" "Bearman" "Gasly" "Hulkenberg" "Stroll"
## [16] "Sainz" "Hamilton" "Antonelli" "Alonso"
##
## [[14]]
## [1] "Leclerc" "Piastri" "Norris" "Russell" "Alonso"
## [6] "Stroll" "Bortoleto" "Verstappen" "Lawson" "Hadjar"
## [11] "Bearman" "Hamilton" "Sainz" "Antonelli" "Gasly"
## [16] "Ocon" "Hulkenberg" "Albon" "Tsunoda"
##
## [[15]]
## [1] "Piastri" "Norris" "Verstappen" "Hadjar" "Russell"
## [6] "Leclerc" "Hamilton" "Lawson" "Sainz" "Alonso"
## [11] "Antonelli" "Tsunoda" "Bortoleto" "Gasly" "Albon"
## [16] "Hulkenberg" "Ocon" "Stroll" "Bearman"
##
## [[16]]
## [1] "Verstappen" "Norris" "Piastri" "Leclerc" "Russell"
## [6] "Antonelli" "Bortoleto" "Alonso" "Tsunoda" "Hamilton"
## [11] "Bearman" "Hulkenberg" "Sainz" "Albon" "Ocon"
## [16] "Stroll" "Lawson" "Hadjar" "Gasly"
##
## [[17]]
## [1] "Verstappen" "Sainz" "Lawson" "Antonelli" "Russell"
## [6] "Tsunoda" "Norris" "Hadjar" "Piastri" "Leclerc"
## [11] "Alonso" "Hamilton" "Bortoleto" "Stroll" "Bearman"
## [16] "Hulkenberg" "Gasly" "Albon" "Ocon"
##
## [[18]]
## [1] "Russell" "Verstappen" "Piastri" "Antonelli" "Norris"
## [6] "Hamilton" "Leclerc" "Hadjar" "Bearman" "Alonso"
## [11] "Hulkenberg" "Lawson" "Tsunoda" "Bortoleto" "Stroll"
## [16] "Ocon" "Sainz" "Gasly" "Albon"
##
## [[19]]
## [1] "Verstappen" "Norris" "Leclerc" "Russell" "Hamilton"
## [6] "Piastri" "Antonelli" "Bearman" "Sainz" "Alonso"
## [11] "Hulkenberg" "Lawson" "Tsunoda" "Gasly" "Bortoleto"
## [16] "Ocon" "Albon" "Stroll" "Hadjar"
##
## [[20]]
## [1] "Norris" "Leclerc" "Hamilton" "Russell" "Verstappen"
## [6] "Antonelli" "Piastri" "Hadjar" "Bearman" "Tsunoda"
## [11] "Ocon" "Sainz" "Hulkenberg" "Alonso" "Lawson"
## [16] "Bortoleto" "Albon" "Gasly" "Stroll"
##
## [[21]]
## [1] "Norris" "Antonelli" "Leclerc" "Piastri" "Hadjar"
## [6] "Russell" "Lawson" "Bearman" "Gasly" "Hulkenberg"
## [11] "Alonso" "Albon" "Hamilton" "Stroll" "Sainz"
## [16] "Tsunoda" "Bortoleto" "Verstappen" "Ocon"
##
## [[22]]
## [1] "Norris" "Verstappen" "Sainz" "Russell" "Piastri"
## [6] "Lawson" "Alonso" "Hadjar" "Leclerc" "Gasly"
## [11] "Hulkenberg" "Stroll" "Ocon" "Bearman" "Albon"
## [16] "Antonelli" "Bortoleto" "Hamilton" "Tsunoda"
##
## [[23]]
## [1] "Piastri" "Norris" "Verstappen" "Russell" "Antonelli"
## [6] "Hadjar" "Sainz" "Alonso" "Gasly" "Leclerc"
## [11] "Hulkenberg" "Lawson" "Bearman" "Bortoleto" "Albon"
## [16] "Tsunoda" "Ocon" "Hamilton" "Stroll"
##
## [[24]]
## [1] "Verstappen" "Norris" "Piastri" "Russell" "Leclerc"
## [6] "Alonso" "Bortoleto" "Ocon" "Hadjar" "Tsunoda"
## [11] "Bearman" "Sainz" "Lawson" "Antonelli" "Stroll"
## [16] "Hamilton" "Albon" "Hulkenberg" "Gasly"
We are going to use the 2025 finishing dataset:
a <- read.table("formula1_2025.txt")
a <- a[1:19,-ncol(a)] # remove Colapinto and Doohan; and the points
We need to iterate through each venue, and use pwa3() to modify the
likelihood function for each one. Then add the log-likelihoods for
each venue together.
geometric <- function(lambda, x){setNames(lambda^(seq_along(x)-1),x)}
f1grid <- function(lambda){
H <- list()
for(i in 1:24){
suppressWarnings(vec <- as.numeric(a[,1]))
vec[is.na(vec)] <- 0
jj <- setNames(vec, rownames(a))
H[[i]] <- ordervec2supp(jj) |> pwa3(geometric(lambda,grid_order[[i]]))
}
out <- hyper3()
for(i in 1:24){
out <- out + H[[i]]
}
return(out)
}
supptime <- system.time(jj <- f1grid(0.5))
maxtime <- system.time(mH <- maxp(jj))
supptime
## user system elapsed
## 16.666 0.001 16.669
maxtime
## user system elapsed
## 22.136 0.002 22.140
mH
## Albon Alonso Antonelli Bearman Bortoleto Gasly Hadjar
## 7.2939e-02 1.5113e-02 6.7986e-02 6.5757e-02 3.7208e-02 6.9300e-02 3.4562e-03
## Hamilton Hulkenberg Lawson Leclerc Norris Ocon Piastri
## 6.0650e-02 7.3282e-02 3.0542e-02 4.1731e-02 6.7222e-02 7.0915e-02 1.9137e-03
## Russell Sainz Stroll Tsunoda Verstappen
## 6.4490e-02 1.0004e-06 7.3259e-02 6.5873e-02 1.1836e-01
pie(mH)
o <- function(lambda){maxp(f1grid(lambda), give=TRUE)$value}
timeo1 <- system.time(l1 <- o(1.01))
timeo2 <- system.time(l2 <- o(1.02))
timeo1
## user system elapsed
## 96.562 0.002 96.573
timeo2
## user system elapsed
## 48.146 0.001 48.151
l1
## [1] -516
l2
## [1] -546.26
lam <- seq(from=0.9, to=1, len=17)
L <- sapply(lam, o)
plot(lam, L - max(L), pch=16, type="b")
Figure 1: Log-likelihood function for lambda, the pole position measure
Figure 1 shows a log-likelihood function for \(\lambda\). It is very irregular, indicating that the optimization routine is having difficulty finding a global maximum for all values of \(\lambda\).
hyper2 Package: Likelihood Functions for Generalized Bradley-Terry Models.” The R Journal 9 (2): 429–39.