Number of Wins

A Grand Prix victory in Formula One grants the driver 25 championship points, making it an important contributor to title bids. In the 2021 season, six different drivers across four constructors achieved a victory. Predictably from the championship contenders, Verstappen and Hamilton top the charts with 10 and 8 wins respectively, significantly more than the others.

race_results %>% 
  filter(Pos==1) %>%
  group_by(Driver,Car) %>%
  summarise(numWins = n()) %>%
  arrange(-numWins) %>% 
  mutate(Driver=str_sub(Driver,-3,-1)) %>%
  
  ggplot() + 
  geom_bar(aes(x=reorder(Driver,-numWins),y=numWins,fill=Car),stat='identity') +
  labs(title='Number of Grand Prix Wins by Driver',
       fill='Constructor') +
  scale_y_continuous(breaks=c(0,2,4,6,8,10),expand=c(0,0)) +
  scale_fill_manual(values=c(alpine_clr,mclaren_clr,mercedes_clr,redbull_clr)) +
  hui_ggplot

Number of Podiums

An impressive thirteen drivers from eight constructors achieved a podium finish in 2021. This reflects a much tighter grid where many can challenge for top positions compared to years past. Again, Verstappen and Hamilton recorded the significantly more podium finishes than the rest, at 18 and 17 each. Often benefiting from the high performing Mercedes car, Valterri Bottas rounds out the top three with 11 himself.

race_results %>%
  filter(Pos==1|Pos==2|Pos==3) %>%
  group_by(Driver,Car) %>%
  summarise(numPodiums = n()) %>%
  arrange(-numPodiums) %>%
  mutate(Driver=str_sub(Driver,-3,-1)) %>%
  
  ggplot() +
  geom_bar(aes(x=reorder(Driver,-numPodiums),y=numPodiums,fill=Car),stat='identity') +
  labs(title='Number of Grand Prix Podiums by Driver',
       fill='Constructor') +
  scale_y_continuous(breaks=c(0,2,4,6,8,10,12,14,16,18,20),expand=c(0,0)) +
  scale_fill_manual(values=c(alpha_clr,alpine_clr,aston_clr,
                             ferrari_clr,mclaren_clr,mercedes_clr,
                             redbull_clr,williams_clr)) +
  hui_ggplot

Average Finishing Position

This metric takes the average of every finishing race result for a driver (retirements and disqualifications excluded). Unsurprisingly, Verstappen and Hamilton tend to finish much higher up the order. However, the difference between the two are marginal at at 2.65 and 2.76. It is interesting to note that several poor results dragged Red Bull Racing’s Sergio Perez to below both Ferrari drivers Carlos Sainz and Charles Leclerc.

race_results %>%
  # disregard non-finishing positions
  filter(Pos!='NC' & Pos!='DQ') %>%
  mutate(Pos=as.numeric(Pos)) %>%
  group_by(Driver) %>%
  summarise(avgFinPos=round(mean(Pos),3)) %>%
  arrange(avgFinPos) %>% 
  
  kbl(col.names=c('Driver','Average Finishing Position'),
      align='lc') %>%
  kable_material_dark() %>%
  row_spec(c(1,2),background='lightyellow',color='black')

Note: calculations exclude sprint qualifying results

Average Position Gained or Lost

A slopegraph below marks the average start position and average end position for each driver across every race they competed in. Like before, Verstappen and Hamilton feature at the top for both statistics, starting and ending high up the grid overall. The visual suggests that both generally move down the grid over the course of a race. And while Verstappen tends to start races in better positions, he has a lower end position on average.

However, it is important to note the limitations of this metric as an indicator of performance. Because they are means that factor in non-finishing positions, the numbers can be significantly skewed by outliers. In other words, a few poor results by a driver through no fault of their own (such as retirements) can heavily drag down their statistic. Additionally, gaining positions on average does not signal better performances because drivers who often start at the front, like Verstappen and Hamilton, have much fewer opportunities to gain positions; whereas hypothetically, a driver starting from last has 19 cars to overtake.

# set slopegraph colours
cols <- c('VER'='#0600EF','HAM'='#00D2BE',
          'PER'='gray','BOT'='gray','LEC'='gray','SAI'='gray','NOR'='gray','RIC'='gray',
          'VET'='gray','STR'='gray','GAS'='gray','TSU'='gray','MSC'='gray','MAZ'='gray',
          'RUS'='gray','LAT'='gray','ALO'='gray','OCO'='gray','RAI'='gray','GIO'='gray','KUB'='gray')

# simplify race_results table
race_results_s <- race_results %>% 
  select(Driver,gp_name,Pos) %>%
  rename(endPos=Pos)

# simplify starting_grid table
starting_grid_s <- starting_grid %>% 
  select(Driver,gp_name,Pos) %>%
  rename(startPos=Pos)

startend <- race_results_s %>% 
  left_join(starting_grid_s,by=c('Driver','gp_name')) %>%
  # replace non-numeric values with 21 
  mutate(endPos=replace(endPos,endPos=='NC','21'), # DNF/DNS
         endPos=replace(endPos,endPos=='DQ','21'), # disqualification
         startPos=replace(startPos,is.na(startPos),'21'), # pit lane start
         endPos=as.numeric(endPos),
         startPos=as.numeric(startPos))

startend %>%
  group_by(Driver) %>%
  summarise(avgStartPos=round(mean(startPos),3),
            avgEndPos=round(mean(endPos),3)) %>%
  mutate(Driver=str_sub(Driver,-3,-1)) %>%
  melt() %>%
  
  newggslopegraph(Times=variable,
                  Measurement=value,
                  Grouping=Driver,
                  ReverseYAxis=TRUE,
                  Title='Average Start and End Position by Driver',
                  SubTitle=element_blank(),
                  Caption=element_blank(),
                  TitleTextSize=20,
                  XTextSize=15,
                  DataTextSize=5,
                  LineColor=cols)

Note: pit lane starts, retirements, and disqualifications are considered 21st position.

Position Gained or Lost by Race

We then plot the positions gained and lost race by race for Verstappen and Hamilton. Seeing how the two drivers gain or lose positions at each Grand Prix gives us a more detailed understanding that a summary statistic cannot.

Counting the vertical lines tells us that Hamilton maintained his position in a race 12 times this season, which is more often than Verstappen did at 10 times. At 6 and 7, both moved up in races similar number of times. It is also interesting to see how Verstappen and Hamilton lost out greatly in the Italy and Azerbaijan GP.

Again, gaining positions does not necessarily indicate better performances because you cannot move up if you are already in the lead.

startend %>%
  mutate(difPos=startPos-endPos) %>%
  filter(Driver=='Lewis Hamilton HAM'|Driver=='Max Verstappen VER') %>%
  mutate(Driver=str_sub(Driver,-3,-1)) %>%
  
  ggplot() + 
  geom_bar(aes(x=gp_name,y=difPos),stat='identity',colour='white',fill='white') + 
  facet_wrap(~Driver) +
  labs(title='Number of Grand Prix Wins by Driver',
       fill='Constructor') +
  scale_y_continuous(breaks=c(-20,-15,-10,-5,0,5,10,15,20),expand=c(0,0)) +
  coord_flip() +
  hui_ggplot

Average Qualifying Gap to Teammate

One common metric to evaluate qualifying performance for a driver is the average lap time gap to teammate. While both qualify quicker than their teammates over the course of the 2021 season, Verstappen seems to pull larger gaps. Verstappen out-qualifies teammate Perez by 0.67 seconds on average; Hamilton out-qualifies teammate Bottas by 0.35 seconds on average.

# replace DNFs and DNSs with NA values
qualis[qualis=='DNF'] <- NA
qualis[qualis=='DNS'] <- NA

qualis %>% 
  # filter out Robert Kubica, who only participated in two sessions
  filter(Driver!='Robert Kubica KUB') %>%
  left_join(teammates,by='No') %>%
  # filter out rows where driver did not set a qualifying lap time
  filter(!is.na(Q1)) %>%
  # set best time to the latest qualifying lap time
  mutate(bestTime=coalesce(Q3,Q2,Q1)) %>%
  mutate(bestTime=as.duration(ms(bestTime))) %>%
  group_by(gp_name) %>%
  mutate(mateTime=bestTime[match(TeammateNo,No)]) %>%
  ungroup() %>%
  # filter out rows where teammate did not set a qualifying lap time
  filter(mateTime>0) %>%
  group_by(Driver,Car) %>%
  summarise(avgGap=mean(bestTime-mateTime)) %>% 
  arrange(Car) %>%
  
  kbl(col.names=c('Driver','Constructor','Average Qualifying Gap to Teammate'),
      align='llc') %>%
  kable_material_dark() %>%
  row_spec(c(15,17),background='lightyellow',color='black')

Average Qualifying Position

A more important metric to look at is the average qualifying position, which describes where a driver generally qualifies throughout the season in terms of position rather than time. This statistic is less indicative of pure driver capabilities because qualifying order is partially determined by car performance during the Grand Prix weekend; however, it is ultimately more decisive in final race results.

In this regard, Hamilton is shown to outdo Verstappen. With an average qualifying position of 2.19, Hamilton tend to qualify higher up the order compared to Verstappen. Knowing from before that Verstappen achieved higher race results throughout the season, does this imply that Hamilton is less capable of converting qualifying results into points during a Grand Prix?

qualis %>%
  # ignore non-qualifying positions
  filter(Pos!='NC' & Pos!='RT') %>%
  mutate(Pos=as.numeric(Pos)) %>%
  group_by(Driver) %>%
  summarise(avgQualiPos=round(mean(Pos),3)) %>%
  arrange(avgQualiPos) %>%
  
  kbl(col.names=c('Driver','Average Qualifying Position'),
      align='lc') %>%
  kable_material_dark() %>%
  row_spec(c(1,2),background='lightyellow',color='black')

Average Starting Position (After Penalties and Sprints)

No, because qualifying performance does not directly translate to starting grid position, which is a bigger influence final race positions. The starting grid takes qualifying order and adjust it based on penalties and sprint qualifying results. When examining the starting grids of races, we find that Verstappen actually starts further up front on average.

startend %>%
  group_by(Driver) %>%
  summarise(avgStartPos=round(mean(startPos),3)) %>%
  arrange(avgStartPos) %>%
  
  kbl(col.names=c('Driver','Average Starting Position'),
      align='lc') %>%
  kable_material_dark() %>%
  row_spec(c(1,2),background='lightyellow',color='black')

Number of Qualifying P1s versus Pole Positions

The difference between qualifying position and starting grid position is particularly pronounced when looking at the top positions.

Although Verstappen and Hamilton almost match each other in topping the timing sheets during qualifying sessions, Verstappen ends up starting the race in pole position significantly more often. This can be explained by Hamilton losing positions at sprint qualifying and taking an engine penalty while ahead, both of which Verstappen never did.

This is an important observation because starting from the most favourable position on the grid ultimately is the biggest contributor to race victories. According to race archives, 40% of all race victories in Formula One has been on from pole position.

poles <- starting_grid %>% 
  filter(Pos==1) %>%
  group_by(Driver) %>%
  summarise(numPoles=n()) %>%
  arrange(-numPoles)

qualip1s <- qualis %>% 
  filter(Pos==1) %>%
  group_by(Driver) %>%
  summarise(numQualiP1s=n()) %>%
  arrange(-numQualiP1s)

# table
qualip1s %>%
  left_join(poles,by='Driver') %>%
  kbl(col.names=c('Driver','Number of Qualifying P1s','Number of Pole Positions'),
      align='lcc') %>%
  kable_material_dark() %>%
  row_spec(c(1,2),background='lightyellow',color='black')

# plot
qualip1s %>%
  left_join(poles,by='Driver') %>%
  melt() %>%
  
  ggplot() +
  geom_bar(aes(x=reorder(Driver,-value),y=value,fill=variable),
           stat='identity',
           width=0.5,
           position='dodge') +
  labs(title='Number of Qualifying P1s and Pole Positions by Driver',
       fill='Statistic') +
  scale_y_continuous(breaks=c(0,2,4,6,8,10),expand=c(0,0)) +
  hui_ggplot

Wins from Pole

Now knowing that Hamilton has started races from pole position far less often than Verstappen did, it makes sense why why a lower number and percentage of Hamilton’s victories are won from pole position.

startend %>%
  filter(endPos=='1') %>%
  mutate(WFP=if_else(endPos==1&startPos==1,1,0)) %>%
  group_by(Driver) %>%
  summarise(numWins=n(),
            numWFP=sum(WFP),
            pcntWFP=numWFP/sum(endPos)) %>%
  arrange(-numWins) %>%
  
  kbl(col.names=c('Driver','Number of Wins','Number of Wins From Pole', 'Percent of Wins From Pole'),
      align='lccc') %>%
  kable_material_dark() %>%
  row_spec(c(1,2),background='lightyellow',color='black')

Pole Conversion Rate

In fact, when Hamilton is on pole position because of a good qualifying performance, he is nearly just as likely to achieve a win compared to Verstappen. The difference between two in pole conversion rate is much lower than that in percentage of wins from poles.

startend %>%
  filter(startPos=='1') %>%
  mutate(converted=if_else(endPos==1&startPos==1,1,0)) %>%
  group_by(Driver) %>%
  summarise(numPoles=n(),
            numConverted=sum(converted),
            pcntConverted=numConverted/sum(startPos)) %>%
  arrange(-numPoles) %>%
  
  kbl(col.names=c('Driver','Number of Poles','Number of Poles Converted','Percent of Poles Converted'),
      align='lccc') %>%
  kable_material_dark() %>%
  row_spec(c(1,2),background='lightyellow',color='black')

Number of Fastest Laps

Over the season, Hamilton and Verstappen achieved the fastest lap of a race the same number of times in total. When unable to fight for the lead, Mercedes strategists have many times targeted the point for fastest lap towards the end of a race as part of damage limitation. It is interesting to see this play reflected in the numbers, which show Hamilton in general achieving the fastest lap in later laps of a Grand Prix.

fastest_laps %>% 
  filter(Pos==1) %>% 
  group_by(Driver) %>%
  summarise(numFastestLaps=n(),avgLap=round(mean(Lap),3)) %>%
  arrange(-numFastestLaps) %>%
  kbl(col.names=c('Driver','Number of Fastest Laps','Average Lap'),
      align='lcc') %>%
  kable_material_dark() %>%
  row_spec(c(1,2),background='lightyellow',color='black')

Note: there is no fastest lap recorded in the Belgium GP

Championship Points By Driver

Earning consistently top results throughout the season, both Verstappen and Hamilton have a firm lead in the championship standings, over 150 points clear of the third highest scoring driver Valterri Bottas. Moreover, the two seem to have brought the majority of points for their respective constructors, with Verstappen at 67.5 percent and Hamilton at 63.2 percent.

# add point finishes in sprint qualifying to race_results
sprint_results_points <- sprint_results %>% filter(PTS>0) 
race_results <- rbind(race_results,sprint_results_points)

driverpoints <- race_results %>%
  group_by(Driver,Car) %>%
  summarise(driverPoints = sum(PTS))

teampoints <- race_results %>%
  group_by(Car) %>%
  summarise(teamPoints = sum(PTS))

driverpoints %>%
  left_join(teampoints,by='Car') %>%
  arrange(-driverPoints) %>%
  mutate(pcntTeamPoints=round(driverPoints/teamPoints,3)) %>%
  kbl(col.names=c('Driver','Constructor','Driver Points',
                  'Constructor Points','Percent of Constructor Points'),
      align='llccc') %>%
  kable_styling(full_width = F) %>%
  kable_material_dark() %>%
  row_spec(c(1,2),background='lightyellow',color='black')

Cumative Points Scored by Race by Driver

A visual on the cumulative points scored race by race illustrates how the lead changed hands a total of six times in 2021. Overall, it seems like Verstappen was ahead more often than Hamilton was.

race_points_cum <- race_results %>% 
  group_by(Driver,gp_name) %>% 
  summarise(totalPoints=sum(PTS)) %>%
  mutate(cumPoints=cumsum(totalPoints)) %>% 
  select(Driver,gp_name,cumPoints)

levels(race_points_cum$gp_name) <- c('BHR','EMI','POR','ESP','MON','AZE','FRA','STY','AUT','GBR',
                                     'HUN','BEL','NED','ITA','RUS','TUR','USA','MXC','SAP','QAT',
                                     'SAU','ABU')

# table
race_points_cum %>%
  pivot_wider(names_from=gp_name,values_from=cumPoints) %>%
  arrange(-ABU) %>%
  kbl() %>%
  kable_styling(full_width=F) %>%
  kable_material_dark() %>%
  row_spec(c(1,2),background='lightyellow',color='black')

# plot
race_points_cum %>% 
  filter(Driver=='Max Verstappen VER'|Driver=='Lewis Hamilton HAM') %>% 
  
  ggplot() + 
  geom_line(aes(x=gp_name,y=cumPoints,colour=Driver,group=Driver)) +
  labs(title='Cumulative Points Scored by Race by Driver') +
  scale_y_continuous(breaks=c(0,50,100,150,200,250,300,350,400),expand=c(0,0)) +
  scale_colour_manual(values=c(mercedes_clr,redbull_clr)) +
  hui_ggplot

Points Scored by Race by Driver

A breakdown of points scored per Grand Prix allows for a more detailed view of how the drivers performed throughout the season. For instance, the troughs on the dark blue line see Verstappen scoring minimal points in Azerbaijan, Great Britain, Hungary, and Italy mostly due to retirements or technical issues. The extended peak from France to Austria represents a particular run of good form.

On the light blue line, the highest point at the middle shows Lewis Hamilton achieving more points than any other weekend due to a second place finish at the sprint qualifying and a victory at the race. The three race peak covering Sao Paolo, Qatar, and Saudi Arabia portrays a slew of good results that helped him catch up to Verstappen in the championship. The datapoints in the middle section represents several mediocre results.

On balance, Verstappen achieves better results more often than Hamilton during the 2021 season. However, his consistently good showings are counteracted by a couple very poor finishes. So although Hamilton does not win as much as Verstappen, he is able to stay in the title fight because his lows are not as low. Also unsurprisingly, whenever one wins, the other usually picks up a second place finish.

race_points <- race_results %>% 
  group_by(Driver,gp_name) %>% 
  summarise(totalPoints=sum(PTS)) %>%
  select(Driver,gp_name,totalPoints)

levels(race_points$gp_name) <- c('BHR','EMI','POR','ESP','MON','AZE','FRA','STY','AUT','GBR',
                                     'HUN','BEL','NED','ITA','RUS','TUR','USA','MXC','SAP','QAT',
                                     'SAU','ABU')

# table
race_points %>% 
  pivot_wider(names_from=gp_name,values_from=totalPoints) %>%
  arrange(-ABU) %>%
  kbl() %>%
  kable_styling(full_width = F) %>%
  kable_material_dark() %>%
  row_spec(c(1,2),background='lightyellow',color='black')

# plot
race_points %>% 
  filter(Driver=='Max Verstappen VER'|Driver=='Lewis Hamilton HAM') %>%
  
  ggplot() + 
  geom_line(aes(x=gp_name,y=totalPoints,colour=Driver,group=Driver)) +
  labs(title='Points Scored by Race by Driver') +
  scale_y_continuous(breaks=c(0,1,2,4,6,8,10,12,15,18,25,27),expand=c(0,0)) +
  scale_colour_manual(values=c(mercedes_clr,redbull_clr)) +
  hui_ggplot

3 Race Rolling Average Points by Driver

Form is temporary but it can nevertheless be analysed. To study how performance fluctuated across the season between Verstappen and Hamilton, we plot a 3 race rolling average for points scored. This graph more clearly identifies the peak of Verstappen’s form at the Styrian GP right before the midway point. It also shows a subsequent dip bottoming out at the Hungarian GP before rising back up by the Mexican GP. In comparison, Hamilton generally did not achieve a run of form as high. He delivered results during Verstappen’s drop-off midseason, but really peaked only over the last few races, especially Qatar.

race_points_roll3 <- race_points %>% 
  mutate(totalPoints_roll3=rollmean(totalPoints,k=3,fill=NA)) %>%
  select(Driver,gp_name,totalPoints_roll3)

levels(race_points_roll3$gp_name) <- c('BHR','EMI','POR','ESP','MON','AZE','FRA','STY','AUT','GBR',
                                     'HUN','BEL','NED','ITA','RUS','TUR','USA','MXC','SAP','QAT',
                                     'SAU','ABU')
# table
race_points_roll3 %>% 
  pivot_wider(names_from=gp_name,values_from=totalPoints_roll3) %>%
  arrange(-ABU) %>%
  kbl() %>%
  kable_styling(full_width = F) %>%
  kable_material_dark() %>%
  row_spec(c(1,2),background='lightyellow',color='black')

# plot
race_points_roll3 %>% 
  filter(Driver=='Max Verstappen VER'|Driver=='Lewis Hamilton HAM') %>% 
  
  ggplot() + 
  geom_line(aes(x=gp_name,y=totalPoints_roll3,colour=Driver,group=Driver)) +
  labs(title='3 Race Rolling Average Points by Driver') +
  scale_y_continuous(breaks=c(0,1,2,4,6,8,10,12,15,18,25,27),expand=c(0,0)) +
  scale_colour_manual(values=c(mercedes_clr,redbull_clr)) +
  hui_ggplot