Does Pre-Snap Motion Make Plays More Successful?
2025 NFL Big Data Bowl (2022 Season, Weeks 1-9)
Connor Williams
November 10, 2026
Introduction
Pre-snap motion is when an offensive player moves after the offense has set and before the snap. Offenses use it to make the defense show its coverage, to create mismatches and to get blockers or receivers moving before the play starts. This project uses player tracking data from the 2025 NFL Big Data Bowl to answer three questions:
- How do we objectively decide whether a player was in motion?
- Are plays with motion more successful than plays without it?
- Which teams get the most out of motion?
Here is what pre-snap motion looks like in the tracking data. The player with the yellow ring and trail is the motion player:
gif_path <- normalizePath("motion_play.gif", mustWork = FALSE)
if (file.exists(gif_path)) {
knitr::include_graphics(gif_path)
} else {
cat("Animation file motion_play.gif not found - run the animation code in the Appendix first.")
}
(The code that builds this animation is in the Appendix at the end.)
Data & Packages
library(tidyverse)
library(data.table)
library(scales)
library(knitr)
library(kableExtra)
games <- fread("games.csv")
plays <- fread("plays.csv")
players <- fread("players.csv")
player_play <- fread("player_play.csv")Step 1: Measuring Lateral Movement
The tracking chips are very sensitive and record movements as small
as 0.01 yards, so a player standing still still shows “movement.” For
every offensive skill player (WR, TE, RB, FB) on every play, I measured
how far he moved laterally (in y) between the moment
the offense was set (line_set) and the snap:
lat_range= max(y) - min(y) is the full width of the movement. I use this instead of adding up every frame-to-frame change, because summing roughly 100 frames of 0.01-yard jitter would make players who stood still look like they moved.
The tracking files are about 1 GB each, so this step processes one
week at a time and saves the results to motion_players.rds.
If that file already exists, the slow loop is skipped.
offense_keys <- plays[, .(gameId, playId, possessionTeam)]
skill_ids <- players[position %in% c("WR", "TE", "RB", "FB"), nflId]
process_week <- function(w) {
trk <- fread(paste0("tracking_week_", w, ".csv"),
select = c("gameId", "playId", "nflId", "frameId",
"frameType", "club", "event", "x", "y"))
trk <- trk[frameType %in% c("BEFORE_SNAP", "SNAP")]
ls <- trk[event == "line_set", .(lineSetFrame = min(frameId)), by = .(gameId, playId)]
sn <- trk[frameType == "SNAP", .(snapFrame = min(frameId)), by = .(gameId, playId)]
trk <- trk[nflId %in% skill_ids]
trk <- merge(trk, offense_keys, by = c("gameId", "playId"))
trk <- trk[club == possessionTeam]
trk <- merge(trk, ls, by = c("gameId", "playId"))
trk <- merge(trk, sn, by = c("gameId", "playId"))
trk <- trk[frameId >= lineSetFrame & frameId <= snapFrame]
setorder(trk, gameId, playId, nflId, frameId)
out <- trk[, .(
y_lineset = y[1],
y_snap = y[.N],
lat_range = max(y) - min(y),
lat_path = sum(abs(diff(y))),
x_range = max(x) - min(x),
n_frames = .N
), by = .(gameId, playId, nflId, possessionTeam)]
rm(trk); gc()
out
}
if (!file.exists("motion_players.rds")) {
motion_players <- rbindlist(lapply(1:9, process_week))
saveRDS(motion_players, "motion_players.rds")
}motion_players <- readRDS("motion_players.rds")
quantile(motion_players$lat_range, c(.5, .75, .9, .95, .99))## 50% 75% 90% 95% 99%
## 0.1100 0.2400 4.3300 9.7000 17.714475% of players move less than about a quarter of a yard, which is just tag noise and shuffling. Then there is a jump: by the 90th percentile, players are moving 4+ yards. That gap is where the motion cutoff should go.
Step 2: Choosing the Motion Cutoff
ggplot(motion_players, aes(x = lat_range)) +
geom_histogram(binwidth = 0.25, fill = "steelblue", color = "white") +
geom_vline(xintercept = 2, linetype = "dashed", color = "red") +
scale_y_log10() +
coord_cartesian(xlim = c(0, 20)) +
labs(title = "Lateral movement of skill players between line set and snap",
subtitle = "Red line = 2-yard motion cutoff",
x = "Lateral movement (yards, max y - min y)",
y = "Number of player-plays (log scale)") +
theme_minimal()
To check the cutoff, I compared my definition against the NFL’s own
motion flags (motionSinceLineset /
inMotionAtBallSnap) at several thresholds:
pp_flags <- player_play[, .(gameId, playId, nflId, motionSinceLineset, inMotionAtBallSnap)]
check <- merge(motion_players, pp_flags, by = c("gameId", "playId", "nflId"))
check[, nfl_motion := motionSinceLineset %in% c(TRUE, "TRUE") |
inMotionAtBallSnap %in% c(TRUE, "TRUE")]
thresholds <- c(0.5, 1, 1.5, 2, 2.5, 3, 4, 5)
agree_tbl <- rbindlist(lapply(thresholds, function(t) {
check[, .(Threshold = t,
Flagged = sum(lat_range >= t),
Agreement = round(mean((lat_range >= t) == nfl_motion), 3),
Precision = round(mean(nfl_motion[lat_range >= t]), 3),
Recall = round(mean(lat_range[nfl_motion] >= t), 3))]
}))
agree_tbl %>%
kable(caption = "Agreement between my lateral-movement cutoff and the NFL motion flag") %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE)| Threshold | Flagged | Agreement | Precision | Recall |
|---|---|---|---|---|
| 0.5 | 12747 | 0.928 | 0.578 | 0.956 |
| 1.0 | 10763 | 0.948 | 0.668 | 0.933 |
| 1.5 | 10249 | 0.951 | 0.687 | 0.913 |
| 2.0 | 9835 | 0.950 | 0.692 | 0.882 |
| 2.5 | 9426 | 0.949 | 0.692 | 0.847 |
| 3.0 | 9080 | 0.947 | 0.692 | 0.815 |
| 4.0 | 8280 | 0.942 | 0.690 | 0.741 |
| 5.0 | 7267 | 0.937 | 0.685 | 0.646 |
I chose 2 yards. Agreement with the NFL flag peaks at 1.5–2 yards (about 95%), and precision stops improving at 2 yards. A higher cutoff only misses more real motion: recall falls from 88% to 65% at 5 yards. Most players I flag that the NFL does not are probably shifts. Those are still real lateral movement, so they belong in this metric. A play counts as a motion play if at least one skill player moved 2+ yards laterally.
motion_cutoff <- 2
motion_players[, in_motion := lat_range >= motion_cutoff]
play_motion <- motion_players[, .(
motion = any(in_motion),
n_motion = sum(in_motion),
motion_yards = sum(lat_range[in_motion]),
max_motion_yards = if (any(in_motion)) max(lat_range[in_motion]) else 0
), by = .(gameId, playId, possessionTeam)]
prop.table(table(play_motion$motion))##
## FALSE TRUE
## 0.4687089 0.5312911About 53% of plays include motion, which is close to how often NFL teams actually used motion in 2022.
Step 3: Defining a “Successful” Play
Success depends on the situation, so I used rules based on down, field position and the two-minute drill:
| Situation | 1st down | 2nd down | 3rd down | 4th down |
|---|---|---|---|---|
| Own territory | Gain > 3.49 yds | Gain ≥ half of yards to go | Convert first down | Convert |
| Opponent territory | Gain > 3.49 yds | Gain ≥ half of yards to go | Leave 4th & 1 or less | Convert |
| Two-minute drill, trailing or tied | First down or 10+ yds | same | same | same |
The 3.5 yards on 1st down comes from splitting 10 yards across 3 downs, since teams usually punt on 4th. In opponent territory, getting to 4th & 1 counts as a success on 3rd down because teams are more likely to go for it or kick a field goal there. In the last two minutes of a half, a team that is winning uses the normal rules, but a trailing or tied team needs chunk plays. I removed QB kneels, spikes, plays nullified by penalty, plays with missing values and tracking glitches (any player with more than 35 lateral yards, which is wider than a realistic sideline-to-sideline motion).
plays_clean <- merge(plays, games[, .(gameId, homeTeamAbbr, visitorTeamAbbr)], by = "gameId")
plays_clean <- plays_clean[
playNullifiedByPenalty != "Y" &
!(qbKneel %in% c(1, TRUE, "TRUE")) &
!(qbSpike %in% c(1, TRUE, "TRUE")) &
!is.na(down) & !is.na(yardsToGo) & !is.na(yardsGained) &
!is.na(yardlineNumber) & !is.na(gameClock)]
plays_clean[, `:=`(
yards_to_endzone = fifelse(yardlineNumber == 50, 50,
fifelse(yardlineSide == possessionTeam,
100 - as.numeric(yardlineNumber),
as.numeric(yardlineNumber))),
clock_sec = as.numeric(sub(":.*", "", gameClock)) * 60 +
as.numeric(sub(".*:", "", gameClock)),
off_score = fifelse(possessionTeam == homeTeamAbbr, preSnapHomeScore, preSnapVisitorScore),
def_score = fifelse(possessionTeam == homeTeamAbbr, preSnapVisitorScore, preSnapHomeScore)
)]
plays_clean[, two_min := quarter %in% c(2, 4) & clock_sec <= 120]
plays_clean[, trailing := off_score <= def_score]
plays_clean[, situation := fcase(
two_min & trailing, "Two-minute (trailing/tied)",
yards_to_endzone >= 50, "Own territory",
default = "Opponent territory")]
plays_clean[, success := fcase(
situation == "Two-minute (trailing/tied)", yardsGained >= yardsToGo | yardsGained >= 10,
down == 1, yardsGained > 3.49,
down == 2, yardsGained >= yardsToGo / 2,
down == 3 & situation == "Own territory", yardsGained >= yardsToGo,
down == 3 & situation == "Opponent territory", (yardsToGo - yardsGained) <= 1,
down == 4, yardsGained >= yardsToGo)]
analysis_df <- merge(plays_clean, play_motion, by = c("gameId", "playId", "possessionTeam"))
analysis_df <- analysis_df[max_motion_yards <= 35]Step 4: Does Motion Work?
overall <- analysis_df[, .(Plays = .N, `Success Rate` = percent(mean(success), 0.1)),
by = .(Motion = motion)][order(-Motion)]
overall %>%
kable(caption = "League-wide success rate with and without motion") %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE)| Motion | Plays | Success Rate |
|---|---|---|
| TRUE | 8476 | 50.2% |
| FALSE | 7301 | 47.9% |
by_sit <- analysis_df[, .(Plays = .N, `Success Rate` = percent(mean(success), 0.1)),
by = .(Situation = situation, Motion = motion)][order(Situation, -Motion)]
by_sit %>%
kable(caption = "Success rate by situation") %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE)| Situation | Motion | Plays | Success Rate |
|---|---|---|---|
| Opponent territory | TRUE | 3334 | 50.4% |
| Opponent territory | FALSE | 2818 | 50.0% |
| Own territory | TRUE | 4724 | 51.7% |
| Own territory | FALSE | 3666 | 49.9% |
| Two-minute (trailing/tied) | TRUE | 418 | 32.1% |
| Two-minute (trailing/tied) | FALSE | 817 | 32.1% |
test_df <- analysis_df[, .(succ = sum(success), n = .N), by = motion][order(-motion)]
pt <- prop.test(test_df$succ, test_df$n)Across the league, plays with motion succeed slightly more often than plays without it (50.2% vs. 47.9%; two-proportion test p = 0.0036). Almost all of the advantage is in a team’s own territory (51.7% vs. 49.9%). In opponent territory the difference is about zero, and in the two-minute drill motion makes no difference (32.1% either way). Teams also use motion much less late in halves, which makes sense: motion takes time off the clock, and defenses play soft coverage that motion can’t do much to reveal.
Step 5: Ranking the Teams
The main ranking metric is success rate on motion plays. Next to it is each team’s motion lift: its success rate with motion minus its success rate without. Lift shows whether motion actually helps that offense, rather than the team just being good overall.
team_stats <- analysis_df[, .(
plays = .N,
motion_rate = mean(motion),
succ_motion = mean(success[motion]),
succ_no_motion = mean(success[!motion]),
avg_motion_yards = mean(motion_yards[motion])
), by = .(team = possessionTeam)]
team_stats[, motion_lift := succ_motion - succ_no_motion]
setorder(team_stats, -succ_motion)
team_stats[, rank := .I]
team_stats[, .(Rank = rank, Team = team,
`Motion Rate` = percent(motion_rate, 0.1),
`Success w/ Motion` = percent(succ_motion, 0.1),
`Success w/o Motion` = percent(succ_no_motion, 0.1),
`Motion Lift` = percent(motion_lift, 0.1),
`Avg Lateral Motion Yds` = round(avg_motion_yards, 1))] %>%
kable(caption = "Teams ranked by success rate on plays with pre-snap motion") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
scroll_box(height = "450px")| Rank | Team | Motion Rate | Success w/ Motion | Success w/o Motion | Motion Lift | Avg Lateral Motion Yds |
|---|---|---|---|---|---|---|
| 1 | BUF | 56.0% | 59.9% | 48.5% | 11.4% | 10.4 |
| 2 | BAL | 64.4% | 55.8% | 49.4% | 6.4% | 8.1 |
| 3 | ATL | 69.2% | 54.5% | 52.9% | 1.6% | 12.4 |
| 4 | NE | 50.4% | 53.9% | 43.3% | 10.6% | 10.5 |
| 5 | KC | 70.4% | 53.8% | 48.1% | 5.8% | 9.7 |
| 6 | JAX | 53.5% | 53.7% | 50.8% | 2.9% | 10.5 |
| 7 | PHI | 39.0% | 52.8% | 54.3% | -1.5% | 10.6 |
| 8 | NO | 32.6% | 52.5% | 50.3% | 2.3% | 10.9 |
| 9 | CLE | 61.6% | 51.9% | 49.0% | 3.0% | 13.4 |
| 10 | MIN | 52.4% | 51.6% | 42.2% | 9.4% | 11.0 |
| 11 | MIA | 76.7% | 51.4% | 49.6% | 1.8% | 10.2 |
| 12 | TEN | 62.2% | 51.4% | 39.0% | 12.4% | 11.1 |
| 13 | LA | 59.0% | 51.3% | 46.5% | 4.8% | 10.2 |
| 14 | DET | 65.5% | 51.3% | 50.6% | 0.7% | 10.6 |
| 15 | NYG | 53.0% | 51.0% | 43.8% | 7.2% | 11.7 |
| 16 | LAC | 43.6% | 50.7% | 47.8% | 2.9% | 9.4 |
| 17 | GB | 55.2% | 50.5% | 49.4% | 1.1% | 10.3 |
| 18 | CIN | 38.6% | 50.5% | 56.0% | -5.5% | 11.1 |
| 19 | SEA | 48.6% | 50.5% | 49.4% | 1.1% | 10.7 |
| 20 | LV | 51.4% | 50.0% | 47.1% | 2.9% | 11.8 |
| 21 | SF | 69.4% | 49.2% | 55.9% | -6.7% | 11.1 |
| 22 | PIT | 47.1% | 48.2% | 46.6% | 1.6% | 10.0 |
| 23 | HOU | 47.8% | 48.0% | 43.9% | 4.1% | 12.9 |
| 24 | DAL | 50.5% | 47.1% | 51.2% | -4.1% | 11.0 |
| 25 | WAS | 52.1% | 46.9% | 46.6% | 0.3% | 10.5 |
| 26 | TB | 54.1% | 46.8% | 49.2% | -2.4% | 10.9 |
| 27 | ARI | 39.8% | 46.3% | 49.1% | -2.8% | 11.5 |
| 28 | DEN | 39.6% | 45.5% | 43.6% | 1.9% | 8.3 |
| 29 | CHI | 62.8% | 44.9% | 43.0% | 1.9% | 9.5 |
| 30 | NYJ | 70.5% | 44.5% | 46.2% | -1.6% | 10.4 |
| 31 | IND | 39.9% | 44.3% | 45.2% | -0.9% | 9.7 |
| 32 | CAR | 47.0% | 42.5% | 42.7% | -0.2% | 11.0 |
league_avg <- analysis_df[motion == TRUE, mean(success)]
ggplot(team_stats, aes(x = reorder(team, succ_motion), y = succ_motion,
fill = motion_lift > 0)) +
geom_col() +
geom_hline(yintercept = league_avg, linetype = "dashed") +
coord_flip() +
scale_y_continuous(labels = percent) +
scale_fill_manual(values = c(`TRUE` = "steelblue", `FALSE` = "firebrick"),
labels = c(`TRUE` = "Better with motion", `FALSE` = "Worse with motion"),
name = NULL) +
labs(title = "Success rate on plays with pre-snap motion",
subtitle = "Dashed line = league average on motion plays",
x = NULL, y = "Success rate") +
theme_minimal() +
theme(legend.position = "bottom")
Buffalo, Baltimore, Atlanta, New England and Kansas City are the best motion offenses. Denver, Chicago, the Jets, Indianapolis and Carolina are the worst.
Do the best motion teams simply move more?
top_bottom <- rbind(
team_stats[1:5][, group := "Top 5 motion success"],
team_stats[(.N - 4):.N][, group := "Bottom 5 motion success"])
ggplot(top_bottom, aes(x = reorder(team, -succ_motion), y = avg_motion_yards, fill = group)) +
geom_col() +
geom_text(aes(label = paste0(percent(succ_motion, 1), " success")),
vjust = -0.4, size = 3) +
scale_fill_manual(values = c("Top 5 motion success" = "steelblue",
"Bottom 5 motion success" = "firebrick"),
name = NULL) +
scale_y_continuous(expand = expansion(mult = c(0, 0.12))) +
labs(title = "Do the most successful motion teams move more?",
subtitle = "Average lateral motion yards per motion play",
x = NULL, y = "Avg lateral motion yards") +
theme_minimal() +
theme(legend.position = "bottom")
ct <- cor.test(team_stats$avg_motion_yards, team_stats$succ_motion)
ggplot(team_stats, aes(x = avg_motion_yards, y = succ_motion)) +
geom_smooth(method = "lm", se = FALSE, color = "grey60", linetype = "dashed") +
geom_point(aes(size = motion_rate), color = "steelblue", alpha = 0.7) +
geom_text(aes(label = team), vjust = -1, size = 3) +
scale_y_continuous(labels = percent) +
scale_size_continuous(labels = percent, name = "Motion rate") +
labs(title = "Lateral motion yards vs. success on motion plays",
x = "Avg lateral motion yards per motion play",
y = "Success rate with motion") +
theme_minimal()
No. The correlation between average motion yards and motion success is essentially zero (r = 0.04, p = 0.84). Baltimore ranks 2nd while using some of the least motion yards, and Carolina ranks last while using some of the most. What matters is how motion is used, not how much ground it covers.
How Offensive Coordinators Can Use This
- Use motion early in drives, on your own side of the field. That is where the success gain shows up. Motion forces the defense to show man or zone coverage before the snap, which matters most when the whole playbook is available.
- Don’t count on motion in the two-minute drill. It costs clock and gives no measurable advantage when trailing late.
- More motion is not better motion. Long, cross-formation motions didn’t make teams more successful. Coordinators should judge motion by its purpose (a reveal, a mismatch, a running start) and not by distance.
- Use motion lift to evaluate your own team and scout opponents. A team with negative lift may be using motion as a tell or running it without a clear purpose. A defense facing a high-lift team (like the top 5 here) should practice communicating and adjusting to motion.
Limitations
- “Success” is my own definition. Other reasonable rules (or EPA) could change the rankings.
- Each team has only about 250 motion plays in 9 weeks, so differences of a few percentage points between teams could be noise.
- This shows association, not cause: teams may choose to use motion on plays that were already likely to work.
- The 2-yard cutoff counts shifts as well as true motion, because both are lateral pre-snap movement.
Appendix: Animation Code
The animation at the top shows a successful Buffalo 1st-down play in
its own territory with one player in motion covering 8–15 yards. It is
drawn on a full NFL field with the offense in solid team colors and the
defense in white. The GIF is only rebuilt if
motion_play.gif doesn’t already exist.
library(gganimate)
library(gifski)
motion_play <- analysis_df[possessionTeam == "BUF" & motion == TRUE & success == TRUE &
n_motion == 1 & max_motion_yards >= 8 & max_motion_yards <= 15 &
down == 1 & situation == "Own territory" &
yardsGained >= 5 & yardsGained <= 15][1]
team_cols <- c(
ARI="#97233F", ATL="#A71930", BAL="#241773", BUF="#00338D", CAR="#0085CA",
CHI="#0B162A", CIN="#FB4F14", CLE="#311D00", DAL="#003594", DEN="#FB4F14",
DET="#0076B6", GB="#203731", HOU="#03202F", IND="#002C5F", JAX="#006778",
KC="#E31837", LA="#003594", LAC="#0080C6", LV="#000000", MIA="#008E97",
MIN="#4F2683", NE="#002244", NO="#D3BC8D", NYG="#0B2265", NYJ="#125740",
PHI="#004C54", PIT="#FFB612", SEA="#002244", SF="#AA0000", TB="#D50A0A",
TEN="#0C2340", WAS="#5A1414", football="#7B4A2A")
draw_field <- function(off_team, def_team, dir) {
hash_x <- setdiff(11:109, seq(10, 110, 5))
num_x <- seq(20, 100, 10)
num_lb <- c(10, 20, 30, 40, 50, 40, 30, 20, 10)
left_team <- if (dir == "right") off_team else def_team
right_team <- if (dir == "right") def_team else off_team
list(
annotate("rect", xmin = seq(10, 105, 5), xmax = seq(15, 110, 5),
ymin = 0, ymax = 53.3, fill = rep(c("#3f8a34", "#367a2d"), 10)),
annotate("rect", xmin = 0, xmax = 10, ymin = 0, ymax = 53.3,
fill = team_cols[left_team], alpha = 0.85),
annotate("rect", xmin = 110, xmax = 120, ymin = 0, ymax = 53.3,
fill = team_cols[right_team], alpha = 0.85),
annotate("text", x = 5, y = 26.65, label = left_team, angle = 90,
color = "white", size = 9, fontface = "bold"),
annotate("text", x = 115, y = 26.65, label = right_team, angle = -90,
color = "white", size = 9, fontface = "bold"),
annotate("segment", x = seq(15, 105, 5), xend = seq(15, 105, 5),
y = 0, yend = 53.3, color = "white", linewidth = 0.5),
annotate("segment", x = c(10, 110), xend = c(10, 110),
y = 0, yend = 53.3, color = "white", linewidth = 1.2),
annotate("segment", x = hash_x, xend = hash_x, y = 0.4, yend = 1.1, color = "white"),
annotate("segment", x = hash_x, xend = hash_x, y = 52.2, yend = 52.9, color = "white"),
annotate("segment", x = hash_x, xend = hash_x, y = 22.91, yend = 23.58, color = "white"),
annotate("segment", x = hash_x, xend = hash_x, y = 29.75, yend = 30.42, color = "white"),
annotate("text", x = num_x, y = 11, label = num_lb, color = "white",
size = 7, fontface = "bold"),
annotate("text", x = num_x, y = 42.3, label = num_lb, color = "white",
size = 7, fontface = "bold", angle = 180),
annotate("rect", xmin = 0, xmax = 120, ymin = 0, ymax = 53.3,
fill = NA, color = "white", linewidth = 1.5)
)
}
animate_play <- function(gid, pid, title_txt, x_window = NULL, post_frames = 40) {
wk <- games[gameId == gid, week]
trk <- fread(paste0("tracking_week_", wk, ".csv"))[gameId == gid & playId == pid]
info <- plays[gameId == gid & playId == pid]
off <- info$possessionTeam
def <- info$defensiveTeam
off_col <- unname(team_cols[off])
def_col <- unname(team_cols[def])
off_txt <- if (off %in% c("PIT", "NO")) "black" else "white"
def_txt <- if (def %in% c("PIT", "NO")) "black" else def_col
ls_f <- trk[event == "line_set", min(frameId)]
sn_f <- trk[frameType == "SNAP", min(frameId)]
trk <- trk[frameId >= ls_f - 5 & frameId <= sn_f + post_frames]
los <- trk[club == "football" & frameId == sn_f, x][1]
dir <- trk$playDirection[1]
fd <- if (dir == "right") los + info$yardsToGo else los - info$yardsToGo
mo_id <- motion_players[gameId == gid & playId == pid & in_motion == TRUE, nflId]
off_dt <- trk[club == off]
def_dt <- trk[club == def]
ball_dt <- trk[club == "football"]
mo_dt <- trk[nflId %in% mo_id]
frames <- sort(unique(trk$frameId))
mo_trk <- trk[nflId %in% mo_id, .(nflId, x, y, ord = frameId)]
setorder(mo_trk, nflId, ord)
trail_df <- rbindlist(lapply(frames, function(f) mo_trk[ord <= f][, frameId := f]))
phase_df <- data.table(frameId = frames)[
, phase := fifelse(frameId < sn_f, "PRE-SNAP", "POST-SNAP")]
xlim_use <- if (is.null(x_window)) c(0, 120) else c(los - x_window, los + x_window)
p <- ggplot() +
draw_field(off, def, dir) +
annotate("segment", x = los, xend = los, y = 0, yend = 53.3,
color = "#1e88e5", linewidth = 1.3) +
annotate("segment", x = fd, xend = fd, y = 0, yend = 53.3,
color = "#fdd835", linewidth = 1.3)
if (nrow(trail_df) > 0) {
p <- p + geom_path(data = trail_df, aes(x = x, y = y, group = nflId),
color = "#ffd600", linewidth = 1.2, alpha = 0.8)
}
p <- p +
geom_point(data = def_dt, aes(x = x, y = y),
shape = 21, size = 6, fill = "white", color = def_col, stroke = 2) +
geom_text(data = def_dt, aes(x = x, y = y, label = jerseyNumber),
color = def_txt, size = 2.6, fontface = "bold") +
geom_point(data = off_dt, aes(x = x, y = y),
shape = 21, size = 6, fill = off_col, color = "white", stroke = 0.8) +
geom_text(data = off_dt, aes(x = x, y = y, label = jerseyNumber),
color = off_txt, size = 2.6, fontface = "bold")
if (nrow(mo_dt) > 0) {
p <- p + geom_point(data = mo_dt, aes(x = x, y = y),
shape = 21, size = 8.5, fill = NA,
color = "#ffd600", stroke = 2)
}
p <- p +
geom_point(data = ball_dt, aes(x = x, y = y),
shape = 21, size = 3.5, fill = "#7B4A2A", color = "white") +
geom_label(data = phase_df, aes(x = mean(xlim_use), y = 56.3, label = phase),
fill = "black", color = "white", size = 5, fontface = "bold",
label.size = 0) +
coord_fixed(xlim = xlim_use, ylim = c(-1, 58), expand = FALSE) +
labs(title = title_txt,
subtitle = paste0(off, " offense (solid) vs ", def, " defense (white)",
" | Q", info$quarter, " ", info$gameClock,
" | ", info$down, " & ", info$yardsToGo,
" | Yards gained: ", info$yardsGained,
"\nBlue line = line of scrimmage Yellow line = first down"),
caption = str_wrap(info$playDescription, 120)) +
theme_void() +
theme(plot.background = element_rect(fill = "#24521d", color = NA),
plot.title = element_text(color = "white", face = "bold", size = 16),
plot.subtitle = element_text(color = "white", size = 10),
plot.caption = element_text(color = "white", size = 9, hjust = 0),
plot.margin = margin(10, 10, 10, 10)) +
transition_manual(frameId)
animate(p, nframes = length(frames), fps = 10,
width = 1200, height = 680, renderer = gifski_renderer())
}
if (!file.exists("motion_play.gif")) {
anim_motion <- animate_play(motion_play$gameId, motion_play$playId,
"BUF pre-snap motion (yellow ring + trail = motion player)")
anim_save("motion_play.gif", anim_motion)
}