#Base R graph #In this graph, I aim to examine if there is a positive linear relationship between quarterbacks’ air yards per attempt and their overall passing yards in 2023. Using a scatterplot will allow the user to see if there is a linear relationship between these two variables, and adding in linear regression and loess curve lines will allow for further context of the graph.

library(readxl)

QB_2023 <- read_excel("2023 QB Statistics.xlsx")

plot(QB_2023$AYPA, QB_2023$Pass_Yds,
     main = "2023 Air Yards per Attempt vs. Total Passing Yards",
     xlab = "Air Yards per Attempt",
     ylab = "Passing Yards")

lin_mod <- lm(Pass_Yds ~ AYPA, data = QB_2023)
abline(lin_mod)

lo_mod <- loess(Pass_Yds ~ AYPA, data = QB_2023)
lines(sort(QB_2023$AYPA), lo_mod$fitted[order(QB_2023$AYPA)], col = "blue")

#From this, it is clear that there is a positive linear relationship between AY/A and Passing Yards. While this is represented well by the points, the linear regression line does not properly represent the linear relationship. This is because of the outliers in the data, where some QBs threw a couple passes for an air yard average that was less than 0 or above 30, which is not realistic over the course of an entire season. For this graph, I retained all the QBs that threw at least one pass in 2023, and this resulted in the linear regression line being way less steep than the majority of the data would indicate. It also resulted in the loess curve going way out to the outlying passer who had 37.0 yards per attempt (which was found to be the Packers’ Sean Clifford, who threw one pass all year for 37 yards, which ended up being 37 AY/A). Overall, while I did find a positive linear relationship between AY/A and overall passing yards, taking out these outliers could result in a much more accurate graph, which I will attempt to do in the next graph.

#ggplot graph #In this graph, I aim to replicate the first graph to examine if there is a positive linear relationship between quarterbacks’ air yards per attempt and their overall passing yards in 2023. Using a scatterplot will allow the user to see if there is a linear relationship between these two variables, and adding in linear regression and loess curve lines will allow for further context of the graph. This time, however, I will filter out non-qualifying QBs, where qualifying QBs will have to have thrown for at least 14 attempts per scheduled game (this qualifying statistic is via Pro Football Reference, where there are 17 scheduled games in a given NFL season).

library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.4.3     ✔ tibble    3.2.1
## ✔ lubridate 1.9.2     ✔ tidyr     1.3.0
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(ggplot2)
library(readxl)

QB_2023 <- read_excel("2023 QB Statistics.xlsx")

#17 scheduled games in a season
QB_2023 <- QB_2023 |> 
  mutate(att_per_game = Att/17)

QB_2023 <- QB_2023 |> 
  filter(att_per_game >= 14)

ggplot(QB_2023, aes(x=AYPA, y=Pass_Yds, color=Att)) + 
  geom_point() +
  geom_smooth(method = "lm") +
  labs(title = "2023 Air Yards per Attempt vs. Total Passing Yards",
       subtitle = "Minimum 14 attempts per scheduled game",
       x = "Air Yards per Attempt",
       y= "Passing Yards") +
  theme(plot.title = element_text(hjust = 0.5, face = "bold"),
        plot.subtitle = element_text(hjust = 0.5))
## `geom_smooth()` using formula = 'y ~ x'
## Warning: The following aesthetics were dropped during statistical transformation: colour
## ℹ This can happen when ggplot fails to infer the correct grouping structure in
##   the data.
## ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
##   variable into a factor?

#From this, I unfortunately discovered that the relationship I envisioned between Air Yards per Attempt and Total Passing Yards for qualified QBs was not as positively linear as I had hoped. Within this linear regression line and the 95% confidence interval, there are only 12 of the 32 qualified QBs. This does not inspire confidence that there is a positive linear relationship between AY/A and Total Passing Yards in 2023.

#trelliscope graph #In this trelliscope display, I want to examine every regular season of Ezekiel Elliott’s career by week by looking at his Expected Points Added per Rush. This trelliscope plot will facet on each season, and conduct a week by week trend analysis to see how consistently Elliott has performed over the course of his career (and to see if there are any noticeable dips in his rushing performance).

library(ggplot2)
library(trelliscopejs)
library(tidyverse)
library(nflfastR)

Zeke_pbp <- load_pbp(2016:2023)

Zeke_pbp <- Zeke_pbp |> 
  filter(play_type == "run") |> 
  filter(rusher_player_id == "00-0033045") |> 
  filter(season_type == "REG") |> 
  filter(two_point_attempt == 0) |> 
  group_by(season, week, posteam) |> 
  summarise(epa = sum(epa),
            rushes = sum(play_type == "run"))
## `summarise()` has grouped output by 'season', 'week'. You can override using
## the `.groups` argument.
Zeke_pbp <- Zeke_pbp |> 
    mutate(epa_per_rush = epa/rushes)

Zeke_pbp |> 
  ggplot(aes(x=week, y=epa_per_rush)) +
  geom_point() +
  geom_line() +
  facet_trelliscope(~ season,
                    name = "Ezekiel Elliott Weekly EPA/Rush",
                    desc = "EPA/Rush of Ezekiel Elliott over the course of his career (2016-2023)",
                    nrow = 1,
                    ncol = 2,
                    scales = "same",
                    path = "Users/jknapp77/Desktop/RMU Files/RMU 2023-24 (Junior) Files/Spring 2024/STAT5110L2 - Data Viz",
                    self_contained = TRUE)
## using data from the first layer

#Running backs in general are very inconsistent. On a week-to-week basis, they can go from having a positive EPA/rush to being deep into the negatives in EPA/Rush. This holds true for Ezekiel Elliott. Historically, it is known that Elliott’s career peaked in his first year in the NFL with the Cowboys, where he was the runner-up for the NFL’s Offensive Rookie of the Year award. This first season reflects that, as the majority of his regular season performances had positive EPA/Rush, with very few performances dipping too far into negative EPA/Rush territory. As his career has worn on, however, it is evident that for his peaks, there are equally as many (if not more) valleys in his EPA/Rush, as his worst performances in his first three seasons were the best of his worst performances (this is examined through sorting by epa_per_play_min), and as his career has gone on, his mean EPA/Rush has gone down, with his worst four average EPA/Rush seasons coming in his last four seasons. This is not surprising, especially since RBs tend to peak earlier than other positions due to the wear and tear nature of the position. In the future, I would like to see if other players are the same way (which in my opinion, is very likely).

#ggplot graph 2 #For this graph, I wanted to examine the 2023 Detroit Lions and compare their Expected Points Added in the run game and the pass game by week. Using a scatter plot with multiple lines will help explain which facet of the offense was better on a week-to-week basis in EPA/Play for the 2023 Detroit Lions, which ideally should be the passing game considering that you get a higher EPA/Play from throwing the ball over running the ball.

library(ggplot2)
library(tidyverse)
library(nflfastR)

pbp <- load_pbp(2023)

DET_pass <- pbp |> 
  filter(posteam == "DET") |>
  filter(week != 19) |> 
  filter(week != 20) |> 
  filter(week != 21) |> 
  filter(play_type == "pass") |>
  group_by(play_type, week) |> 
  summarise(epa = sum(epa),
            plays = n())
## `summarise()` has grouped output by 'play_type'. You can override using the
## `.groups` argument.
DET_pass <- DET_pass |> 
  mutate(epa_per_play = epa/plays)

DET_rush <- pbp |> 
  filter(posteam == "DET") |>
  filter(week != 19) |> 
  filter(week != 20) |> 
  filter(week != 21) |> 
  filter(play_type == "run") |>
  group_by(play_type, week) |> 
  summarise(epa = sum(epa),
            plays = n())
## `summarise()` has grouped output by 'play_type'. You can override using the
## `.groups` argument.
DET_rush <- DET_rush |> 
  mutate(epa_per_play = epa/plays)

ggplot() +
  geom_point(data = DET_pass, aes(x = week, y = epa_per_play, color = "Pass")) +
  geom_point(data = DET_rush, aes(x = week, y = epa_per_play, color = "Rush")) +
  geom_line(data = DET_pass, aes(x = week, y = epa_per_play, color = "Pass")) +
  geom_line(data = DET_rush, aes(x = week, y = epa_per_play, color = "Rush")) +
  scale_color_manual(name = "Lines",
                     values = c("Pass" = "#0076B6", "Rush" = "#B0B7BC")) +
  labs(title = "2023 DET EPA/Play - Pass vs. Rush",
       x = "Week",
       y = "EPA/Play") +
  theme(plot.title = element_text(hjust = 0.5, face = "bold"))

#In this graph, I found that the passing game did have a better EPA/Play in the majority of weeks (11/17). Again, this is not particularly surprising considering that throwing the ball increases EPA/Play more than running the ball does. It is really interesting to see the Lions EPA/Pass decrease in weeks 7 and 8, and again from weeks 11-14 (minus 13). These were arguably the Lions’ worst games of the season, and seeing that dip in EPA/Pass explains why. It also is worth noting that the Lions’ best games (weeks 4, 5, 10, and 15) were games in which both the passing and rushing offense were above a 0.00 EPA/Play, which makes sense considering they dominated on offense in those games.