---
title: "Does being on the podium affect Formula 1 drivers' performance in the next race?"
author: "R. K. S. Hankin"
output: bookdown::html_document2
bibliography: hyper2.bib  # copy vignettes/hyper2.bib to inst/
---


```{r setup, include=FALSE}
set.seed(0)
knitr::opts_chunk$set(echo = TRUE)
library("hyper2")
options("digits" = 5)
```

```{r out.width='20%', out.extra='style="float:right; padding:10px"',echo=FALSE}
knitr::include_graphics(system.file("help/figures/hyper2.png", package = "hyper2"))
```

To cite the `hyper2` package in publications, please use @hankin2017_rmd.
This short document defines the `podium()` function which tests the
hypothesis that a Formula 1 driver's being on the podium at one venue
affects his performance on the next.  Data from the 2007 season are
used.  It uses `hyper3` objects from the `hyper2` package.  A detailed
use-case for the top six drivers (Alonso, Hamilton, Heidfeld, Kubica,
Massa, and Raikkonen), and only the first five venues (Austria,
Malaysia, Bahrain, Spain, and Monaco) is given.  

***TLDR***: Statistically significant evidence for the podium effect
was found, with about 2.7 units of support for the alternative.

Function `podium()`, defined below, takes a race table and a value of
$\lambda$ and returns a `hyper3` support function.

```{r,label=definepodiumfun}
podium <- function (lambda,x,print=FALSE){
     noscore <- c("Ret", "WD", "DNS", "DSQ", "DNP", "NC", "DNQ", "EX", "Sick")
     venues <- colnames(x)
     jj <- apply(x, 2, function(y) {
         if (any(y %in% noscore)) {
             y[y %in% noscore] <- 0
         }
         return(y)
     })
     fmat <- matrix(as.numeric(jj), byrow = TRUE, ncol = nrow(x))
     colnames(fmat) <- rownames(x)
     rownames(fmat) <- venues

     o <- fmat[1, , drop = TRUE]
     o[o > 0] <- rank(o[o > 0])
     out <- as.hyper3(ordervec2supp(o))
     for (i in seq(from=2,to=nrow(fmat))){
       if(print){cat(paste(i,"/",nrow(fmat),"\n"))}
       yesterday <- fmat[i-1, , drop = TRUE]
       yesterday[yesterday > 0] <- rank(yesterday[yesterday > 0])  # 'incomplete' functionality of ordertable2supp()
       podium_yesterday <- names(which((yesterday <= 3) & (yesterday>0)))
       d <- fmat[i, , drop = TRUE] # today
       d[d > 0] <- rank(d[d > 0])  # This is the 'incomplete' functionality of ordertable2supp()
       ## Following lines lifted from ordervec2supp()
       nd <- names(d)
       while (any(d > 0)) {
         eligible <- which(d >= 0)
         winner <- nd[d == 1]  # that is, the winner of those still racing
         if(winner %in% podium_yesterday){
           jj <- lambda
         } else {
           jj <- 1
         }
         names(jj) <- winner
         out[jj] %<>% inc    # numerator

         ## Now denominator
         jj <- rep(1,length(eligible))
         jj[nd[eligible] %in% podium_yesterday] <- lambda
         names(jj) <- names(eligible)
         out[jj] %<>% dec  # denominator
         
         d[d == 1] <- -1
         d[d > 0] %<>% dec
       } # ordervec2supp() lookalike closes
     }  # i loop closes
     return(out)
}
```



Define a subset of it:

```{r, definesubset}
a <- read.table("formula1_2007.txt",header=TRUE)
a <- a[,seq_len(ncol(a)-1)]
b <- a[1:6,1:5]
b[,1] <- 1:6
b[,2] <- c(4,5,6,1,2,3)
b[,3] <- c(5,6,4,2,3,1)

b[,5] <- c(1,2,4,3,8,6)  # tests the 'incomplete' functionality of podium()
b
```

```{r,usepodiu,cache=TRUE}
Ha <- podium(1.4,b)
Hb <- podium(1.5,b)
ma <- maxp(Ha,give=TRUE,n=1)
mb <- maxp(Hb,give=TRUE,n=1)
```

```{r}
Ha
Hb
ma
mb
```


```{r,usefuns,cache=TRUE}
fun <- function(lambda){maxp(podium(lambda,b),give=TRUE)$value}
lam <- seq(from=0.5,to=2,len=6)
like <- lapply(lam,fun)
```


```{r, plotlik}
like <- unlist(like)
plot(lam,like-max(like),type='b')
like
```

Now a real dataset, Formula 1 2007 season:

```{r,load2007}

a <- read.table("formula1_2007.txt",header=TRUE)
a <- a[1:10,seq_len(ncol(a)-1)]  # rows Raikkonen (1) through Coulthard (10)
options(width=90)
a
```

```{r,definepodlike}
podlike <- function(lambda){maxp(podium(lambda=lambda,a),n=1,give=TRUE)$value}
```


```{r,usepodlike10,cache=TRUE}
podlike(1.8)
podlike(1.9)
```

```{r,podlikevec7,cache=TRUE}
date()
lam <- seq(from=0.2,to=1.2,len=7)
like <- lapply(lam,podlike)
date()
```


```{r,plotpodlike}
like <- unlist(like)
plot(lam,like-max(like),type="b")
abline(h=c(0,-2))
abline(v=1)
```


### References {-}