library(tidyverse)
library(nflfastR)
library(reactable)
mcvay <- (2017:2020)
half_scores <- map_df(mcvay, function(x) {
readRDS(url(
paste0("https://raw.githubusercontent.com/guga31bb/nflfastR-data/master/data/play_by_play_", x, ".rds")
)) %>%
mutate(year= x)})
half_data <- half_scores %>% #there are several games with na possession, does this happen after a score?
group_by(game_id, game_half) %>%
mutate(obs= row_number()) %>%
filter(obs== max(obs)-1) %>% #the last play before end of half.. better way?
ungroup() %>%
select(game_id, posteam, defteam, week, game_half, posteam_score_post, defteam_score_post) %>%
mutate(leader= case_when(
posteam_score_post > defteam_score_post ~ posteam,
posteam_score_post < defteam_score_post ~ defteam,
posteam_score_post == defteam_score_post ~ "tie"),
lead= abs(posteam_score_post- defteam_score_post)) %>%
group_by(game_id) %>%
mutate(half_num= row_number()) %>%
ungroup()
#record
halftime_record <- half_data %>%
group_by(game_id) %>%
mutate(winner= leader[half_num==max(half_num)]) %>%
ungroup() %>%
filter(game_half== "Half1") %>%
mutate(half_win= ifelse(leader==winner, 1, 0)) %>%
filter(is.na(half_win)==FALSE) #figure out what is causing NAs and fix
34-0 How unusual is the Rams success when winning at halftime and what’s behind it? – The Rams put an end to some troubling streaks in a reassuring 38-28 win over the Arizona Cardinals this Sunday. It was the first time since Week 3 that the Rams had managed at least 30 points. This drought was partially due to the struggles of Jared Goff, who had served up a serious of clunkers after a hot start to the season. After tallying 10 turnovers the previous 4 weeks, he delivered a zero turnover performance.
In other ways, the Rams victory built off of the trends that have long been present in LA. They took a 14-7 lead into halftime, and their victory moved the Rams to a whopping 34-0 when leading at halftime since Sean McVay took over in 2017. This stat is quite commonly cited by announcers and in the ticker of the bottom of the screen and for good reason, it seems incredible. 34 wins and 0 losses? But it would be nice to get a little more context for it. How much better is this record than that of other teams over this period, and why have the Rams been so successful?
nfl_winning_perc <- round(sum(halftime_record$half_win)/nrow(halftime_record), digits=1)
#their record when losing or tied
rams <- halftime_record %>%
filter(posteam== "LA"| defteam=="LA")
when_tied <- rams %>%
filter(game_half=="Half1", leader=="tie") %>%
mutate(wins= ifelse(winner=="LA", 1, 0))
when_losing <- rams %>%
filter(game_half=="Half1", leader !="tie", leader != "LA") %>%
mutate(wins= ifelse(winner=="LA", 1, 0),
wins= sum(wins),
losses= n()- mean(wins))
The Rams have won 41 (must also add playoff games) games total since 2017. In addition to their undefeated record when winning at half, they’ve been 3-5 when tied at half and 6-16 when trailing. These stats confirm what any football fan would generally know- the team that leads at half tends to win. Indeed, across the NFL over the same time period, 0.7% of games were won by the team that led at half. This shows that by winning about 38% of the games where they trailed at the half, the Rams actually outperformed the NFL average. Not surprising, given their high total wins over the last few years.
The Rams record is better than this average, but are they that much above the winrate of other teams leading at the half? The table below shows the records of the 10 teams that had the highest win rates when leading at halftime. While the Rams are the only perfect team over this period when leading at the half, it shows that the best teams across the league don’t have a much worse record when leading at the half. So while the Rams are clearly better than the bottom 2/3s of teams, they aren’t significantly better than the top competitors. Still, the Rams perfect 34-0 remains an impressive stat that ranks them among the best NFL teams and is always a fun statistic to throw around even if the difference between them and other teams wouldn’t show up in a statistical significance test.
halftime_record %>%
filter(leader != "tie") %>%
group_by(leader) %>%
summarise(first_half_leads= n(),
wins_when_leading= sum(half_win),
lead= round(mean(lead), digits=1)) %>%
mutate(win_perc = round(wins_when_leading/first_half_leads, digits=2)) %>%
arrange(desc(win_perc)) %>%
reactable() #the Rams have 34.. correct!!
## `summarise()` ungrouping output (override with `.groups` argument)
#could we add second half spread in here anywhere? could probably be created earlier in process. can give short detail of that and the average lead
#make figure that shows first half spread on one axis and second half spread on another
#would also be interesting to see the team with the greatest difference in points when winning and losing