NFL Big Data Bowl – Class Catch-Up (Classes 1–7)
Amaris Palanga
2026-09-24
About this file
This document rebuilds everything covered in classes 1–7 using the 2022 NFL Big Data Bowl data (special teams, 2018–2020 seasons): loading and exploring the tracking data, joining files, building a kicker ranking, a grouped bar chart, an animated Justin Tucker kickoff, and convex-hull analysis of each team’s shape during the play.
Before knitting: set base_dir in the setup chunk,
and make sure the 2022 files (tracking2018.csv,
tracking2019.csv, tracking2020.csv,
plays.csv, players.csv,
games.csv) are unzipped into NFLBDB2022.
1. Packages
# Professor Tallon's shared code (provides load_packages()). Rerun this line each class -- he pushes updates.
# (Moodle's Topic 3 still shows the old Fall2024 URL; this is the Fall 2026 repo. Double-check against his email.)
source("https://raw.githubusercontent.com/ptallon/SportsAnalytics_Fall2026/main/SharedCode.R")
# Fallback in case the source line fails: installs anything missing, then loads it quietly.
if (!exists("load_packages")) {
load_packages <- function(pkgs) {
missing <- pkgs[!pkgs %in% rownames(installed.packages())]
if (length(missing) > 0) install.packages(missing, dependencies = TRUE, quiet = TRUE)
invisible(suppressPackageStartupMessages(lapply(pkgs, library, character.only = TRUE)))
}
}
load_packages(c("data.table", "dplyr", "ggplot2", "stringr", "scales",
"hms", "gganimate", "gifski", "ggforce", "sf", "writexl"))
# Mike Furman's football-field drawing function (gg_field)
source("https://raw.githubusercontent.com/mlfurman3/gg_field/main/gg_field.R")2. Downloading the data (class 1 – run once, not when knitting)
# Professor's download code from Moodle ("NFL Big Data Bowl Data Files"), Dropbox links included.
# Run this in the console/an R script once -- not while knitting.
load_packages(c("httr"))
download_bdb <- function(file_url, zip_file, destination) {
if (!file.exists(zip_file)) {
GET(url = file_url, write_disk(zip_file, overwrite = TRUE))
print("ZIP file downloaded.")
} else {
print("ZIP file already exists. Skipping download.")
}
unzip(zip_file, exdir = destination, overwrite = TRUE)
print("Files successfully unzipped.")
}
# 2022 (special teams, seasons 2018-2020) -> Assignment 1
download_bdb("https://www.dropbox.com/s/1omgytiw40crxos/nfl-big-data-bowl-2022.zip?raw=1",
"NFLBDB2022.zip", file.path(base_dir, "NFLBDB2022"))
# 2025 (after the snap / pre-snap motion) -> Assignment 2 (~2 GB)
download_bdb("https://www.dropbox.com/scl/fi/spy2limdm8kqleswa1pqo/nfl-big-data-bowl-2025.zip?rlkey=e4cz61xvmzlv3itdli1oee3dw&raw=1",
"NFLBDB2025.zip", file.path(base_dir, "NFLBDB2025"))
# Sanity check from Moodle: tracking2020.csv should be about 1.6 GB
file.info(file.path(base_dir, "NFLBDB2022", "tracking2020.csv"))$size / 1e9
# Once unzipped, delete the .zip files to save space.3. Loading and exploring the tracking data (class 2)
y1 <- fread(file.path(data_dir, "tracking2018.csv"))
y2 <- fread(file.path(data_dir, "tracking2019.csv"))
y3 <- fread(file.path(data_dir, "tracking2020.csv"))
# Same columns in the same order, so we can stack them like pancakes
tracking_df <- rbind(y1, y2, y3)
rm(y1, y2, y3) # free up memory
dim(tracking_df)## [1] 36769985 18head(tracking_df)## time x y s a dis o dir event nflId
## <POSc> <num> <num> <num> <num> <num> <num> <num> <char> <int>
## 1: 2018-12-30 21:25:32 41.32 29.45 4.36 1.33 0.43 130.42 128.44 None 39470
## 2: 2018-12-30 21:25:32 41.68 29.17 4.59 1.24 0.45 128.59 127.81 None 39470
## 3: 2018-12-30 21:25:32 42.05 28.88 4.74 0.99 0.47 124.47 128.15 None 39470
## 4: 2018-12-30 21:25:32 42.43 28.59 4.87 0.71 0.48 126.02 127.35 None 39470
## 5: 2018-12-30 21:25:32 42.84 28.31 4.96 0.79 0.50 131.71 124.75 None 39470
## 6: 2018-12-30 21:25:32 43.26 28.05 4.98 1.07 0.50 136.68 122.28 None 39470
## displayName jerseyNumber position team frameId gameId playId
## <char> <int> <char> <char> <int> <int> <int>
## 1: Justin Tucker 9 K home 1 2018123000 36
## 2: Justin Tucker 9 K home 2 2018123000 36
## 3: Justin Tucker 9 K home 3 2018123000 36
## 4: Justin Tucker 9 K home 4 2018123000 36
## 5: Justin Tucker 9 K home 5 2018123000 36
## 6: Justin Tucker 9 K home 6 2018123000 36
## playDirection
## <char>
## 1: right
## 2: right
## 3: right
## 4: right
## 5: right
## 6: rightcolnames(tracking_df)## [1] "time" "x" "y" "s"
## [5] "a" "dis" "o" "dir"
## [9] "event" "nflId" "displayName" "jerseyNumber"
## [13] "position" "team" "frameId" "gameId"
## [17] "playId" "playDirection"# New columns derived from the time stamp
tracking_df$year <- year(tracking_df$time)
tracking_df$month <- month(tracking_df$time)Each row is one player (or the ball) in one frame. A frame is 1/10 of
a second; gameId + playId identify a play, and
nflId identifies a player (it is NA for the
ball).
# How often each event tag appears ("None" = nothing notable in that frame)
events <- count(tracking_df, event) |> arrange(desc(n))
events## event n
## <char> <int>
## 1: None 35203064
## 2: ball_snap 277840
## 3: kickoff 175421
## 4: punt 135953
## 5: touchback 116058
## 6: tackle 105961
## 7: first_contact 101844
## 8: kick_received 83674
## 9: extra_point_attempt 79948
## 10: extra_point 74083
## 11: field_goal_attempt 60789
## 12: punt_received 54763
## 13: field_goal 50830
## 14: fair_catch 37766
## 15: autoevent_kickoff 36041
## 16: punt_land 35581
## 17: out_of_bounds 34868
## 18: kickoff_land 21206
## 19: punt_downed 19803
## 20: line_set 12121
## 21: field_goal_missed 9085
## 22: fumble_offense_recovered 4991
## 23: extra_point_missed 4623
## 24: fumble 4531
## 25: fumble_defense_recovered 4209
## 26: onside_kick 3933
## 27: punt_muffed 3473
## 28: kick_recovered 2139
## 29: touchdown 1633
## 30: punt_fake 1311
## 31: penalty_flag 1058
## 32: free_kick 1035
## 33: pass_forward 989
## 34: field_goal_blocked 897
## 35: punt_blocked 897
## 36: kickoff_play 805
## 37: punt_play 782
## 38: pass_arrived 736
## 39: run 713
## 40: man_in_motion 552
## 41: pass_outcome_caught 552
## 42: extra_point_blocked 529
## 43: pass_outcome_incomplete 437
## 44: lateral 391
## 45: snap_direct 322
## 46: field_goal_fake 230
## 47: drop_kick 207
## 48: field_goal_play 207
## 49: safety 207
## 50: handoff 161
## 51: pass_shovel 92
## 52: extra_point_fake 69
## 53: huddle_start_offense 69
## 54: shift 69
## 55: huddle_break_offense 46
## 56: pass_outcome_interception 46
## 57: pass_outcome_touchdown 46
## 58: penalty_accepted 46
## 59: qb_sack 46
## 60: two_point_conversion 46
## 61: xp_fake 46
## 62: field_goal_miseed 23
## 63: free_kick_play 23
## 64: play_action 23
## 65: qb_strip_sack 23
## 66: timeout_home 23
## event n
## <char> <int># How many rows mention a punt?
table(tracking_df$event %like% "punt")##
## FALSE TRUE
## 36517422 252563# Field-goal-related frames in 2020
fg_2020 <- tracking_df |>
filter(year == 2020 & event %like% "field") |>
select(gameId, playId, nflId, year, event) |>
data.frame()
head(fg_2020)## gameId playId nflId year event
## 1 2020122500 1123 34615 2020 field_goal_attempt
## 2 2020122500 1123 34615 2020 field_goal
## 3 2020122500 1123 38559 2020 field_goal_attempt
## 4 2020122500 1123 38559 2020 field_goal
## 5 2020122500 1123 40023 2020 field_goal_attempt
## 6 2020122500 1123 40023 2020 field_goal# Longest plays: the highest frameId in a play = its length in tenths of a second
df1 <- tracking_df |>
select(gameId, playId, frameId) |>
group_by(gameId, playId) |>
summarize(duration = max(frameId), .groups = "keep") |>
arrange(-duration) |>
head(10) |>
data.frame()
df1## gameId playId duration
## 1 2018121000 3312 473
## 2 2020112202 2930 276
## 3 2018122400 241 272
## 4 2018100704 324 262
## 5 2018111105 3239 256
## 6 2018091610 3871 250
## 7 2018110401 2180 243
## 8 2020110810 1270 237
## 9 2020092007 1589 232
## 10 2021010300 1586 2314. Joining files (class 3)
plays <- fread(file.path(data_dir, "plays.csv"))
players <- fread(file.path(data_dir, "players.csv"))
games <- fread(file.path(data_dir, "games.csv"))
# Left join: keep every play, add the kicker's details (kickerId in plays = nflId in players)
plays_df <- left_join(plays, players, by = c("kickerId" = "nflId"))
# Add the season from games
plays_df <- left_join(plays_df, games, by = c("gameId"))
# Assignment 1 instructions on Moodle also ask you to merge PFF scouting data (hang time, kick type, etc.)
pff <- fread(file.path(data_dir, "PFFScoutingData.csv"))
plays_df <- left_join(plays_df, pff, by = c("gameId", "playId"))Moodle asks you to confirm you can reproduce these counts before choosing a play type (Extra Point 3488, Field Goal 2657, Kickoff 7843, Punt 5991; Kick Attempt Good 5470, No Good 585, Blocked Kick Attempt 61, …):
table(plays$specialTeamsPlayType)##
## Extra Point Field Goal Kickoff Punt
## 3488 2657 7843 5991table(plays$specialTeamsResult)##
## Blocked Kick Attempt Blocked Punt Downed
## 61 39 834
## Fair Catch Kick Attempt Good Kick Attempt No Good
## 1645 5470 585
## Kickoff Team Recovery Muffed Non-Special Teams Result
## 16 214 101
## Out of Bounds Return Touchback
## 651 5207 5156Justin Tucker’s longest plays, with the play type attached
justin_df <- tracking_df |>
filter(displayName == "Justin Tucker") |>
select(gameId, playId, frameId) |>
unique() |>
group_by(gameId, playId) |>
summarize(duration = max(frameId), .groups = "keep") |>
arrange(-duration) |>
data.frame() |>
left_join(plays |> select(gameId, playId, specialTeamsPlayType),
by = c("gameId", "playId")) |>
head(10)
justin_df## gameId playId duration specialTeamsPlayType
## 1 2019101301 36 171 Kickoff
## 2 2018100703 2072 162 Field Goal
## 3 2019111001 2703 159 Kickoff
## 4 2020120800 758 157 Kickoff
## 5 2018090900 4236 144 Kickoff
## 6 2018092301 1721 143 Field Goal
## 7 2020110802 3748 138 Kickoff
## 8 2018090900 2416 135 Kickoff
## 9 2019100607 433 134 Kickoff
## 10 2018122201 2113 131 Field Goal5. Kicker ranking (class 4)
Why the NAs appeared in class: blocked kicks and “Non-Special Teams Result” plays have no kick length.
plays_df |>
select(displayName, kickLength, specialTeamsPlayType, specialTeamsResult) |>
filter(is.na(kickLength), specialTeamsPlayType == "Field Goal") |>
count(specialTeamsResult)## specialTeamsResult n
## <char> <int>
## 1: Blocked Kick Attempt 37
## 2: Non-Special Teams Result 14kicker_df <- plays_df |>
select(season, displayName, kickLength, specialTeamsPlayType, specialTeamsResult) |>
filter(specialTeamsPlayType == "Field Goal",
specialTeamsResult != "Non-Special Teams Result") |>
group_by(displayName, season) |>
summarize(attempts = n(),
avg_length = mean(kickLength, na.rm = TRUE),
max_length = max(kickLength, na.rm = TRUE),
min_length = min(kickLength, na.rm = TRUE),
kicks_made = sum(specialTeamsResult == "Kick Attempt Good", na.rm = TRUE),
kicks_blocked = sum(specialTeamsResult == "Blocked Kick Attempt", na.rm = TRUE),
kicks_missed = sum(specialTeamsResult == "Kick Attempt No Good", na.rm = TRUE),
accuracy = kicks_made / attempts,
.groups = "keep") |>
group_by(displayName) |> # roll up across seasons
mutate(total = sum(kicks_made) / sum(attempts),
seasons_played = n()) |>
ungroup() |>
filter(seasons_played == 3) |> # only kickers active all 3 seasons
mutate(rank = dense_rank(desc(total))) |>
arrange(rank, season) |>
data.frame()
# Show percentages nicely without changing the underlying numbers
kicker_df |>
mutate(accuracy = percent(accuracy, accuracy = 0.1),
total = percent(total, accuracy = 0.1)) |>
head(15)## displayName season attempts avg_length max_length min_length kicks_made
## 1 Josh Lambo 2018 21 39.76190 57 22 19
## 2 Josh Lambo 2019 31 35.41935 56 20 30
## 3 Josh Lambo 2020 5 44.00000 59 30 5
## 4 Justin Tucker 2018 38 37.58333 65 21 35
## 5 Justin Tucker 2019 29 36.41379 51 21 28
## 6 Justin Tucker 2020 27 40.14815 61 20 24
## 7 Jason Myers 2018 36 40.52778 56 21 33
## 8 Jason Myers 2019 24 36.25000 58 20 20
## 9 Jason Myers 2020 20 41.00000 61 27 20
## 10 Harrison Butker 2018 26 35.88462 54 21 23
## 11 Harrison Butker 2019 35 36.55882 54 20 32
## 12 Harrison Butker 2020 24 35.04167 58 19 22
## 13 Wil Lutz 2018 27 37.92308 54 21 26
## 14 Wil Lutz 2019 32 37.28125 58 19 29
## 15 Wil Lutz 2020 27 37.37037 57 21 22
## kicks_blocked kicks_missed accuracy total seasons_played rank
## 1 0 2 90.5% 94.7% 3 1
## 2 0 1 96.8% 94.7% 3 1
## 3 0 0 100.0% 94.7% 3 1
## 4 2 1 92.1% 92.6% 3 2
## 5 0 1 96.6% 92.6% 3 2
## 6 0 3 88.9% 92.6% 3 2
## 7 0 3 91.7% 91.2% 3 3
## 8 0 4 83.3% 91.2% 3 3
## 9 0 0 100.0% 91.2% 3 3
## 10 0 3 88.5% 90.6% 3 4
## 11 1 2 91.4% 90.6% 3 4
## 12 0 2 91.7% 90.6% 3 4
## 13 1 0 96.3% 89.5% 3 5
## 14 0 3 90.6% 89.5% 3 5
## 15 0 5 81.5% 89.5% 3 5Note: in class, accuracy was converted to a text percentage and then back to a number before charting. Keeping it numeric and formatting only for display (as above) skips that round trip.
6. Grouped bar chart (classes 4–5)
g <- ggplot(kicker_df |> filter(rank <= 10),
aes(x = reorder(displayName, rank), y = accuracy, fill = factor(season))) +
geom_col(position = "dodge") +
geom_text(aes(label = percent(accuracy, accuracy = 1)),
position = position_dodge(width = 0.9), vjust = -0.4, size = 2.3) +
scale_x_discrete(labels = function(x) gsub(" ", "\n", x)) +
scale_y_continuous(labels = percent) +
labs(x = "Kicker name",
y = "Accuracy (good kicks as a % of all kicks)",
fill = "Season",
title = "Top 10 NFL Kickers, 2018–2020") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5))
g
7. Animating a single play (classes 5–6)
Justin Tucker kickoff, 30 Dec 2018 (gameId 2018123000,
playId 36).
df <- tracking_df |>
filter(gameId == 2018123000, playId == 36) |>
left_join(plays |> select(gameId, playId, absoluteYardlineNumber, playDescription),
by = c("gameId", "playId")) |>
data.frame()
yard_line <- unique(df$absoluteYardlineNumber)
# Convex hull around each team, for every frame (base R's chull)
hulls <- df |>
filter(team != "football") |>
group_by(frameId, team) |>
slice(chull(x, y)) |>
ungroup() |>
data.frame()
rm(tracking_df); invisible(gc())g <- ggplot() +
# visualize the field of play, zoomed to where the action is
gg_field(yardmin = max(min(df$x) - 5, 0),
yardmax = min(max(df$x) + 5, 125)) +
# colors, shapes and sizes (alphabetical order: away, football, home)
scale_size_manual(values = c(6, 4, 6), guide = "none") +
scale_shape_manual(values = c(21, 16, 21), guide = "none") +
scale_fill_manual(values = c("firebrick1", "#663300", "purple"), guide = "none") +
scale_colour_manual(values = c("black", "#663300", "black"), guide = "none") +
# team shapes (convex hulls)
geom_polygon(data = hulls,
aes(x = x, y = y, fill = team, group = interaction(frameId, team)),
alpha = 0.5) +
# points for each player and the ball
geom_point(data = df, aes(x = x, y = y, shape = team, colour = team,
size = team, fill = team)) +
# jersey numbers (not the ball)
geom_text(data = df |> filter(team != "football"),
aes(x = x, y = y, label = jerseyNumber),
colour = "white", size = 3.5, vjust = 0.36) +
# augmented-reality line of scrimmage
annotate("segment", x = yard_line, xend = yard_line, y = 0, yend = 160/3,
colour = "yellow", linewidth = 1) +
# title + colour the areas outside the field
labs(title = unique(df$playDescription)) +
theme(panel.background = element_rect(fill = "forestgreen", colour = "forestgreen"),
panel.grid = element_blank()) +
guides(alpha = "none") +
transition_time(frameId)
frames_to_display <- max(df$frameId)
# 10 frames per second = real time (each frame is 1/10 s)
anim <- animate(g, fps = 10, nframes = frames_to_display,
width = 480, height = 280, renderer = gifski_renderer())
anim_save("my_animation.gif", animation = anim)
8. Convex hull analytics (classes 6–7)
# Turn a team's x/y points into one convex hull polygon
make_hull <- function(data) {
pts <- st_as_sf(data, coords = c("x", "y"), crs = NA)
st_convex_hull(st_union(pts))
}
# Stats for one frame: areas, overlap, centroid distance
calculate_frame_hulls <- function(frame_data) {
# 1. separate home and away players
home_hull <- frame_data |> filter(team == "home") |> make_hull()
away_hull <- frame_data |> filter(team == "away") |> make_hull()
# 2. hull areas (square yards)
home_area <- as.numeric(st_area(home_hull))
away_area <- as.numeric(st_area(away_hull))
# 3–4. overlap between the two hulls, if any
intersection <- suppressWarnings(st_intersection(home_hull, away_hull))
overlap_area <- if (length(intersection) == 0) 0 else sum(as.numeric(st_area(intersection)))
# 5. normalized overlap (0 = none, 1 = identical)
union_area <- home_area + away_area - overlap_area
overlap_ratio <- overlap_area / union_area
# 6–7. distance between each team's center
centroid_distance <- as.numeric(st_distance(st_centroid(home_hull), st_centroid(away_hull)))
data.frame(home_area = home_area, away_area = away_area,
overlap_area = overlap_area, overlap_ratio = overlap_ratio,
centroid_distance = centroid_distance)
}# Hull statistics frame by frame for both teams
frame_stats <- df |>
filter(team != "football") |> # remove the ball
group_by(frameId) |>
group_modify(~ calculate_frame_hulls(.x)) |>
ungroup() |>
data.frame()
head(frame_stats)## frameId home_area away_area overlap_area overlap_ratio centroid_distance
## 1 1 58.86265 1555.721 0 0 38.19373
## 2 2 52.04470 1553.809 0 0 38.06078
## 3 3 44.74755 1552.088 0 0 37.93023
## 4 4 37.33375 1549.889 0 0 37.78717
## 5 5 29.69425 1547.738 0 0 37.63093
## 6 6 22.06280 1545.309 0 0 37.46906# Optional: export for Excel / to paste into an AI tool for interpretation
# write_xlsx(frame_stats, "frame_stats.xlsx")ggplot(frame_stats, aes(x = frameId)) +
geom_line(aes(y = home_area, colour = "Home"), linewidth = 1) +
geom_line(aes(y = away_area, colour = "Away"), linewidth = 1) +
scale_y_continuous(labels = comma) +
labs(title = "Team Spatial Area Analysis During the Play",
x = "Frame",
y = "Convex hull area (sq. yards)",
colour = "Team") +
theme_minimal()
9. Publishing
Click Knit → Knit to HTML, then Publish → RPubs (top right of the preview window). You’ll need a free RPubs account.