2024-06-03
Questions: Given 2022 season data can we accurately predict Team performance? Do drivers play a crucial role in the outcome of a season?
This data consists of every Track, Team, Driver and a few KPI’s from 2022, but only a few indicators are important for this analysis; driver points and driver finishing position.
f1_cleaned = f1_data %>% select(Track, Position, Driver, Team, Points) f1_cleaned = na.omit(f1_cleaned) f1_cleaned <- f1_cleaned %>% mutate(across(where(is.character), as.factor)) %>% filter(Driver != "Nyck De Vries" & Driver != "Nico Hulkenberg") head(f1_cleaned, 3)
Track Position Driver Team Points 1 Bahrain 1 Charles Leclerc Ferrari 26 2 Bahrain 2 Carlos Sainz Ferrari 18 3 Bahrain 3 Lewis Hamilton Mercedes 15
To plot wins per driver, I manipulated f1_cleaned to filter for drivers who finished in position 1. Group to ensure each unique driver and team is considered separately.
wins_per_driver <- f1_cleaned %>%
filter(Position == 1) %>%
group_by(Driver, Team) %>%
summarise(wins = n(), .groups = "drop") %>%
arrange(desc(wins))
# Plot code
#ggplot(wins_per_driver, aes(x = reorder(Driver, -wins), y = wins, fill = Team)) +
#geom_bar(stat = "identity") +
#scale_fill_manual(values = c("Red Bull Racing RBPT" = "darkblue", "Ferrari" = "red", "Mercedes" = "darkgreen")) +
#theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
#labs(title = "Wins per Driver in 2022 Season", x = "Driver", y = "Number of Wins", fill = "Team")
Red Bull dominated the season in 2022, and we can start to see a trend here; the teammates do not seem to deviate far from one another in performance.
Red bull won the Constructors Championship by a landslide
Zoom to visualize race performance per Track
# Create a mapping of tracks to track numbers
track_mapping <- f1_cleaned %>%
select(Track) %>%
distinct() %>%
mutate(track_number = row_number())
f1_cleaned <- f1_cleaned %>%
left_join(track_mapping, by = "Track")
head(f1_cleaned)
# Create cumulative points for each team per track
cumulative_points_per_team_track <- f1_cleaned %>%
group_by(.,Team, Track, track_number) %>%
summarise(total_points = sum(Points, na.rm = TRUE), .groups = "drop") %>%
ungroup() %>%
arrange(Team, track_number) %>%
group_by(Team) %>%
mutate(cumulative_points = cumsum(total_points))
create_cumulative_team_plot <- function(team_names, title_suffix) {
subset_data <- cumulative_points_per_team_track %>%
filter(Team %in% team_names)
g <- ggplot(subset_data, aes(x = track_number, y = cumulative_points, color = Team, group = Team, text = paste("Track:", Track))) +
geom_line() +
geom_point(size = 1) +
theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
labs(title = paste("Cumulative Points per Team per Track in 2022 Season -", title_suffix), x = "Track Number", y = "Cumulative Points") +
scale_color_manual(values = c(
"Red Bull Racing RBPT" = "darkblue",
"Ferrari" = "red",
"Mercedes" = "darkgreen",
"Haas Ferrari" = "darkred",
"Williams Mercedes" = "lightblue",
"McLaren Mercedes" = "orange",
"Aston Martin Aramco Mercedes" = "lightyellow3",
"Alfa Romeo Ferrari" = "maroon",
"Alpine Renault" = "magenta",
"AlphaTauri RBPT" = "steelblue"
)) +
theme_minimal()
ggplotly(g, tooltip = "text")
The trend for the top teams, is that their season progression is very robust. Low volatility as the season continues. I would imagine that we could fit a model to these teams very easily.
The middle of grid teams are relatively linear with the exception of Alfa Romeo. We see these trends in F1 becasue there are mid season upgrades for cars. This either causes teams to see a boost in performance or a decrease (like Alfa Romeo)
The bottom teams see the most volatility and variance in their performance. Especially when compared to the top 3 teams, which have a very consistent linear relationship throughout the season.
These visualizations pave the way to many statistical analyses. One thing that I notice, is the progression of points for the teams at the top of the grid is much more linear and less volatile compared to teams at the bottom of the grid. I will look at techniques like linear regression to quantify the predictive nature and differences we see here.
regression_results <- cumulative_points_per_team_track %>%
group_by(Team) %>%
do(model = lm(cumulative_points ~ track_number, data = .))
regression_summary <- regression_results %>%
summarise(
Team,
Slope = coef(model)[2], # Extract the slope coefficient from the model
p_value = summary(model)$coefficients[2, 4] # Extract the p-value associated with the slope coefficient
)
# Print the regression summary, which includes the slope and p-value for each team
print(regression_summary)
# A tibble: 10 × 3 Team Slope p_value <fct> <dbl> <dbl> 1 Alfa Romeo Ferrari 1.92 4.80e- 7 2 AlphaTauri RBPT 1.39 5.37e-11 3 Alpine Renault 8.10 1.12e-20 4 Aston Martin Aramco Mercedes 2.67 1.33e-13 5 Ferrari 22.0 2.20e-27 6 Haas Ferrari 1.31 2.26e- 9 7 McLaren Mercedes 6.71 7.28e-20 8 Mercedes 22.8 1.32e-24 9 Red Bull Racing RBPT 34.6 4.98e-29 10 Williams Mercedes 0.266 1.34e-10
As we expected, the relationship for differential points over the season are very significant for teams like Ferrari, Red Bull, and Mercedes
I also evaluated some of the diagnostic plots for each team. Conditions such as linearity, normality, constant variance, and independence of residuals. Most of these were met with a few exceptions. I will now show all of them because there are about 60 plots outputted from this code chunk.
# Extract the models and team names from the tibble
models <- regression_results$model
teams <- regression_results$Team
# Generate diagnostic plots for each model
for (i in seq_along(models)) {
# Plot diagnostic plots for the current model
plot(models[[i]], main = paste("Diagnostic Plots for", teams[i]))
}
This plot helps to check for linearity and homoscedasticity. A ranomly scattered data around the y = 0 line would indicate that the assumption is met. A clear pattern indicates a violation of linearity. For models where we observed low volatility in the top of the grid teams, this assumption is met, but for teams with less robust performance across the season, this assumption was violated.
This plot assesses the normallity of the residuals. Points falling close to the line indicate that the residuals are approximately normal, but deviations from this line suggest violation of normallity. For most teams, this assumption is valid, but for teams like Hass Ferrari who saw inconsistent season performance, there are large deviations from the normality line.
The purpose of this plot is to primarily check for independence. If there is no discernable trend moving along the x axis, this assumption is likely met. For top of the grid teams like Ferrari, this plot has no pattern or trend, but teams like Alfa Romeo took huge strides early in the season, and plateud drastically towards the middle. This caused a trend in the difference between their actual points and predicted points.
This plot helps you assess homoscedasticity and detect patterns in the variance of residuals. Ideally, the points in this plot should be evenly spread along the horizontal axis with no discernible pattern.
Team p_value Ferrari Ferrari 0.2368046639 Mercedes Mercedes 0.3941729995 Haas Ferrari Haas Ferrari 0.4547989830 Alfa Romeo Ferrari Alfa Romeo Ferrari 0.0103905782 Alpine Renault Alpine Renault 0.7630847657 AlphaTauri RBPT AlphaTauri RBPT 0.4436886383 Aston Martin Aramco Mercedes Aston Martin Aramco Mercedes 0.1914924814 Williams Mercedes Williams Mercedes 0.5402103478 McLaren Mercedes McLaren Mercedes 0.0006284115 Red Bull Racing RBPT Red Bull Racing RBPT 0.0174614561
Using a conventional significance level of 0.05, there are only 3 out of the ten teams that had drivers perform statistically significantly different. There is no apparent trend regarding whether or not drivers on better teams performed more similarly than those on worse teams. However, I would say that overall, the driver aspect does not play a significant role. There are drivers such as Max Verstappen, who even in the best car, far outperformed his teammate.