library(tidyverse)
library(plotly)
library(nflverse)# Loading in data for the Steelers from 2022 to 2024 (years without Big Ben)
Steelers <- nflreadr::load_team_stats(seasons = c(2022, 2023, 2024)) |>
# Filtering for PIT
filter(team == "PIT",
season_type == "REG") |>
# Selecting only passing stats
select(season:passing_2pt_conversions) |>
# Season needs to be categorical (factor)
mutate(season = as.factor(season),
passing_epa = round(passing_epa, 2))
Steelers |>
plot_ly(x = ~week,
y = ~passing_yards,
# Want lines and points
mode = "markers+lines",
type = "scatter",
color = ~season,
# Steelers colors
colors = c("#a5acaf", "#003087", "#FFB612"),
marker = list(size = 10,
opacity = .7),
line = list(opacity = .7),
hoverinfo = "text",
text = ~paste("<b>Season:</b>", season, "<br>",
"<b>Week:</b>", week, "<br>",
"<b>Passing Yards:</b>", passing_yards, "<br>",
"<b>Passing EPA:</b>", passing_epa)) |>
add_lines(x = seq(0, 19, by = 1),
y = 260,
name = "League Avg. \nPassing Yards",
# Ensures that the line's colors won't inherit attributes from plotly
inherit = FALSE,
hoverinfo = "text",
hovertext = "<b>League Average Passing \nYards Line (2022-2024)</b>",
line = list(
# Steelers red
color = "#c60c30",
width = 2,
dash = "dash"
)
) |>
layout(xaxis = list(title = "<b>Week</b>",
zeroline = FALSE),
yaxis = list(title = "<b>Passing Yards</b>"),
title = list(text = "<b>The Steelers have struggled in the passing \ngame in the Post-Roethlisberger Era</b>",
# Moving the title down
y = .95,
# Left align
xanchor = "left",
x = .05,
font = list(size = 16)),
# Making the graph wider
width = 1000)This graph shows the Steelers’ passing yards week to week in the 2022, 2023, and 2024 NFL seasons. These mark the first three seasons without longtime Steelers’ quarterback, Ben Roethlisberger. Since Roethlisberger’s retirement, the Steelers have struggled to find consistency in the passing game. The red dashed line shows the league average team passing yards per game across this three-season span. The large majority of the data points fall beneath this line, signifying the Steelers’ passing game has been below average. They have eight games where their passing yards are 150 yards or below. Although the consistency of below average passing yards is noticeable in this graph, what may be even more interesting is the Steelers’ lack of “explosive” games. In this span, the Steelers have only thrown for over 400 yards one time, when Russell Wilson was the quarterback. No other game has come close to this number. It would be intriguing to include the full 2025 season (when it’s done) to this graph, as the Steelers seemed to have found better footing in the passing game with Aaron Rodgers.
Regarding the graph features, if viewers hover over each point, they’ll see the season, week, passing yards, and passing Expected Points Added (EPA) of the game. Passing EPA represents how many points were added due to the Steelers’ passing performance of that game. We can see that even if the Steelers have thrown for a large amount of yards, the EPA may be small, as those throws may have not come during scoring opportunities. One challenge making this graph was trying to include a mean line for league passing yards. There doesn’t seem to be a set way to make an abline, like in ggplot. As a fix around, I added a line trace spanning from weeks 1 through 19. However, if you zoom out, the line doesn’t span the entire graph. This isn’t really an issue, as there is no need to zoom out, but I couldn’t find a way to fix this using this method. Also, another issue with the mean line was that it would adopt colors and values from what was already defined in plotly. To fix this, I used inherit = FALSE. This way I could change the hovertext and color of the line.
# Reading in the data
Metro <- readxl::read_xlsx("MetroNHL.xlsx")
# Including rank for points
Metro <- Metro |>
group_by(GP) |>
# Tie breakers go by points, regulation wins, and then wins
arrange(desc(Points), desc(Reg_W), desc(W)) |>
mutate(rank = row_number()) |>
ungroup()
Metro |>
plot_ly(x = 0, # The x-axis just needs to be stationary
y = ~factor(rank),
color = ~Team,
size = ~Points,
colors = c("#002654", # Blue Jackets
"#C8102E", # Capitals
"#000000", # Devils
"#F74902", # Flyers
"#A4A9AD", # Hurricanes
"#f47d30", # Islanders
"#FFB81C", # Penguins
"#0038A8"), # Rangers
# Fixes appearing issue
ids = ~Team,
hoverinfo = "text",
text = ~paste("<b>Rank:</b>", rank,
"<br><b>Team:</b>", Team,
"<br><b>Points:</b>", Points)) |>
# Adding games played to the graph
add_text(
x = .15,
y = 4.55,
text = ~paste("GP:", GP),
frame = ~GP,
textfont = list(size = 50, color = toRGB("grey90")),
# No legend for GP text
showlegend = FALSE
) |>
add_markers(frame = ~GP,
# Markers will increase depending on number of team points
marker = list(sizemode = "diameter",
sizeref = 2.75,
line = list(
# Changing the stroke of the points
color = "black",
width = .25)
)
) |>
# Animation characteristics
animation_opts(frame = 1200,
transition = 1000,
easing = "cubic-in-out") |>
animation_slider(currentvalue = list(visible = FALSE,
prefix = ""))|>
layout(
xaxis = list(visible = FALSE,
# fixes add_text issue
range = c(-.25, .25)),
yaxis = list(autorange = "reversed",
range = c(1,8),
title = "<b>Metro Standings Position</b>"),
title = list(text = "<b>2024-25 NHL \nMetro Division \nRankings</b>",
font = list(size = 20),
x = 0.15,
# Left aligned
xanchor = "left",
y = .60)
)This animation shows the 2024-25 NHL Metropolitan Division standings throughout the season. Each data point represents a team in the division, which I color coded based on their team colors. I copied the data from Hockey-Reference.com into an Excel sheet. However, I had to caclulate regulation wins and format the data properly, myself. The slider bar represents the game number played from game 1 to 82. As the game number increases, we can see the teams’ positions in the rankings change. To determine rankings, I used the standard approach by the NHL. They first are sorted by points (2 points for a win and 1 point for an overtime loss). Then, the tie breakers go by regulation wins and overall wins. Throughout the animation, the teams’ data points increase in size, depending on their number of points. Although the teams may be hard to visualize in the beginning of the season, the difference in points becomes clearer towards the end of the season. The animation also has hovertext, if the colors are too hard to differentiate.
As for notable trends, we can see that the rankings shift a lot within the first half of the season. However, from about game 46 to 65, the rankings never dramatically change until the very end of the season. We can also see that this was a season to forget for the Pittsburgh Penguins. They reached 4th place halfway through the season, but they never really moved from 7th or 8th in the standings afterwards. The difference in sizes of the Penguins’ and Flyers’ bubbles from the 1st place Captials’ bubble on game 82 helps to show just how successful the Captials were that season.
In creating the animation, I ran into several issues. First, I wanted to see movement of the points and not have them randomly appear on the ranking lines. To fix this, I set ids = ~Team, which seemed to work. Second, I was struggling with the x-axis. At first, I made the x-axis the number of games played. However, this was really unnecessary, as all teams play the same number of games. As a solution, I fixed the x-axis at 0. Third and finally, my biggest issue was getting the add_text feature to work. I knew I wanted to put the game number on the actual plot. However, add_text kept positioning the game number in the upper right corner, off the screen. I looked up a solution to this, which was to fix the x-axis with the range command in layout. This ensured that add_text would properly read the positioning of the text. This seemed to do the trick. However, the text is not exactly where I want it to be when you put the plot to full screen. Yet, in its normal viewing state, the text looks good.