Applied Data Science

What makes a driver more likely to score second place in a F1 race?

Data importing and wrangling

# loading required packages

library(dplyr)
library(lubridate)
library(tidyr)
library(caret)
library(readr)

# setting working directory
setwd("D:/QMSS_Spring_2020/AppliedDS")

For this project, I utilized df_races, df_drivers and df_results from Amazon S3 bucket (primarily df_results). I also tried using df_lap_times and df_pit_stops, both of those data frames contained extremely useful information that I thought could be useful to explain why a driver arrives in second place in a given race. Unfortunately, both of those datasets only contained data for more recent years and are missing all of the years prior to 1990s. Therefore, I decided to build the processed data based on those three data frames mentioned above.

# reading data imported from Amazon S3 
df_races <- read_csv("data/races.csv")
df_drivers <- read_csv("data/drivers.csv")
df_results <- read_csv("data/results.csv")
#df_lap_times <- read_csv("data/lap_times.csv")
#df_pit_stops <- read_csv("data/pit_stops.csv")

# removing unrelated variables and combining data frames
df_all <- df_results %>% select(-resultId, -number, -positionText, 
                                    -positionOrder, -time)

df_all <- df_all %>% right_join(df_drivers, by = "driverId") %>% 
                         select(-driverRef, -number, -code, -forename, -surname, 
                                -nationality, -url)

df_all <- df_all %>% right_join(df_races, by = "raceId") %>% 
                     select(-year, -name, -time, -url)

# mutating new feature 'year'
df_all$year <- as.numeric(year(df_all$date))

Initially I chose not to include points from df_results because I thought points is just another presentation of position, thus would make the regression analysis less generalization (and raise multi-collinearity issue). Nevertheless, later I realized the points earned for each position differs in different circuits. Additionally, the correlation ratio between position and points are lower than I assumed (I thought it would be over -0.8). As the consequence, I decided to include points in the following models.

# checking correlation between position and points, as well as mean points earned for each position
cor(df_results$positionOrder, df_results$points)

[1] -0.5665862

df_results %>% group_by(positionOrder) %>% summarise(mean(points))

I’m curious to see whether a driver from a club that has a long history of earning second places is more likely to earn more second places for that constructor. Below I checked the number of second places each constructor earned, then in the following code chunks, I created variable dummy constructor_2nd_place to identify the clubs that had earned second place more than 20 times (if true than the dummy equals 1, otherwise equals 0).

Furthermore, I also wanted to investigate if a driver who had earned second placed is more likely to score another second place. The dummy variable history_2nd_place is set to be 1 if the driver had earned second place in the past.

# number of second place earned for each constructor
df_all %>%  filter(position == 2) %>%
  group_by(constructorId) %>% summarise(n = n()) %>% arrange(desc(n))

# dummy variable second_place_driver, if a driver had earned second place in the past then variable = 1
second_place_driver <- df_all %>%  filter(position == 2, ) %>%
  group_by(driverId) %>% summarise(n = n()) %>% arrange(desc(n))
second_place_driver <- second_place_driver$driverId %>% as.vector()

# creating dummy variables for second place and if the driver completed the race
df_all$second_place <- recode(df_all$position, "2" = "1", .default = "0")
df_all$race_complete <- recode(df_all$statusId, "1" = "1", .default = "0")

# recoding the constructors who had earned 2nd place more than 20 times
df_all$constructor_2nd_place <- recode(df_all$constructorId, "6" = "6", "1" = "1", "3" = "3",
                                       "131" = "131", "9" = "9", "4" = "4", "25" = "25",
                                       "22" = "22", "32" = "32", "66" = "66", "34" = "34", default = "0", .missing = "0") 
df_all$constructor_2nd_place <- replace_na(df_all$constructor_2nd_place, "0")

# if the driver had ever earned 2nd place, then the dummy variable equals to 1
df_all$history_2nd_place <- ifelse(df_all$driverId %in% second_place_driver, 1, 0)

# mutating birthday based on race date and driver dob
df_all <- df_all %>% mutate(age = as.integer(round((as.Date(date) - as.Date(dob)) / 365.25, 0)))

# converting variable to either integers
df_all$position <- as.integer(df_all$position)
df_all$fastestLap <- as.integer(df_all$fastestLap)
df_all$rank <- as.integer(df_all$rank)
df_all$fastestLapSpeed <- as.integer(df_all$fastestLapSpeed)
df_all$fastestLapTimeSec <- period_to_seconds(ms(df_all$fastestLapTime))
df_all$race_complete <- as.integer(df_all$race_complete)
df_all$second_place <- as.integer(df_all$second_place)
df_all$milliseconds <- as.integer(df_all$milliseconds)
df_all$constructor_2nd_place <- as.integer(df_all$constructor_2nd_place)

# subsetting df_all to create a smaller df for regression
subset <- df_all %>% filter(year <= 2010) %>% 
                    select(second_place, constructor_2nd_place, grid, points, round, race_complete,
                            age, history_2nd_place)
# confirming the subset does not include any NAs
colSums(is.na(subset))

         second_place constructor_2nd_place                  grid                points                 round 
                    0                     0                     0                     0                     0 
        race_complete                   age     history_2nd_place 
                    0                     0                     0 

# subsetting df_all to create training and testing set for ml practice
subset2 <- df_all %>% select(year, constructor_2nd_place, grid, laps, points, 
                            second_place, race_complete, age, history_2nd_place) %>% 
                     rename(y = second_place)
subset2$y <- factor(subset2$y, labels = c("yes", "no"), levels = 1:0)

training <- subset2 %>% filter(year <= 2010) %>% select(-year)
testing <- subset2 %>% filter(year > 2010 & year <= 2017) %>% select(-year)

# confirming there's no NAs
colSums(is.na(training))

constructor_2nd_place                  grid                  laps                points                     y 
                    0                     0                     0                     0                     0 
        race_complete                   age     history_2nd_place 
                    0                     0                     0 

colSums(is.na(testing))

constructor_2nd_place                  grid                  laps                points                     y 
                    0                     0                     0                     0                     0 
        race_complete                   age     history_2nd_place 
                    0                     0                     0 

# exporting data
write.csv(subset, 'data/subset.csv')
write.csv(training, 'data/training.csv')
write.csv(testing, 'data/testing.csv')

Inferential model to explain why a driver arrives in second place in a race between 1950 and 2010.

For the first part of this project, I used logit regression trying to explain why a driver arrives in second place in a race between 1950 and 2010. Model1 returned an adjusted R² of 0.25, suggesting 25% of the variance in whether a driver arrives the second in a given race is explained by the model. This is not ideal, but with the current information I did not a better solution. Model2 uses the center scaled version of the dataset, thus offering standarized coefficients. The standardized coefficients are used to determine the importance of variables in the model1, a larger coefficient value would indicate a more important variable.

• second_place, the dependent variable (y), where 1 represents the driver finished second in the given race.
• points, the number of points earned by the driver in that race. The model included a second degree polynomial term of points. As the coefficient at both first and second degree polynomial terms are negative, the curve of feature points is determined to be a concave (curve opens down), which means the points earned would over increase the chance of a driver earning second place, though the impact fades as the points earned increases. Both degree terms are statistically significant at 99.9% level.
• race_complete, a dummy variable based on statusId and is coded to 1 if the driver completed the race. The coefficient sugguests that having completed the race successful will increase the chance of earning second place by 9.43%. This feature is statistically significant at 99.9% level.
• age, age of the driver at the time of that race. This variable is not statistically significant in the model, indicates that driver’s age at time of race does not affect the likelihood of a driver arrives the second in a race.
• history_2nd_place, dummy variable for whether the driver has a history of earning second places. This feature is statistically significant at 99% level, and if the driver had a history of earning second places, the chance of that driver winning another second place decreases by 0.9%. One possible interpretation would be earning second places would help a driver improve skill, so that driver can earn first places in the future.
• constructor_2nd_place, a list of constructors/clubs IDs that had earned second place for more than 20 times. In the actual model, this feature is factorized, meaning each of the constructorId is treated as an independent dummy variable. For instance, if a driver comes from Renault or Mercedes, the likelihood of the driver earning second place each decrease by 1.76% and 7.26%. However, if the driver comes from Ferrari’s club, the chance of that driver earning second place increases by 1.24%.
• grid, a grid number for each driver at the race beginnig. Similar to the previous variable, grid is factorized in the model1. The starting position do help explaining whether a driver arrives second in a given race. The regression outcome indicates that if the driver is located in the first grid when starting, the chance of him earning second place decreases by 5.64% (maybe ends up winning the race). But if the driver is located in a grid slot from 2 to 4, the chance of him arrives the second in the race increases.

Overall, according to standardized coefficient in model2, the most important feature is the polynomial terms of points. The next most important feature is history_2nd_place (if the driver have already earned second place).

I also included a series of interaction terms, all of the interaction terms are statistically significnat at 99.9% level. Below I would provide marginal effect of the most important interaction:

• constructor_2nd_place and points, given the save level of points earned, the impact of whether the constructor is a frequent second place earner.
• constructor_2nd_place and race_complete, given the driver had completed the race, the impact of whether the constructor is a frequent second place earner.
• grid and points, given the save level of points earned, the impact of a grid position closer to front.
• grid and race_complete, given the driver had completed the race, the impact of a grid position closer to front.
• points and history_second_place, if the driver had a history of earning second place, what’s the impact of more points earned. This interaction term is tested to be the most important interaction term (according to standarized coefficient in model 2). If the driver had a history of eraning second place, 1 extra point earned would make that driver 4.65% more likely to earn another second place.
• round and race_complete, holding the round number in a circuit constant, what’s the impact of completing the race in determining whether the driver earns the second place.

Lastly, I believe it’s simply an association we observed instead of an “explanation” or causation. In order to fulfill a causal relation, three criterias need to be met: spatial continuity, temporal succession and constant conjunction. Among variables discussed previously, the regressors do not precedes the y variable (second place) in time. At the same time, we cannot ensure the independence or unit homogeneity among variables. Therefore, I suggest the relationship we explained is simply an association.

a) Logistic regression without scaling

print(summary(model1))

Call:
lm(formula = second_place ~ poly(points, 2) + race_complete + 
    age + history_2nd_place + factor(constructor_2nd_place) + 
    factor(grid) + constructor_2nd_place:points + constructor_2nd_place:race_complete + 
    grid:points + grid:race_complete + points:history_2nd_place + 
    round:race_complete, data = subset)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.40873 -0.01118  0.00099  0.01175  0.88672 

Coefficients:
                                      Estimate Std. Error t value Pr(>|t|)    
(Intercept)                         -2.363e-02  9.024e-03  -2.619  0.00883 ** 
poly(points, 2)1                    -7.311e+00  1.113e+00  -6.568 5.21e-11 ***
poly(points, 2)2                    -5.167e+00  2.220e-01 -23.276  < 2e-16 ***
race_complete                        9.426e-02  1.097e-02   8.590  < 2e-16 ***
age                                  3.574e-04  2.344e-04   1.525  0.12725    
history_2nd_place                   -9.788e-03  3.087e-03  -3.171  0.00152 ** 
factor(constructor_2nd_place)1      -4.318e-03  5.299e-03  -0.815  0.41517    
factor(constructor_2nd_place)3       3.883e-03  5.688e-03   0.683  0.49482    
factor(constructor_2nd_place)4      -1.760e-02  7.669e-03  -2.296  0.02171 *  
factor(constructor_2nd_place)6       1.235e-02  4.704e-03   2.627  0.00863 ** 
factor(constructor_2nd_place)9      -4.554e-03  1.204e-02  -0.378  0.70536    
factor(constructor_2nd_place)22     -3.609e-03  7.904e-03  -0.457  0.64791    
factor(constructor_2nd_place)25      8.207e-03  6.036e-03   1.360  0.17394    
factor(constructor_2nd_place)32     -4.990e-03  6.165e-03  -0.809  0.41825    
factor(constructor_2nd_place)34      2.730e-03  6.974e-03   0.391  0.69553    
factor(constructor_2nd_place)66      1.119e-02  7.667e-03   1.459  0.14459    
factor(constructor_2nd_place)131    -7.264e-02  2.434e-02  -2.984  0.00285 ** 
factor(grid)1                       -5.637e-02  8.896e-03  -6.336 2.40e-10 ***
factor(grid)2                        1.683e-02  8.482e-03   1.984  0.04729 *  
factor(grid)3                        4.645e-02  8.197e-03   5.667 1.47e-08 ***
factor(grid)4                        1.968e-02  7.988e-03   2.464  0.01376 *  
factor(grid)5                       -8.235e-03  7.864e-03  -1.047  0.29503    
factor(grid)6                       -7.201e-03  7.790e-03  -0.924  0.35527    
factor(grid)7                       -1.280e-02  7.684e-03  -1.665  0.09589 .  
factor(grid)8                       -1.433e-02  7.672e-03  -1.868  0.06179 .  
factor(grid)9                       -7.833e-03  7.603e-03  -1.030  0.30294    
factor(grid)10                      -1.302e-02  7.542e-03  -1.727  0.08423 .  
factor(grid)11                      -1.133e-02  7.505e-03  -1.510  0.13103    
factor(grid)12                      -6.723e-03  7.509e-03  -0.895  0.37066    
factor(grid)13                      -4.102e-03  7.465e-03  -0.550  0.58262    
factor(grid)14                      -3.056e-03  7.481e-03  -0.408  0.68294    
factor(grid)15                      -4.719e-03  7.450e-03  -0.633  0.52649    
factor(grid)16                      -2.148e-03  7.481e-03  -0.287  0.77403    
factor(grid)17                      -1.802e-03  7.505e-03  -0.240  0.81021    
factor(grid)18                      -3.098e-04  7.590e-03  -0.041  0.96744    
factor(grid)19                      -1.823e-04  7.616e-03  -0.024  0.98090    
factor(grid)20                       1.227e-03  7.667e-03   0.160  0.87282    
factor(grid)21                      -1.063e-03  8.229e-03  -0.129  0.89719    
factor(grid)22                      -3.510e-03  8.435e-03  -0.416  0.67734    
factor(grid)23                       1.710e-03  9.466e-03   0.181  0.85664    
factor(grid)24                      -1.407e-03  9.668e-03  -0.146  0.88429    
factor(grid)25                       3.146e-03  1.079e-02   0.292  0.77063    
factor(grid)26                       7.642e-04  1.172e-02   0.065  0.94801    
factor(grid)27                       1.580e-02  2.576e-02   0.613  0.53963    
factor(grid)28                       3.891e-03  3.159e-02   0.123  0.90198    
factor(grid)29                       3.014e-04  3.455e-02   0.009  0.99304    
factor(grid)30                       5.967e-03  3.954e-02   0.151  0.88005    
factor(grid)31                       1.411e-02  4.070e-02   0.347  0.72879    
factor(grid)32                       5.625e-02  4.187e-02   1.344  0.17912    
factor(grid)33                       2.479e-02  4.787e-02   0.518  0.60456    
factor(grid)34                      -3.778e-03  1.713e-01  -0.022  0.98241    
constructor_2nd_place:points        -1.817e-04  3.816e-05  -4.761 1.94e-06 ***
race_complete:constructor_2nd_place  1.304e-03  2.654e-04   4.915 8.96e-07 ***
points:grid                          8.803e-04  1.794e-04   4.906 9.35e-07 ***
race_complete:grid                  -7.057e-03  7.972e-04  -8.852  < 2e-16 ***
history_2nd_place:points             4.650e-02  2.611e-03  17.811  < 2e-16 ***
race_complete:round                 -2.707e-03  5.347e-04  -5.062 4.18e-07 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.1713 on 20722 degrees of freedom
Multiple R-squared:  0.252, Adjusted R-squared:   0.25 
F-statistic: 124.7 on 56 and 20722 DF,  p-value: < 2.2e-16

b) Logistic regression with scaling, to provide standardized coefficients

# model after scaling, offering standardized coefficients
scaled_subset <- scale(subset, center = TRUE, scale = TRUE) %>% as.data.frame()
model2 <- lm(second_place ~  poly(points, 2) + race_complete + age + history_2nd_place + 
               constructor_2nd_place + grid + constructor_2nd_place:points +
               constructor_2nd_place:race_complete + grid:points + grid:race_complete + 
               points:history_2nd_place + round:race_complete, 
               data = scaled_subset)
print(summary(model2))

Call:
lm(formula = second_place ~ poly(points, 2) + race_complete + 
    age + history_2nd_place + constructor_2nd_place + grid + 
    constructor_2nd_place:points + constructor_2nd_place:race_complete + 
    grid:points + grid:race_complete + points:history_2nd_place + 
    round:race_complete, data = scaled_subset)

Residuals:
    Min      1Q  Median      3Q     Max 
-1.9191 -0.0264  0.0138  0.0537  4.3582 

Coefficients:
                                      Estimate Std. Error t value Pr(>|t|)    
(Intercept)                          -0.091764   0.008390 -10.937  < 2e-16 ***
poly(points, 2)1                     32.030230   2.523366  12.693  < 2e-16 ***
poly(points, 2)2                    -26.107551   1.102145 -23.688  < 2e-16 ***
race_complete                         0.005283   0.009718   0.544   0.5867    
age                                   0.011818   0.006065   1.949   0.0513 .  
history_2nd_place                     0.109762   0.008720  12.587  < 2e-16 ***
constructor_2nd_place                 0.003215   0.006201   0.518   0.6042    
grid                                 -0.017777   0.007794  -2.281   0.0226 *  
constructor_2nd_place:points         -0.045258   0.007529  -6.011 1.87e-09 ***
race_complete:constructor_2nd_place   0.041256   0.008868   4.652 3.30e-06 ***
grid:points                           0.103095   0.016155   6.382 1.79e-10 ***
race_complete:grid                   -0.124061   0.012257 -10.122  < 2e-16 ***
history_2nd_place:points              0.304121   0.016440  18.499  < 2e-16 ***
race_complete:round                  -0.030395   0.005871  -5.177 2.28e-07 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.8701 on 20765 degrees of freedom
Multiple R-squared:  0.2435,    Adjusted R-squared:  0.243 
F-statistic:   514 on 13 and 20765 DF,  p-value: < 2.2e-16

Predictive models using 1950 to 2010 as training set, 2011 to 2017 as testing set to predict drivers that come in second place.

For this part of the project, I splitted the dataset I created and assigned data from year 1950 to 2010 to training set, and 2011 to 2017 to testing set. Slightly different from the dataset I used for the inferential model, I included variable laps, which represents the number of laps a driver completed in a given race.

In the following predicitive models, I exlucded constructor_2nd_place variable as it would increase the overfitting in the testing set. Furthermore, I also changed the sets of interaction terms to include.

• grid and points; constructor_2nd_place and points; grid and race_complete are the three sets of interations I kept. I included three new sets of interactions.
• points and race_complete
• points and laps
• race_complete and laps

As the primary focus of supervised learning methods is not inference but prediction, I retained some features / interactions even though they don’t make too much sense, as long as they help predicting better.

a) Generalized Linear Model

print(confusionMatrix(z_glm, testing$y))

Confusion Matrix and Statistics

          Reference
Prediction   no  yes
       no  2785  137
       yes   79    0
                                         
               Accuracy : 0.928          
                 95% CI : (0.9182, 0.937)
    No Information Rate : 0.9543         
    P-Value [Acc > NIR] : 1.0000000      
                                         
                  Kappa : -0.0345        
                                         
 Mcnemar's Test P-Value : 0.0001052      
                                         
            Sensitivity : 0.9724         
            Specificity : 0.0000         
         Pos Pred Value : 0.9531         
         Neg Pred Value : 0.0000         
             Prevalence : 0.9543         
         Detection Rate : 0.9280         
   Detection Prevalence : 0.9737         
      Balanced Accuracy : 0.4862         
                                         
       'Positive' Class : no             
                                         

b) Bagging (treebag)

print(confusionMatrix(z_treebag, testing$y))

Confusion Matrix and Statistics

          Reference
Prediction   no  yes
       no  2733    1
       yes  131  136
                                          
               Accuracy : 0.956           
                 95% CI : (0.9481, 0.9631)
    No Information Rate : 0.9543          
    P-Value [Acc > NIR] : 0.3511          
                                          
                  Kappa : 0.6523          
                                          
 Mcnemar's Test P-Value : <2e-16          
                                          
            Sensitivity : 0.9543          
            Specificity : 0.9927          
         Pos Pred Value : 0.9996          
         Neg Pred Value : 0.5094          
             Prevalence : 0.9543          
         Detection Rate : 0.9107          
   Detection Prevalence : 0.9110          
      Balanced Accuracy : 0.9735          
                                          
       'Positive' Class : no              
                                          

c) Random Forest

print(confusionMatrix(z_rf1, testing$y))

Confusion Matrix and Statistics

          Reference
Prediction   no  yes
       no  2733    1
       yes  131  136
                                          
               Accuracy : 0.956           
                 95% CI : (0.9481, 0.9631)
    No Information Rate : 0.9543          
    P-Value [Acc > NIR] : 0.3511          
                                          
                  Kappa : 0.6523          
                                          
 Mcnemar's Test P-Value : <2e-16          
                                          
            Sensitivity : 0.9543          
            Specificity : 0.9927          
         Pos Pred Value : 0.9996          
         Neg Pred Value : 0.5094          
             Prevalence : 0.9543          
         Detection Rate : 0.9107          
   Detection Prevalence : 0.9110          
      Balanced Accuracy : 0.9735          
                                          
       'Positive' Class : no              
                                          

print(confusionMatrix(z_rf2, testing$y))

Confusion Matrix and Statistics

          Reference
Prediction   no  yes
       no  2703    1
       yes  161  136
                                          
               Accuracy : 0.946           
                 95% CI : (0.9373, 0.9538)
    No Information Rate : 0.9543          
    P-Value [Acc > NIR] : 0.9854          
                                          
                  Kappa : 0.6019          
                                          
 Mcnemar's Test P-Value : <2e-16          
                                          
            Sensitivity : 0.9438          
            Specificity : 0.9927          
         Pos Pred Value : 0.9996          
         Neg Pred Value : 0.4579          
             Prevalence : 0.9543          
         Detection Rate : 0.9007          
   Detection Prevalence : 0.9010          
      Balanced Accuracy : 0.9682          
                                          
       'Positive' Class : no              
                                          

Neural Network (MLP)

print(confusionMatrix(z_nn, testing$y))

Confusion Matrix and Statistics

          Reference
Prediction   no  yes
       no  2708  137
       yes  156    0
                                          
               Accuracy : 0.9024          
                 95% CI : (0.8912, 0.9128)
    No Information Rate : 0.9543          
    P-Value [Acc > NIR] : 1.000           
                                          
                  Kappa : -0.0511         
                                          
 Mcnemar's Test P-Value : 0.293           
                                          
            Sensitivity : 0.9455          
            Specificity : 0.0000          
         Pos Pred Value : 0.9518          
         Neg Pred Value : 0.0000          
             Prevalence : 0.9543          
         Detection Rate : 0.9024          
   Detection Prevalence : 0.9480          
      Balanced Accuracy : 0.4728          
                                          
       'Positive' Class : no              
                                          

Predictive model evaluation

Overall, the best predictive model from the algorithms/models above is the random forest model with 1000 trees. In that model, the accuracy score is 0.956, meaning 95.6% of the predicted y in the testing set matched the actual y. Breaking down the confusion matrix, the number of true positives and true negatives in this model are both the highest among all models I tried. The count of false positives is 131 and the count of false negative is just 1.

According to the varImp function (variable importance), the top 5 most important features in this model are: first and second degree polynomial term of points, interaction term between race_complete and points, points and laps, as well as variable age.

ggsave("plot1.png")