# Data Source : https://api.openf1.org/v1/laps?driver_number=3&csv=true
library(readr)
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.3.3
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(stringr)
library(shiny)
## Warning: package 'shiny' was built under R version 4.3.3
library(plotly)
## Loading required package: ggplot2
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
library(tidyr)
## Warning: package 'tidyr' was built under R version 4.3.3
library(lme4)
## Warning: package 'lme4' was built under R version 4.3.3
## Loading required package: Matrix
##
## Attaching package: 'Matrix'
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
## Warning in check_dep_version(): ABI version mismatch:
## lme4 was built with Matrix ABI version 1
## Current Matrix ABI version is 0
## Please re-install lme4 from source or restore original 'Matrix' package
library(ggplot2)
library(scales)
##
## Attaching package: 'scales'
## The following object is masked from 'package:readr':
##
## col_factor
library(corrplot)
## corrplot 0.92 loaded
library(caret)
## Loading required package: lattice
library(gridExtra)
##
## Attaching package: 'gridExtra'
## The following object is masked from 'package:dplyr':
##
## combine
df <- read_csv("Verstappen.csv")
## Rows: 4930 Columns: 24
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (6): meeting_key, segments_sector_1, segments_sector_2, segments_secto...
## dbl (16): driver_number, duration_sector_1, duration_sector_2, duration_sec...
## lgl (1): is_pit_out_lap
## dttm (1): date_start
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
newdf <- df %>%
filter(
`session key name` == "Race"
)
View(newdf)
# Data Cleaning
df <- df %>%
filter(!is.na(date_start))
df <- df %>%
filter(
!is.na(duration_sector_1) & str_trim(duration_sector_1)!= "",
!is.na(duration_sector_2) & str_trim(duration_sector_2) != "",
!is.na(duration_sector_3) & str_trim(duration_sector_3) != "",
)
df <- df %>%
filter(
!is.na(i1_speed),
!is.na(i2_speed),
!is.na(st_speed),
)
View(df)
unique(df$`meeting key name`)
## [1] "Hungary" "Belgium" "Netherlands"
## [4] "United States" "Mexico" "Brazil"
## [7] "United Arab Emirates" "Bahrain" "Saudi Arabia"
## [10] "Australia" "Japan" "China"
## [13] "Italy" "Monaco" "Canada"
## [16] "Spain" "Austria" "United Kingdom"
## [19] "Azerbaijan" "Singapore"
# Structure
str(newdf)
## spc_tbl_ [1,764 × 24] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ date_start : POSIXct[1:1764], format: "2023-07-23 13:03:06" "2023-07-23 13:04:44" ...
## $ driver_number : num [1:1764] 3 3 3 3 3 3 3 3 3 3 ...
## $ duration_sector_1: num [1:1764] 40.9 31.1 30.9 30.5 30.5 ...
## $ duration_sector_2: num [1:1764] 32.7 32.3 31.7 31.6 31.4 ...
## $ duration_sector_3: num [1:1764] 24.8 24.5 24.4 24.5 24.4 ...
## $ i1_speed : num [1:1764] 276 271 269 274 278 275 277 276 278 276 ...
## $ i2_speed : num [1:1764] 227 225 227 227 228 231 230 228 231 231 ...
## $ is_pit_out_lap : logi [1:1764] FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ lap_duration : num [1:1764] 98.5 87.9 86.9 86.6 86.2 ...
## $ lap_number : num [1:1764] 1 2 3 4 5 6 7 8 9 10 ...
## $ meeting_key : chr [1:1764] "1215" "1215" "1215" "1215" ...
## $ segments_sector_1: chr [1:1764] "[2049, 2049, 2049, 2049, 2049, 2049, 2049]" "[None, 2049, 2049, 2049, 2049, 2048, 2048]" "[None, 2049, 2049, 2049, 2048, 2048, 2048]" "[None, 2049, 2048, 2049, 2049, 2049, 2048]" ...
## $ segments_sector_2: chr [1:1764] "[2049, 2049, 2049, 2049, 2049, 2049, 2049, 2049]" "[2048, 2049, 2048, 2049, 2049, 2049, 2048, 2049]" "[2048, 2049, 2049, 2049, 2049, 2049, 2049, 2049]" "[2049, 2049, 2048, 2048, 2049, 2048, 2049, 2049]" ...
## $ segments_sector_3: chr [1:1764] "[2049, 2049, 2049, 2049, 0]" "[2048, 2049, 2049, 2048, 2049]" "[2049, 2049, 2049, 2048]" "[2049, 2048, 2048, 2048]" ...
## $ session_key : num [1:1764] 9133 9133 9133 9133 9133 ...
## $ st_speed : num [1:1764] 265 290 NA 304 301 NA NA 302 300 299 ...
## $ meeting key name : chr [1:1764] "Hungary" "Hungary" "Hungary" "Hungary" ...
## $ session key name : chr [1:1764] "Race" "Race" "Race" "Race" ...
## $ year : num [1:1764] 2023 2023 2023 2023 2023 ...
## $ Win : num [1:1764] 0 0 0 0 0 0 0 0 0 0 ...
## $ Total km : num [1:1764] 4.38 4.38 4.38 4.38 4.38 ...
## $ Sector 1 km : num [1:1764] 1.85 1.85 1.85 1.85 1.85 1.85 1.85 1.85 1.85 1.85 ...
## $ Sector 2 km : num [1:1764] 1.43 1.43 1.43 1.43 1.43 1.43 1.43 1.43 1.43 1.43 ...
## $ Sector 3 km : num [1:1764] 1.1 1.1 1.1 1.1 1.1 1.1 1.1 1.1 1.1 1.1 ...
## - attr(*, "spec")=
## .. cols(
## .. date_start = col_datetime(format = ""),
## .. driver_number = col_double(),
## .. duration_sector_1 = col_double(),
## .. duration_sector_2 = col_double(),
## .. duration_sector_3 = col_double(),
## .. i1_speed = col_double(),
## .. i2_speed = col_double(),
## .. is_pit_out_lap = col_logical(),
## .. lap_duration = col_double(),
## .. lap_number = col_double(),
## .. meeting_key = col_character(),
## .. segments_sector_1 = col_character(),
## .. segments_sector_2 = col_character(),
## .. segments_sector_3 = col_character(),
## .. session_key = col_double(),
## .. st_speed = col_double(),
## .. `meeting key name` = col_character(),
## .. `session key name` = col_character(),
## .. year = col_double(),
## .. Win = col_double(),
## .. `Total km` = col_double(),
## .. `Sector 1 km` = col_double(),
## .. `Sector 2 km` = col_double(),
## .. `Sector 3 km` = col_double()
## .. )
## - attr(*, "problems")=<externalptr>
# Dimensions
dim(newdf)
## [1] 1764 24
# Variable names
names(newdf)
## [1] "date_start" "driver_number" "duration_sector_1"
## [4] "duration_sector_2" "duration_sector_3" "i1_speed"
## [7] "i2_speed" "is_pit_out_lap" "lap_duration"
## [10] "lap_number" "meeting_key" "segments_sector_1"
## [13] "segments_sector_2" "segments_sector_3" "session_key"
## [16] "st_speed" "meeting key name" "session key name"
## [19] "year" "Win" "Total km"
## [22] "Sector 1 km" "Sector 2 km" "Sector 3 km"
# Data types
glimpse(newdf)
## Rows: 1,764
## Columns: 24
## $ date_start <dttm> 2023-07-23 13:03:06, 2023-07-23 13:04:44, 2023-07-…
## $ driver_number <dbl> 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, …
## $ duration_sector_1 <dbl> 40.936, 31.082, 30.874, 30.520, 30.494, 30.445, 30.…
## $ duration_sector_2 <dbl> 32.713, 32.294, 31.653, 31.638, 31.370, 31.473, 31.…
## $ duration_sector_3 <dbl> 24.834, 24.522, 24.351, 24.475, 24.372, 24.283, 24.…
## $ i1_speed <dbl> 276, 271, 269, 274, 278, 275, 277, 276, 278, 276, N…
## $ i2_speed <dbl> 227, 225, 227, 227, 228, 231, 230, 228, 231, 231, 2…
## $ is_pit_out_lap <lgl> FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FA…
## $ lap_duration <dbl> 98.483, 87.898, 86.878, 86.633, 86.236, 86.201, 86.…
## $ lap_number <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, …
## $ meeting_key <chr> "1215", "1215", "1215", "1215", "1215", "1215", "12…
## $ segments_sector_1 <chr> "[2049, 2049, 2049, 2049, 2049, 2049, 2049]", "[Non…
## $ segments_sector_2 <chr> "[2049, 2049, 2049, 2049, 2049, 2049, 2049, 2049]",…
## $ segments_sector_3 <chr> "[2049, 2049, 2049, 2049, 0]", "[2048, 2049, 2049, …
## $ session_key <dbl> 9133, 9133, 9133, 9133, 9133, 9133, 9133, 9133, 913…
## $ st_speed <dbl> 265, 290, NA, 304, 301, NA, NA, 302, 300, 299, 285,…
## $ `meeting key name` <chr> "Hungary", "Hungary", "Hungary", "Hungary", "Hungar…
## $ `session key name` <chr> "Race", "Race", "Race", "Race", "Race", "Race", "Ra…
## $ year <dbl> 2023, 2023, 2023, 2023, 2023, 2023, 2023, 2023, 202…
## $ Win <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ `Total km` <dbl> 4.381, 4.381, 4.381, 4.381, 4.381, 4.381, 4.381, 4.…
## $ `Sector 1 km` <dbl> 1.85, 1.85, 1.85, 1.85, 1.85, 1.85, 1.85, 1.85, 1.8…
## $ `Sector 2 km` <dbl> 1.43, 1.43, 1.43, 1.43, 1.43, 1.43, 1.43, 1.43, 1.4…
## $ `Sector 3 km` <dbl> 1.1, 1.1, 1.1, 1.1, 1.1, 1.1, 1.1, 1.1, 1.1, 1.1, 1…
# Summary statistics
summary(newdf)
## date_start driver_number duration_sector_1
## Min. :2023-07-23 13:03:06.13 Min. :3 Min. :17.18
## 1st Qu.:2024-03-02 15:43:10.75 1st Qu.:3 1st Qu.:24.11
## Median :2024-06-23 13:06:50.65 Median :3 Median :28.88
## Mean :2024-08-31 22:19:19.94 Mean :3 Mean :28.48
## 3rd Qu.:2024-09-15 11:39:57.11 3rd Qu.:3 3rd Qu.:31.21
## Max. :2026-06-14 14:35:13.49 Max. :3 Max. :96.40
## NA's :14
## duration_sector_2 duration_sector_3 i1_speed i2_speed
## Min. :17.54 Min. :16.99 Min. : 76.0 Min. : 53
## 1st Qu.:29.75 1st Qu.:23.75 1st Qu.:214.0 1st Qu.:209
## Median :33.19 Median :26.32 Median :269.0 Median :256
## Mean :34.51 Mean :28.44 Mean :256.1 Mean :247
## 3rd Qu.:39.64 3rd Qu.:32.24 3rd Qu.:287.0 3rd Qu.:278
## Max. :73.46 Max. :75.06 Max. :345.0 Max. :346
## NA's :5 NA's :7 NA's :280 NA's :5
## is_pit_out_lap lap_duration lap_number meeting_key
## Mode :logical Min. : 70.43 Min. : 1.00 Length:1764
## FALSE:1711 1st Qu.: 82.01 1st Qu.:15.00 Class :character
## TRUE :53 Median : 86.88 Median :30.00 Mode :character
## Mean : 93.02 Mean :30.69
## 3rd Qu.: 98.59 3rd Qu.:45.00
## Max. :1679.11 Max. :76.00
## NA's :7
## segments_sector_1 segments_sector_2 segments_sector_3 session_key
## Length:1764 Length:1764 Length:1764 Min. : 9133
## Class :character Class :character Class :character 1st Qu.: 9472
## Mode :character Mode :character Mode :character Median : 9539
## Mean : 9801
## 3rd Qu.: 9606
## Max. :11307
##
## st_speed meeting key name session key name year
## Min. : 38.0 Length:1764 Length:1764 Min. :2023
## 1st Qu.:290.0 Class :character Class :character 1st Qu.:2024
## Median :303.0 Mode :character Mode :character Median :2024
## Mean :298.7 Mean :2024
## 3rd Qu.:315.0 3rd Qu.:2024
## Max. :355.0 Max. :2026
## NA's :141
## Win Total km Sector 1 km Sector 2 km
## Min. :0.0000 Min. :3.337 Min. :1.200 Min. :1.150
## 1st Qu.:0.0000 1st Qu.:4.361 1st Qu.:1.650 1st Qu.:1.550
## Median :0.0000 Median :5.278 Median :1.850 Median :1.750
## Mean :0.3203 Mean :5.077 Mean :1.858 Mean :1.753
## 3rd Qu.:1.0000 3rd Qu.:5.513 3rd Qu.:2.100 3rd Qu.:1.900
## Max. :1.0000 Max. :7.004 Max. :2.300 Max. :2.650
##
## Sector 3 km
## Min. :0.990
## 1st Qu.:1.260
## Median :1.560
## Mean :1.465
## 3rd Qu.:1.620
## Max. :2.050
##
# Count missing values
colSums(is.na(newdf))
## date_start driver_number duration_sector_1 duration_sector_2
## 0 0 14 5
## duration_sector_3 i1_speed i2_speed is_pit_out_lap
## 7 280 5 0
## lap_duration lap_number meeting_key segments_sector_1
## 7 0 0 2
## segments_sector_2 segments_sector_3 session_key st_speed
## 2 3 0 141
## meeting key name session key name year Win
## 0 0 0 0
## Total km Sector 1 km Sector 2 km Sector 3 km
## 0 0 0 0
sum(duplicated(newdf))
## [1] 0
table(newdf$Win)
##
## 0 1
## 1199 565
prop.table(table(newdf$Win))
##
## 0 1
## 0.6797052 0.3202948
ggplot(newdf,
aes(x=factor(Win),
fill=factor(Win)))+
geom_bar()+
geom_text(stat="count",
aes(label=after_stat(count)),
vjust=-0.5)+
labs(title="Distribution of Win",
x="Win",
y="Count")+
theme_minimal()
lap_analysis <- df %>%
group_by(year, `meeting key name`) %>%
arrange(lap_number) %>%
mutate(
avg_lap_duration = cummean(lap_duration)
)
# Example Lap 20:
lap20 <- lap_analysis %>%
filter(lap_number == 20)
# Logistic Regression Model:
model1 <- glm(
Win ~ avg_lap_duration,
data= lap20,
family = binomial
)
summary(model1)
##
## Call:
## glm(formula = Win ~ avg_lap_duration, family = binomial, data = lap20)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -4.44148 3.02163 -1.47 0.142
## avg_lap_duration 0.02203 0.02939 0.75 0.453
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 52.429 on 81 degrees of freedom
## Residual deviance: 51.866 on 80 degrees of freedom
## AIC: 55.866
##
## Number of Fisher Scoring iterations: 5
# Predcit Probability
new_data <- data.frame(
avg_lap_duration = seq(
min(lap20$avg_lap_duration),
max(lap20$avg_lap_duration),
length.out = 100
)
)
new_data$win_probability <- predict(
model1,
newdata = new_data,
type = "response"
)
ggplot(new_data,
aes(avg_lap_duration,
win_probability)) +
geom_line(size=1.2) +
scale_y_continuous(labels=scales::percent) +
labs(
x="Average Lap Duration (seconds)",
y="Probability of Finishing P1",
title="Chance of Winning vs Average Lap Duration"
) +
theme_minimal()
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
threshold <- 90
fast <- new_data %>%
filter(avg_lap_duration < threshold) %>%
summarise(
avg_probability = mean(win_probability)
)
slow <- new_data %>%
filter(avg_lap_duration >= threshold) %>%
summarise(
avg_probability = mean(win_probability)
)
drop_percentage <-
(slow$avg_probability - fast$avg_probability) /
slow$avg_probability * 100
drop_percentage
## [1] 43.77042
# Distance and Pole Position
# Distance and Win Probability
df_distance <- df %>%
mutate(
# each completed lap equals one track length
lap_distance_km = `Total km`
)
df_distance <- df_distance %>%
arrange(
year,
`meeting key name`,
lap_number
) %>%
group_by(
year,
`meeting key name`
) %>%
mutate(
cumulative_distance_km = cumsum(lap_distance_km),
cumulative_duration_min = cumsum(lap_duration) / 60
) %>%
ungroup()
# Choose distance point instead of lap number
# Example: closest point to 200 km
distance_checkpoint <- 200
checkpoint <- df_distance %>%
group_by(
year,
`meeting key name`
) %>%
slice_min(
abs(cumulative_distance_km - distance_checkpoint),
with_ties = FALSE
) %>%
ungroup()
# Logistic regression
model <- glm(
Win ~ cumulative_distance_km,
data = checkpoint,
family = binomial
)
summary(model)
##
## Call:
## glm(formula = Win ~ cumulative_distance_km, family = binomial,
## data = checkpoint)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -7.08064 14.61325 -0.485 0.628
## cumulative_distance_km 0.02576 0.07334 0.351 0.725
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 24.376 on 32 degrees of freedom
## Residual deviance: 24.145 on 31 degrees of freedom
## AIC: 28.145
##
## Number of Fisher Scoring iterations: 6
# Prediction curve
prediction <- data.frame(
cumulative_distance_km = seq(
min(checkpoint$cumulative_distance_km, na.rm=TRUE),
max(checkpoint$cumulative_distance_km, na.rm=TRUE),
length.out = 100
)
)
prediction$win_probability <- predict(
model,
newdata = prediction,
type = "response"
)
# Plot
ggplot(
prediction,
aes(
x = cumulative_distance_km,
y = win_probability
)
)+
geom_line(
linewidth = 1.2
)+
scale_y_continuous(
labels = scales::percent
)+
labs(
title="Probability of Finishing P1 vs Distance Completed",
x="Race Distance Completed (km)",
y="Probability of P1"
)+
theme_minimal()
Since there are 3158 records with 0 and 619 records with 1, how
about if I remove all the races except for Grand Prix:
table(newdf$Win)
##
## 0 1
## 1199 565
Checking the curve now:
# Distance and Pole Position
# Distance and Win Probability
df_distance <- newdf %>%
mutate(
# each completed lap equals one track length
lap_distance_km = `Total km`
)
df_distance <- df_distance %>%
arrange(
year,
`meeting key name`,
lap_number
) %>%
group_by(
year,
`meeting key name`
) %>%
mutate(
cumulative_distance_km = cumsum(lap_distance_km),
cumulative_duration_min = cumsum(lap_duration) / 60
) %>%
ungroup()
# Choose distance point instead of lap number
# Example: closest point to 200 km
distance_checkpoint <- 200
checkpoint <- df_distance %>%
group_by(
year,
`meeting key name`
) %>%
slice_min(
abs(cumulative_distance_km - distance_checkpoint),
with_ties = FALSE
) %>%
ungroup()
# Logistic regression
mod2 <- glm(
Win ~ cumulative_distance_km,
data = checkpoint,
family = binomial
)
summary(mod2)
##
## Call:
## glm(formula = Win ~ cumulative_distance_km, family = binomial,
## data = checkpoint)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.140806 1.447643 0.097 0.923
## cumulative_distance_km -0.004502 0.007549 -0.596 0.551
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 38.191 on 29 degrees of freedom
## Residual deviance: 37.839 on 28 degrees of freedom
## AIC: 41.839
##
## Number of Fisher Scoring iterations: 4
# Prediction curve
prediction <- data.frame(
cumulative_distance_km = seq(
min(checkpoint$cumulative_distance_km, na.rm=TRUE),
max(checkpoint$cumulative_distance_km, na.rm=TRUE),
length.out = 100
)
)
prediction$win_probability <- predict(
mod2,
newdata = prediction,
type = "response"
)
# Plot
ggplot(
prediction,
aes(
x = cumulative_distance_km,
y = win_probability
)
)+
geom_line(
linewidth = 1.2
)+
scale_y_continuous(
labels = scales::percent
)+
labs(
title="Probability of Finishing P1 vs Distance Completed",
x="Race Distance Completed (km)",
y="Probability of P1"
)+
theme_minimal()
View(newdf)
The chart looks ok now… with increasing distance, the probability of
winning decreases:
Now Let’s check with Lap Duration:
#-------------------------------------------------
# Create cumulative distance and elapsed race time
#-------------------------------------------------
df_distance <- newdf %>%
mutate(
lap_distance_km = `Total km`
) %>%
arrange(
year,
`meeting key name`,
lap_number
) %>%
group_by(
year,
`meeting key name`
) %>%
mutate(
cumulative_distance_km = cumsum(lap_distance_km),
# Sector times are in seconds
cumulative_duration_min =
cumsum(
duration_sector_1 +
duration_sector_2 +
duration_sector_3
) / 60
) %>%
ungroup()
#-------------------------------------------------
# Logistic Regression
#-------------------------------------------------
mod2 <- glm(
Win ~ cumulative_distance_km +
cumulative_duration_min,
data = df_distance,
family = binomial
)
summary(mod2)
##
## Call:
## glm(formula = Win ~ cumulative_distance_km + cumulative_duration_min,
## family = binomial, data = df_distance)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.076735 0.112792 -9.546 <2e-16 ***
## cumulative_distance_km -0.054457 0.005203 -10.466 <2e-16 ***
## cumulative_duration_min 0.181338 0.016317 11.113 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1683.4 on 1373 degrees of freedom
## Residual deviance: 1465.5 on 1371 degrees of freedom
## (390 observations deleted due to missingness)
## AIC: 1471.5
##
## Number of Fisher Scoring iterations: 5
#-------------------------------------------------
# Prediction Grid for Heatmap
#-------------------------------------------------
prediction <- expand.grid(
cumulative_distance_km = seq(
min(df_distance$cumulative_distance_km, na.rm = TRUE),
max(df_distance$cumulative_distance_km, na.rm = TRUE),
length.out = 100
),
cumulative_duration_min = seq(
min(df_distance$cumulative_duration_min, na.rm = TRUE),
max(df_distance$cumulative_duration_min, na.rm = TRUE),
length.out = 100
)
)
prediction$win_probability <- predict(
mod2,
newdata = prediction,
type = "response"
)
#-------------------------------------------------
# Heatmap
#-------------------------------------------------
ggplot(
prediction,
aes(
x = cumulative_distance_km,
y = cumulative_duration_min,
fill = win_probability
)
) +
geom_tile() +
scale_fill_gradient(
low = "#132B43",
high = "#56B1F7",
labels = scales::percent
) +
scale_x_continuous(
limits = c(0, 200),
breaks = seq(0, 200, by = 50)
) +
labs(
title = "Probability Max is P1 by Distance and Race Time",
x = "Cumulative Distance Completed (km)",
y = "Elapsed Race Time (minutes)",
fill = "P1 Probability"
) +
theme_minimal()
## Warning: Removed 7200 rows containing missing values or values outside the scale range
## (`geom_tile()`).
##################################################
# EXPLORATORY DATA ANALYSIS (EDA)
##################################################
# Load libraries
library(dplyr)
library(ggplot2)
library(corrplot)
##################################################
# 1. Dataset Overview
##################################################
str(df)
## spc_tbl_ [3,777 × 24] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ date_start : POSIXct[1:3777], format: "2023-07-21 11:42:59" "2023-07-21 15:02:41" ...
## $ driver_number : num [1:3777] 3 3 3 3 3 3 3 3 3 3 ...
## $ duration_sector_1: num [1:3777] 31.6 29.3 48.8 29.2 48.7 ...
## $ duration_sector_2: num [1:3777] 42.1 29 51.4 28.5 48.5 ...
## $ duration_sector_3: num [1:3777] 43.9 22.8 43 23.2 36.6 ...
## $ i1_speed : num [1:3777] 242 275 176 276 149 165 273 181 230 272 ...
## $ i2_speed : num [1:3777] 141 243 141 246 159 213 246 171 197 246 ...
## $ is_pit_out_lap : logi [1:3777] FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ lap_duration : num [1:3777] 117.5 81 143.2 80.9 133.7 ...
## $ lap_number : num [1:3777] 4 2 3 4 5 6 7 8 9 10 ...
## $ meeting_key : chr [1:3777] "1215" "1215" "1215" "1215" ...
## $ segments_sector_1: chr [1:3777] "[2048, 2048, 2048, 2048, 2048, 2048, 2048]" "[2049, 2049, 2049, 2049, 2049]" "[2048, 2048, 2048, 2048, 2048]" "[2049, 2049, 2048, 2049, 2049]" ...
## $ segments_sector_2: chr [1:3777] "[2048, 2048, 2048, 2048, 2048, 2048, 2048, 2048]" "[2049, 2049, 2049, 2049, 2049, 2049, 2049, 2049]" "[2048, 2048, 2048, 2048, 2048, 2048, 2048, 2048]" "[2049, 2049, 2049, 2049, 2049, 2049, 2049, 2049]" ...
## $ segments_sector_3: chr [1:3777] "[2048, 2048, 2048, 2064, 2064]" "[2049, 2049, 2049, 2049, 2049]" "[2048, 2048, 2048, 2048, 2048]" "[2049, 2048, 2048, 2048]" ...
## $ session_key : num [1:3777] 9223 9127 9127 9127 9127 ...
## $ st_speed : num [1:3777] 294 295 276 296 276 246 295 282 251 294 ...
## $ meeting key name : chr [1:3777] "Hungary" "Hungary" "Hungary" "Hungary" ...
## $ session key name : chr [1:3777] "Practice 1" "Practice 2" "Practice 2" "Practice 2" ...
## $ year : num [1:3777] 2023 2023 2023 2023 2023 ...
## $ Win : num [1:3777] 0 0 0 0 0 0 0 0 0 0 ...
## $ Total km : num [1:3777] 4.38 4.38 4.38 4.38 4.38 ...
## $ Sector 1 km : num [1:3777] 1.85 1.85 1.85 1.85 1.85 1.85 1.85 1.85 1.85 1.85 ...
## $ Sector 2 km : num [1:3777] 1.43 1.43 1.43 1.43 1.43 1.43 1.43 1.43 1.43 1.43 ...
## $ Sector 3 km : num [1:3777] 1.1 1.1 1.1 1.1 1.1 1.1 1.1 1.1 1.1 1.1 ...
## - attr(*, "spec")=
## .. cols(
## .. date_start = col_datetime(format = ""),
## .. driver_number = col_double(),
## .. duration_sector_1 = col_double(),
## .. duration_sector_2 = col_double(),
## .. duration_sector_3 = col_double(),
## .. i1_speed = col_double(),
## .. i2_speed = col_double(),
## .. is_pit_out_lap = col_logical(),
## .. lap_duration = col_double(),
## .. lap_number = col_double(),
## .. meeting_key = col_character(),
## .. segments_sector_1 = col_character(),
## .. segments_sector_2 = col_character(),
## .. segments_sector_3 = col_character(),
## .. session_key = col_double(),
## .. st_speed = col_double(),
## .. `meeting key name` = col_character(),
## .. `session key name` = col_character(),
## .. year = col_double(),
## .. Win = col_double(),
## .. `Total km` = col_double(),
## .. `Sector 1 km` = col_double(),
## .. `Sector 2 km` = col_double(),
## .. `Sector 3 km` = col_double()
## .. )
## - attr(*, "problems")=<externalptr>
summary(df)
## date_start driver_number duration_sector_1
## Min. :2023-07-21 11:42:59.66 Min. :3 Min. :16.41
## 1st Qu.:2024-03-02 15:55:01.44 1st Qu.:3 1st Qu.:25.65
## Median :2024-06-23 13:03:14.41 Median :3 Median :29.69
## Mean :2024-10-25 20:21:20.10 Mean :3 Mean :31.14
## 3rd Qu.:2026-02-13 09:06:21.36 3rd Qu.:3 3rd Qu.:33.58
## Max. :2026-06-26 16:05:59.23 Max. :3 Max. :97.24
## duration_sector_2 duration_sector_3 i1_speed i2_speed
## Min. :17.54 Min. :16.41 Min. : 54.0 Min. : 42.0
## 1st Qu.:30.74 1st Qu.:23.86 1st Qu.:206.0 1st Qu.:195.0
## Median :36.63 Median :27.59 Median :237.0 Median :240.0
## Mean :37.44 Mean :29.97 Mean :238.7 Mean :234.7
## 3rd Qu.:42.81 3rd Qu.:34.15 3rd Qu.:281.0 3rd Qu.:272.0
## Max. :88.49 Max. :98.03 Max. :343.0 Max. :346.0
## is_pit_out_lap lap_duration lap_number meeting_key
## Mode :logical Min. : 65.29 Min. : 1.00 Length:3777
## FALSE:3563 1st Qu.: 83.00 1st Qu.: 8.00 Class :character
## TRUE :214 Median : 95.36 Median : 17.00 Mode :character
## Mean : 98.56 Mean : 22.84
## 3rd Qu.:108.28 3rd Qu.: 31.00
## Max. :200.88 Max. :137.00
## segments_sector_1 segments_sector_2 segments_sector_3 session_key
## Length:3777 Length:3777 Length:3777 Min. : 9127
## Class :character Class :character Class :character 1st Qu.: 9472
## Mode :character Mode :character Mode :character Median : 9540
## Mean : 9965
## 3rd Qu.:11235
## Max. :11469
## st_speed meeting key name session key name year
## Min. : 38.0 Length:3777 Length:3777 Min. :2023
## 1st Qu.:272.0 Class :character Class :character 1st Qu.:2024
## Median :296.0 Mode :character Mode :character Median :2024
## Mean :282.7 Mean :2024
## 3rd Qu.:312.0 3rd Qu.:2026
## Max. :355.0 Max. :2026
## Win Total km Sector 1 km Sector 2 km
## Min. :0.0000 Min. :3.337 Min. :1.200 Min. :1.150
## 1st Qu.:0.0000 1st Qu.:4.361 1st Qu.:1.650 1st Qu.:1.550
## Median :0.0000 Median :5.412 Median :1.850 Median :1.750
## Mean :0.1639 Mean :5.084 Mean :1.862 Mean :1.744
## 3rd Qu.:0.0000 3rd Qu.:5.513 3rd Qu.:2.100 3rd Qu.:1.900
## Max. :1.0000 Max. :7.004 Max. :2.300 Max. :2.650
## Sector 3 km
## Min. :0.990
## 1st Qu.:1.260
## Median :1.560
## Mean :1.477
## 3rd Qu.:1.620
## Max. :2.050
dim(df)
## [1] 3777 24
names(df)
## [1] "date_start" "driver_number" "duration_sector_1"
## [4] "duration_sector_2" "duration_sector_3" "i1_speed"
## [7] "i2_speed" "is_pit_out_lap" "lap_duration"
## [10] "lap_number" "meeting_key" "segments_sector_1"
## [13] "segments_sector_2" "segments_sector_3" "session_key"
## [16] "st_speed" "meeting key name" "session key name"
## [19] "year" "Win" "Total km"
## [22] "Sector 1 km" "Sector 2 km" "Sector 3 km"
##################################################
# 2. Missing Values
##################################################
colSums(is.na(df))
## date_start driver_number duration_sector_1 duration_sector_2
## 0 0 0 0
## duration_sector_3 i1_speed i2_speed is_pit_out_lap
## 0 0 0 0
## lap_duration lap_number meeting_key segments_sector_1
## 0 0 0 0
## segments_sector_2 segments_sector_3 session_key st_speed
## 0 0 0 0
## meeting key name session key name year Win
## 0 0 0 0
## Total km Sector 1 km Sector 2 km Sector 3 km
## 0 0 0 0
##################################################
# 3. Duplicate Rows
##################################################
sum(duplicated(df))
## [1] 0
##################################################
# 4. Target Variable (Win)
##################################################
table(df$Win)
##
## 0 1
## 3158 619
prop.table(table(df$Win))
##
## 0 1
## 0.8361133 0.1638867
ggplot(df, aes(x = factor(Win))) +
geom_bar(fill = "steelblue") +
labs(title = "Distribution of Win",
x = "Win",
y = "Count") +
theme_minimal()
##################################################
# 5. Histograms
##################################################
ggplot(df, aes(lap_duration)) +
geom_histogram(fill="steelblue", bins=30) +
theme_minimal()
ggplot(df, aes(duration_sector_1)) +
geom_histogram(fill="steelblue", bins=30) +
theme_minimal()
ggplot(df, aes(duration_sector_2)) +
geom_histogram(fill="steelblue", bins=30) +
theme_minimal()
ggplot(df, aes(duration_sector_3)) +
geom_histogram(fill="steelblue", bins=30) +
theme_minimal()
ggplot(df, aes(st_speed)) +
geom_histogram(fill="steelblue", bins=30) +
theme_minimal()
##################################################
# 6. Boxplots by Win
##################################################
ggplot(df,
aes(factor(Win),
lap_duration,
fill=factor(Win)))+
geom_boxplot()+
theme_minimal()
ggplot(df,
aes(factor(Win),
st_speed,
fill=factor(Win)))+
geom_boxplot()+
theme_minimal()
ggplot(df,
aes(factor(Win),
duration_sector_1,
fill=factor(Win)))+
geom_boxplot()+
theme_minimal()
##################################################
# 7. Correlation Matrix
##################################################
numeric_df <- df %>%
select(where(is.numeric))
cor_matrix <- cor(numeric_df,
use="complete.obs")
## Warning in cor(numeric_df, use = "complete.obs"): the standard deviation is
## zero
corrplot(cor_matrix,
method="color",
type="upper")
##################################################
# 8. Lap Time vs Lap Number
##################################################
ggplot(df,
aes(lap_number,
lap_duration,
color=factor(Win)))+
geom_smooth(se=FALSE)+
theme_minimal()
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
##################################################
# 9. Speed vs Lap Number
##################################################
ggplot(df,
aes(lap_number,
st_speed,
color=factor(Win)))+
geom_smooth(se=FALSE)+
theme_minimal()
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
##################################################
# 10. Win Percentage by Year
##################################################
ggplot(df,
aes(factor(year),
fill=factor(Win)))+
geom_bar(position="fill")+
labs(y="Proportion")+
theme_minimal()
