NFL Big Data Bowl - Best Kicker Assignment 1, IS470 FA26
Noah Parcover
2026-10-6
Assignment Description
The goal of this project is to accept the NFL Big Data Bowl Datasets for 2018-2020 and determine who is the best kicker. However, the criteria is who performs best under pressure. Using variables created using the score differential at the time of the kick, the amount of game remaining at the time of the kick, and the stage of the season in which the kick takes place.
Step 1. Load the CSV files
Import datasets for 2018,2019, and 2020. Combine the three into a new dataset called tracking_df.Finally, import the plays, players, and games datasets.
setwd("C:/Users/nparc/Downloads/School/Fall 26/IS470")
library(data.table)
library(dplyr)
library(ggplot2)
library(scales)
library(plotly)
#import
y1 <- fread("tracking2018.csv")
y2 <- fread("tracking2019.csv")
y3 <- fread("tracking2020.csv")
tracking_df <- rbind(y1, y2, y3)
rm(y1, y2, y3)
plays <- fread("plays.csv")
players <- fread("players.csv")
games <- fread("games.csv")Step 2. Create a dataset to compile field goal attempt, connect each kick to a kicker, and convert makes/misses into binary.
I began by determining score differential at the time of the kick and assigning it to a variable.
#create dataframe, connect nflId to kicker name
field_goals <- plays |>
filter(
specialTeamsPlayType == "Field Goal",
specialTeamsResult %in% c(
"Kick Attempt Good",
"Kick Attempt No Good"
)
) |>
left_join(
players |> select(nflId, displayName),
by = c("kickerId" = "nflId")
)
#convert to binary for ease later
field_goals <- field_goals |>
mutate(
made = ifelse(
specialTeamsResult == "Kick Attempt Good",
1,
0
)
)
names(field_goals)## [1] "gameId" "playId" "playDescription"
## [4] "quarter" "down" "yardsToGo"
## [7] "possessionTeam" "specialTeamsPlayType" "specialTeamsResult"
## [10] "kickerId" "returnerId" "kickBlockerId"
## [13] "yardlineSide" "yardlineNumber" "gameClock"
## [16] "penaltyCodes" "penaltyJerseyNumbers" "penaltyYards"
## [19] "preSnapHomeScore" "preSnapVisitorScore" "passResult"
## [22] "kickLength" "kickReturnYardage" "playResult"
## [25] "absoluteYardlineNumber" "displayName" "made"#collect teams
field_goals <- field_goals |>
left_join(
games |>
select(gameId, homeTeamAbbr, visitorTeamAbbr),
by = "gameId"
)
#check score differential
field_goals <- field_goals |>
mutate(
score_diff = case_when(
possessionTeam == homeTeamAbbr ~
preSnapHomeScore - preSnapVisitorScore,
possessionTeam == visitorTeamAbbr ~
preSnapVisitorScore - preSnapHomeScore,
TRUE ~ NA_real_
)
)Step 3. Visualize the location of the ball relative to the goal posts
Let’s take a look at where field goal attempts crossed the goal line
#convert time on clock to numeric
field_goals <- field_goals |>
mutate(
time_remaining = as.numeric(sub(":.*", "", gameClock)) * 60 +
as.numeric(sub(".*:", "", gameClock))
)
#calculate time remaining
field_goals <- field_goals |>
mutate(
total_time_remaining = case_when(
quarter <= 4 ~ time_remaining + (4 - quarter) * 15 * 60,
quarter > 4 ~ time_remaining,
TRUE ~ NA_real_
)
)
#table(is.na(field_goals$score_diff))
#table(is.na(field_goals$time_remaining))
field_goals <- field_goals |>
mutate(
score_pressure = 1 / (abs(score_diff) + 1)
)
field_goals <- field_goals |>
mutate(
time_pressure = 1 / (total_time_remaining / 60 + 1)
)
field_goals <- field_goals |>
mutate(
game_pressure = score_pressure * time_pressure
)
field_goals |>
select(
displayName,
quarter,
gameClock,
score_diff,
score_pressure,
time_pressure,
game_pressure
) |>
arrange(desc(game_pressure))## displayName quarter gameClock score_diff score_pressure
## <char> <int> <char> <num> <num>
## 1: Mason Crosby 4 00:03:00 0 1.00000000
## 2: Daniel Carlson 5 00:04:00 0 1.00000000
## 3: Wil Lutz 4 00:26:00 0 1.00000000
## 4: Ka'imi Fairbairn 4 00:06:00 0 1.00000000
## 5: Ka'imi Fairbairn 5 00:03:00 0 1.00000000
## ---
## 2600: Jason Myers 2 00:02:00 -31 0.03125000
## 2601: Aldrick Rosas 2 00:04:00 31 0.03125000
## 2602: Cody Parkey 2 00:03:00 32 0.03030303
## 2603: Joey Slye 2 00:36:00 -35 0.02777778
## 2604: Jason Sanders 2 10:43:00 -28 0.03448276
## time_pressure game_pressure
## <num> <num>
## 1: 1.00000000 1.0000000000
## 2: 1.00000000 1.0000000000
## 3: 1.00000000 1.0000000000
## 4: 1.00000000 1.0000000000
## 5: 1.00000000 1.0000000000
## ---
## 2600: 0.03225806 0.0010080645
## 2601: 0.03225806 0.0010080645
## 2602: 0.03225806 0.0009775171
## 2603: 0.03225806 0.0008960573
## 2604: 0.02439024 0.0008410429Step 4. Build Expected Field-Goal Model
fg_model <- glm(
made ~ kickLength,
data = field_goals,
family = binomial
)
field_goals <- field_goals |>
mutate(
expected_make = predict(
fg_model,
newdata = field_goals,
type = "response"
)
)
field_goals |>
select(
displayName,
kickLength,
made,
expected_make
)## displayName kickLength made expected_make
## <char> <int> <num> <num>
## 1: Matt Bryant 21 1 0.9846960
## 2: Jake Elliott 26 1 0.9730351
## 3: Matt Bryant 52 1 0.6407354
## 4: Justin Tucker 41 1 0.8642314
## 5: Stephen Hauschka 52 0 0.6407354
## ---
## 2600: Jason Myers 36 1 0.9190286
## 2601: Jason Myers 30 1 0.9578404
## 2602: Tristan Vizcaino 36 1 0.9190286
## 2603: Tristan Vizcaino 47 1 0.7607671
## 2604: Tristan Vizcaino 33 1 0.9413772field_goals <- field_goals |>
mutate(
performance = made - expected_make
)
field_goals <- field_goals |>
mutate(
pressure_performance = performance * game_pressure
)
summary(field_goals$game_pressure)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000841 0.003289 0.006944 0.043081 0.019325 1.000000field_goals |>
select(
displayName,
quarter,
gameClock,
score_diff,
kickLength,
made,
expected_make,
game_pressure,
pressure_performance
) |>
arrange(desc(game_pressure))## displayName quarter gameClock score_diff kickLength made
## <char> <int> <char> <num> <int> <num>
## 1: Mason Crosby 4 00:03:00 0 52 0
## 2: Daniel Carlson 5 00:04:00 0 35 0
## 3: Wil Lutz 4 00:26:00 0 44 1
## 4: Ka'imi Fairbairn 4 00:06:00 0 59 0
## 5: Ka'imi Fairbairn 5 00:03:00 0 37 1
## ---
## 2600: Jason Myers 2 00:02:00 -31 55 1
## 2601: Aldrick Rosas 2 00:04:00 31 23 1
## 2602: Cody Parkey 2 00:03:00 32 50 1
## 2603: Joey Slye 2 00:36:00 -35 23 1
## 2604: Jason Sanders 2 10:43:00 -28 54 1
## expected_make game_pressure pressure_performance
## <num> <num> <num>
## 1: 0.6407354 1.0000000000 -6.407354e-01
## 2: 0.9272293 1.0000000000 -9.272293e-01
## 3: 0.8181538 1.0000000000 1.818462e-01
## 4: 0.4424788 1.0000000000 -4.424788e-01
## 5: 0.9099934 1.0000000000 9.000658e-02
## ---
## 2600: 0.5576322 0.0010080645 4.459353e-04
## 2601: 0.9807892 0.0010080645 1.936572e-05
## 2602: 0.6920861 0.0009775171 3.009911e-04
## 2603: 0.9807892 0.0008960573 1.721397e-05
## 2604: 0.5859443 0.0008410429 3.482386e-04table(field_goals$quarter)##
## 1 2 3 4 5
## 444 950 473 710 27field_goals <- field_goals |>
mutate(
total_time_remaining = case_when(
quarter <= 4 ~ time_remaining + (4 - quarter) * 15 * 60,
quarter > 4 ~ time_remaining,
TRUE ~ NA_real_
)
)
range(field_goals$total_time_remaining, na.rm = TRUE)## [1] 0 3480field_goals <- field_goals |>
mutate(
score_pressure = 1 - pmin(abs(score_diff) / 14, 1),
time_pressure = 1 - pmin(total_time_remaining / (60 * 60), 1),
game_pressure = score_pressure * time_pressure,
pressure_performance = performance * game_pressure
)
summary(field_goals$game_pressure)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00000 0.09167 0.21667 0.28611 0.41786 1.00000field_goals |>
select(
displayName,
quarter,
gameClock,
score_diff,
kickLength,
made,
game_pressure
) |>
arrange(desc(game_pressure))## displayName quarter gameClock score_diff kickLength made
## <char> <int> <char> <num> <int> <num>
## 1: Mason Crosby 4 00:03:00 0 52 0
## 2: Daniel Carlson 5 00:04:00 0 35 0
## 3: Wil Lutz 4 00:26:00 0 44 1
## 4: Ka'imi Fairbairn 4 00:06:00 0 59 0
## 5: Ka'imi Fairbairn 5 00:03:00 0 37 1
## ---
## 2600: Dustin Hopkins 3 04:04:00 -17 26 1
## 2601: Jason Sanders 2 01:48:00 -18 32 1
## 2602: Greg Zuerlein 2 00:04:00 -14 57 1
## 2603: Ryan Succop 2 08:49:00 14 38 1
## 2604: Rodrigo Blankenship 2 02:41:00 17 24 1
## game_pressure
## <num>
## 1: 1
## 2: 1
## 3: 1
## 4: 1
## 5: 1
## ---
## 2600: 0
## 2601: 0
## 2602: 0
## 2603: 0
## 2604: 0names(games)## [1] "gameId" "season" "week" "gameDate"
## [5] "gameTimeEastern" "homeTeamAbbr" "visitorTeamAbbr"names(plays)## [1] "gameId" "playId" "playDescription"
## [4] "quarter" "down" "yardsToGo"
## [7] "possessionTeam" "specialTeamsPlayType" "specialTeamsResult"
## [10] "kickerId" "returnerId" "kickBlockerId"
## [13] "yardlineSide" "yardlineNumber" "gameClock"
## [16] "penaltyCodes" "penaltyJerseyNumbers" "penaltyYards"
## [19] "preSnapHomeScore" "preSnapVisitorScore" "passResult"
## [22] "kickLength" "kickReturnYardage" "playResult"
## [25] "absoluteYardlineNumber"game_results <- plays |>
group_by(gameId) |>
slice_max(playId, n = 1, with_ties = FALSE) |>
ungroup() |>
select(
gameId,
home_score = preSnapHomeScore,
visitor_score = preSnapVisitorScore
)
game_results <- game_results |>
left_join(
games |>
select(
gameId,
season,
week,
homeTeamAbbr,
visitorTeamAbbr
),
by = "gameId"
)
home_games <- game_results |>
transmute(
season,
week,
gameId,
team = homeTeamAbbr,
opponent = visitorTeamAbbr,
team_score = home_score,
opponent_score = visitor_score
)
away_games <- game_results |>
transmute(
season,
week,
gameId,
team = visitorTeamAbbr,
opponent = homeTeamAbbr,
team_score = visitor_score,
opponent_score = home_score
)
team_games <- bind_rows(home_games, away_games) |>
arrange(season, team, week)
team_games <- team_games |>
mutate(
result = case_when(
team_score > opponent_score ~ "W",
team_score < opponent_score ~ "L",
TRUE ~ "T"
)
)
team_games <- team_games |>
group_by(season, team) |>
mutate(
wins_before = lag(cumsum(result == "W"), default = 0),
losses_before = lag(cumsum(result == "L"), default = 0),
ties_before = lag(cumsum(result == "T"), default = 0)
) |>
ungroup()
team_games |>
select(
season,
week,
team,
opponent,
wins_before,
losses_before,
ties_before
)## # A tibble: 1,528 × 7
## season week team opponent wins_before losses_before ties_before
## <int> <int> <chr> <chr> <int> <int> <int>
## 1 2018 1 ARI WAS 0 0 0
## 2 2018 2 ARI LA 0 1 0
## 3 2018 3 ARI CHI 0 2 0
## 4 2018 4 ARI SEA 0 3 0
## 5 2018 5 ARI SF 0 3 1
## 6 2018 6 ARI MIN 1 3 1
## 7 2018 7 ARI DEN 1 4 1
## 8 2018 8 ARI SF 1 5 1
## 9 2018 10 ARI KC 2 5 1
## 10 2018 11 ARI OAK 2 6 1
## # ℹ 1,518 more rowsteam_games <- team_games |>
mutate(
games_played = wins_before + losses_before + ties_before,
win_pct = ifelse(
games_played == 0,
0,
(wins_before + 0.5 * ties_before) / games_played
)
)
afc_teams <- c(
"BAL", "BUF", "CIN", "CLE", "DEN", "HOU", "IND",
"JAX", "KC", "LV", "LAC", "MIA", "NE", "NYJ",
"PIT", "TEN"
)
team_games <- team_games |>
mutate(
conference = ifelse(team %in% afc_teams, "AFC", "NFC")
)
team_games <- team_games |>
group_by(season, week, conference) |>
mutate(
conference_rank = min_rank(desc(win_pct))
) |>
ungroup()
team_games <- team_games |>
mutate(
playoff_spots = case_when(
season <= 2019 ~ 6,
season == 2020 ~ 7
)
)
team_games <- team_games |>
mutate(
playoff_distance = conference_rank - playoff_spots,
playoff_race = case_when(
playoff_distance <= -2 ~ 0.25,
playoff_distance == -1 ~ 0.50,
playoff_distance == 0 ~ 1.00,
playoff_distance == 1 ~ 1.00,
playoff_distance == 2 ~ 0.75,
playoff_distance == 3 ~ 0.50,
playoff_distance >= 4 ~ 0.25
)
)
team_games <- team_games |>
mutate(
playoff_timing = case_when(
week <= 8 ~ 0.25,
week <= 12 ~ 0.50,
week <= 15 ~ 0.75,
week >= 16 ~ 1.00
)
)
team_games <- team_games |>
mutate(
playoff_importance = playoff_race * playoff_timing
)field_goals <- field_goals |>
left_join(
team_games |>
select(
gameId,
week,
team,
wins_before,
losses_before,
ties_before,
win_pct,
conference_rank,
playoff_race,
playoff_timing,
playoff_importance
),
by = c(
"gameId" = "gameId",
"possessionTeam" = "team"
)
)
field_goals |>
select(
gameId,
displayName,
possessionTeam,
wins_before,
losses_before,
win_pct,
conference_rank,
playoff_importance
)## gameId displayName possessionTeam wins_before losses_before
## <int> <char> <char> <int> <int>
## 1: 2018090600 Matt Bryant ATL 0 0
## 2: 2018090600 Jake Elliott PHI 0 0
## 3: 2018090600 Matt Bryant ATL 0 0
## 4: 2018090900 Justin Tucker BAL 0 0
## 5: 2018090900 Stephen Hauschka BUF 0 0
## ---
## 2600: 2021010315 Jason Myers SEA 11 3
## 2601: 2021010315 Jason Myers SEA 11 3
## 2602: 2021010315 Tristan Vizcaino SF 6 8
## 2603: 2021010315 Tristan Vizcaino SF 6 8
## 2604: 2021010315 Tristan Vizcaino SF 6 8
## win_pct conference_rank playoff_importance
## <num> <int> <num>
## 1: 0.0000000 1 0.0625
## 2: 0.0000000 1 0.0625
## 3: 0.0000000 1 0.0625
## 4: 0.0000000 1 0.0625
## 5: 0.0000000 1 0.0625
## ---
## 2600: 0.7666667 2 0.2500
## 2601: 0.7666667 2 0.2500
## 2602: 0.4333333 8 1.0000
## 2603: 0.4333333 8 1.0000
## 2604: 0.4333333 8 1.0000field_goals <- field_goals |>
mutate(
total_pressure = game_pressure * playoff_importance
)
summary(field_goals$total_pressure)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000000 0.009821 0.029167 0.060031 0.068750 1.000000field_goals |>
select(
displayName,
week,
possessionTeam,
wins_before,
losses_before,
conference_rank,
game_pressure,
playoff_importance,
total_pressure
) |>
arrange(desc(total_pressure))## displayName week possessionTeam wins_before losses_before
## <char> <int> <char> <int> <int>
## 1: Sam Sloman 17 TEN 8 5
## 2: Matthew McCrane 17 PIT 8 5
## 3: Matthew McCrane 17 PIT 8 5
## 4: Jason Sanders 16 MIA 9 5
## 5: Dustin Hopkins 16 WAS 6 7
## ---
## 2600: Dustin Hopkins 16 WAS 5 8
## 2601: Jason Sanders 17 MIA 10 5
## 2602: Greg Zuerlein 17 DAL 3 11
## 2603: Ryan Succop 17 TB 10 5
## 2604: Rodrigo Blankenship 17 IND 9 5
## conference_rank game_pressure playoff_importance total_pressure
## <int> <num> <num> <num>
## 1: 8 1.0000000 1.00 1.0000000
## 2: 6 0.9666667 1.00 0.9666667
## 3: 6 0.8666667 1.00 0.8666667
## 4: 7 0.8571429 1.00 0.8571429
## 5: 7 0.8047619 1.00 0.8047619
## ---
## 2600: 10 0.0000000 0.50 0.0000000
## 2601: 5 0.0000000 0.25 0.0000000
## 2602: 15 0.0000000 0.25 0.0000000
## 2603: 4 0.0000000 0.25 0.0000000
## 2604: 7 0.0000000 1.00 0.0000000names(team_games)## [1] "season" "week" "gameId"
## [4] "team" "opponent" "team_score"
## [7] "opponent_score" "result" "wins_before"
## [10] "losses_before" "ties_before" "games_played"
## [13] "win_pct" "conference" "conference_rank"
## [16] "playoff_spots" "playoff_distance" "playoff_race"
## [19] "playoff_timing" "playoff_importance"names(field_goals)## [1] "gameId" "playId" "playDescription"
## [4] "quarter" "down" "yardsToGo"
## [7] "possessionTeam" "specialTeamsPlayType" "specialTeamsResult"
## [10] "kickerId" "returnerId" "kickBlockerId"
## [13] "yardlineSide" "yardlineNumber" "gameClock"
## [16] "penaltyCodes" "penaltyJerseyNumbers" "penaltyYards"
## [19] "preSnapHomeScore" "preSnapVisitorScore" "passResult"
## [22] "kickLength" "kickReturnYardage" "playResult"
## [25] "absoluteYardlineNumber" "displayName" "made"
## [28] "homeTeamAbbr" "visitorTeamAbbr" "score_diff"
## [31] "time_remaining" "total_time_remaining" "score_pressure"
## [34] "time_pressure" "game_pressure" "expected_make"
## [37] "performance" "pressure_performance" "week"
## [40] "wins_before" "losses_before" "ties_before"
## [43] "win_pct" "conference_rank" "playoff_race"
## [46] "playoff_timing" "playoff_importance" "total_pressure"summary(field_goals$playoff_importance)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0625 0.0625 0.1250 0.2027 0.2500 1.0000summary(field_goals$total_pressure)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000000 0.009821 0.029167 0.060031 0.068750 1.000000field_goals |>
select(
displayName,
week,
possessionTeam,
wins_before,
losses_before,
conference_rank,
playoff_importance,
game_pressure,
total_pressure
) |>
arrange(desc(total_pressure))## displayName week possessionTeam wins_before losses_before
## <char> <int> <char> <int> <int>
## 1: Sam Sloman 17 TEN 8 5
## 2: Matthew McCrane 17 PIT 8 5
## 3: Matthew McCrane 17 PIT 8 5
## 4: Jason Sanders 16 MIA 9 5
## 5: Dustin Hopkins 16 WAS 6 7
## ---
## 2600: Dustin Hopkins 16 WAS 5 8
## 2601: Jason Sanders 17 MIA 10 5
## 2602: Greg Zuerlein 17 DAL 3 11
## 2603: Ryan Succop 17 TB 10 5
## 2604: Rodrigo Blankenship 17 IND 9 5
## conference_rank playoff_importance game_pressure total_pressure
## <int> <num> <num> <num>
## 1: 8 1.00 1.0000000 1.0000000
## 2: 6 1.00 0.9666667 0.9666667
## 3: 6 1.00 0.8666667 0.8666667
## 4: 7 1.00 0.8571429 0.8571429
## 5: 7 1.00 0.8047619 0.8047619
## ---
## 2600: 10 0.50 0.0000000 0.0000000
## 2601: 5 0.25 0.0000000 0.0000000
## 2602: 15 0.25 0.0000000 0.0000000
## 2603: 4 0.25 0.0000000 0.0000000
## 2604: 7 1.00 0.0000000 0.0000000field_goals <- field_goals |>
mutate(
total_pressure = game_pressure * playoff_importance
)
field_goals <- field_goals |>
mutate(
pressure_performance = performance * total_pressure
)
kicker_pressure <- field_goals |>
group_by(displayName) |>
summarise(
attempts = n(),
made = sum(made),
fg_percentage = mean(made),
expected_percentage = mean(expected_make),
above_expected = mean(performance),
pressure_performance = mean(pressure_performance),
high_pressure_attempts = sum(total_pressure >= 0.50),
.groups = "drop"
) |>
filter(attempts >= 10) |>
arrange(desc(pressure_performance))
kicker_pressure## # A tibble: 48 × 8
## displayName attempts made fg_percentage expected_percentage above_expected
## <chr> <int> <dbl> <dbl> <dbl> <dbl>
## 1 Matthew McCr… 11 8 8 0.830 -0.103
## 2 Justin Tucker 92 87 87 0.848 0.0976
## 3 Matt Bryant 34 28 28 0.808 0.0155
## 4 Dustin Hopki… 85 73 73 0.844 0.0151
## 5 Nick Folk 41 38 38 0.874 0.0532
## 6 Jason Sanders 83 71 71 0.840 0.0157
## 7 Harrison But… 84 77 77 0.877 0.0397
## 8 Jake Elliott 66 54 54 0.851 -0.0325
## 9 Josh Lambo 57 54 54 0.851 0.0961
## 10 Chandler Cat… 19 15 15 0.873 -0.0833
## # ℹ 38 more rows
## # ℹ 2 more variables: pressure_performance <dbl>, high_pressure_attempts <int>kicker_pressure |>
slice_head(n = 10)## # A tibble: 10 × 8
## displayName attempts made fg_percentage expected_percentage above_expected
## <chr> <int> <dbl> <dbl> <dbl> <dbl>
## 1 Matthew McCr… 11 8 8 0.830 -0.103
## 2 Justin Tucker 92 87 87 0.848 0.0976
## 3 Matt Bryant 34 28 28 0.808 0.0155
## 4 Dustin Hopki… 85 73 73 0.844 0.0151
## 5 Nick Folk 41 38 38 0.874 0.0532
## 6 Jason Sanders 83 71 71 0.840 0.0157
## 7 Harrison But… 84 77 77 0.877 0.0397
## 8 Jake Elliott 66 54 54 0.851 -0.0325
## 9 Josh Lambo 57 54 54 0.851 0.0961
## 10 Chandler Cat… 19 15 15 0.873 -0.0833
## # ℹ 2 more variables: pressure_performance <dbl>, high_pressure_attempts <int>kicker_pressure |>
select(
displayName,
attempts,
made,
fg_percentage,
expected_percentage,
above_expected,
pressure_performance,
high_pressure_attempts
) |>
arrange(desc(pressure_performance)) |>
slice_head(n = 15)## # A tibble: 15 × 8
## displayName attempts made fg_percentage expected_percentage above_expected
## <chr> <int> <dbl> <dbl> <dbl> <dbl>
## 1 Matthew McCr… 11 8 8 0.830 -0.103
## 2 Justin Tucker 92 87 87 0.848 0.0976
## 3 Matt Bryant 34 28 28 0.808 0.0155
## 4 Dustin Hopki… 85 73 73 0.844 0.0151
## 5 Nick Folk 41 38 38 0.874 0.0532
## 6 Jason Sanders 83 71 71 0.840 0.0157
## 7 Harrison But… 84 77 77 0.877 0.0397
## 8 Jake Elliott 66 54 54 0.851 -0.0325
## 9 Josh Lambo 57 54 54 0.851 0.0961
## 10 Chandler Cat… 19 15 15 0.873 -0.0833
## 11 Austin Seibe… 34 27 27 0.854 -0.0598
## 12 Mike Nugent 19 17 17 0.901 -0.00650
## 13 Mason Crosby 71 63 63 0.846 0.0411
## 14 Wil Lutz 85 77 77 0.864 0.0417
## 15 Graham Gano 45 42 42 0.833 0.100
## # ℹ 2 more variables: pressure_performance <dbl>, high_pressure_attempts <int>field_goals |>
summarise(
total_kicks = n(),
high_pressure_kicks = sum(total_pressure >= 0.50, na.rm = TRUE),
average_pressure = mean(total_pressure, na.rm = TRUE),
max_pressure = max(total_pressure, na.rm = TRUE)
)## total_kicks high_pressure_kicks average_pressure max_pressure
## 1 2604 24 0.06003073 1field_goals |>
select(
displayName,
week,
possessionTeam,
kickLength,
made,
expected_make,
game_pressure,
playoff_importance,
total_pressure
) |>
arrange(desc(total_pressure)) |>
slice_head(n = 20)## displayName week possessionTeam kickLength made expected_make
## <char> <int> <char> <int> <num> <num>
## 1: Sam Sloman 17 TEN 37 1 0.9099934
## 2: Matthew McCrane 17 PIT 35 1 0.9272293
## 3: Matthew McCrane 17 PIT 47 1 0.7607671
## 4: Jason Sanders 16 MIA 44 1 0.8181538
## 5: Dustin Hopkins 16 WAS 46 1 0.7811800
## 6: Jake Elliott 17 PHI 50 1 0.6920861
## 7: Greg Zuerlein 16 LA 52 1 0.6407354
## 8: Jason Sanders 16 MIA 22 1 0.9828516
## 9: Matt Bryant 17 ATL 37 1 0.9099934
## 10: Daniel Carlson 16 LV 22 1 0.9828516
## 11: Tristan Vizcaino 17 SF 33 1 0.9413772
## 12: Dustin Hopkins 16 WAS 40 1 0.8772406
## 13: Younghoe Koo 16 ATL 39 0 0.8891632
## 14: Cairo Santos 15 CHI 42 1 0.8500792
## 15: Matt Gay 16 TB 41 1 0.8642314
## 16: Dustin Hopkins 15 WAS 36 1 0.9190286
## 17: Daniel Carlson 16 LV 20 1 0.9863448
## 18: Ryan Succop 16 TEN 33 1 0.9413772
## 19: Daniel Carlson 15 LV 23 1 0.9807892
## 20: Justin Tucker 16 BAL 56 1 0.5289405
## displayName week possessionTeam kickLength made expected_make
## <char> <int> <char> <int> <num> <num>
## game_pressure playoff_importance total_pressure
## <num> <num> <num>
## 1: 1.0000000 1.0000 1.0000000
## 2: 0.9666667 1.0000 0.9666667
## 3: 0.8666667 1.0000 0.8666667
## 4: 0.8571429 1.0000 0.8571429
## 5: 0.8047619 1.0000 0.8047619
## 6: 0.7666667 1.0000 0.7666667
## 7: 0.7595238 1.0000 0.7595238
## 8: 0.7333333 1.0000 0.7333333
## 9: 0.9285714 0.7500 0.6964286
## 10: 0.9285714 0.7500 0.6964286
## 11: 0.6500000 1.0000 0.6500000
## 12: 0.6190476 1.0000 0.6190476
## 13: 0.7857143 0.7500 0.5892857
## 14: 0.7726190 0.7500 0.5794643
## 15: 0.5761905 1.0000 0.5761905
## 16: 1.0000000 0.5625 0.5625000
## 17: 0.7166667 0.7500 0.5375000
## 18: 0.5357143 1.0000 0.5357143
## 19: 0.9500000 0.5625 0.5343750
## 20: 0.5238095 1.0000 0.5238095
## game_pressure playoff_importance total_pressure
## <num> <num> <num>kicker_pressure |>
select(
displayName,
attempts,
made,
fg_percentage,
expected_percentage,
above_expected,
pressure_performance,
high_pressure_attempts
) |>
arrange(desc(pressure_performance)) |>
slice_head(n = 15)## # A tibble: 15 × 8
## displayName attempts made fg_percentage expected_percentage above_expected
## <chr> <int> <dbl> <dbl> <dbl> <dbl>
## 1 Matthew McCr… 11 8 8 0.830 -0.103
## 2 Justin Tucker 92 87 87 0.848 0.0976
## 3 Matt Bryant 34 28 28 0.808 0.0155
## 4 Dustin Hopki… 85 73 73 0.844 0.0151
## 5 Nick Folk 41 38 38 0.874 0.0532
## 6 Jason Sanders 83 71 71 0.840 0.0157
## 7 Harrison But… 84 77 77 0.877 0.0397
## 8 Jake Elliott 66 54 54 0.851 -0.0325
## 9 Josh Lambo 57 54 54 0.851 0.0961
## 10 Chandler Cat… 19 15 15 0.873 -0.0833
## 11 Austin Seibe… 34 27 27 0.854 -0.0598
## 12 Mike Nugent 19 17 17 0.901 -0.00650
## 13 Mason Crosby 71 63 63 0.846 0.0411
## 14 Wil Lutz 85 77 77 0.864 0.0417
## 15 Graham Gano 45 42 42 0.833 0.100
## # ℹ 2 more variables: pressure_performance <dbl>, high_pressure_attempts <int>kicker_pressure_final <- field_goals |>
group_by(displayName) |>
summarise(
attempts = n(),
made = sum(made),
fg_percentage = mean(made),
expected_percentage = mean(expected_make),
above_expected = mean(performance),
pressure_weighted_performance =
sum(performance * total_pressure, na.rm = TRUE) /
sum(total_pressure, na.rm = TRUE),
high_pressure_attempts =
sum(total_pressure >= 0.50, na.rm = TRUE),
total_pressure = sum(total_pressure, na.rm = TRUE),
.groups = "drop"
) |>
filter(attempts >= 10) |>
arrange(desc(pressure_weighted_performance))
kicker_pressure_final |>
select(
displayName,
attempts,
made,
fg_percentage,
expected_percentage,
above_expected,
pressure_weighted_performance,
high_pressure_attempts
) |>
slice_head(n = 15)## # A tibble: 15 × 8
## displayName attempts made fg_percentage expected_percentage above_expected
## <chr> <int> <dbl> <dbl> <dbl> <dbl>
## 1 Matt Bryant 34 28 28 0.808 0.0155
## 2 Matthew McCr… 11 8 8 0.830 -0.103
## 3 Dustin Hopki… 85 73 73 0.844 0.0151
## 4 Nick Folk 41 38 38 0.874 0.0532
## 5 Justin Tucker 92 87 87 0.848 0.0976
## 6 Harrison But… 84 77 77 0.877 0.0397
## 7 Mike Nugent 19 17 17 0.901 -0.00650
## 8 Josh Lambo 57 54 54 0.851 0.0961
## 9 Jason Sanders 83 71 71 0.840 0.0157
## 10 Mason Crosby 71 63 63 0.846 0.0411
## 11 Graham Gano 45 42 42 0.833 0.100
## 12 Wil Lutz 85 77 77 0.864 0.0417
## 13 Austin Seibe… 34 27 27 0.854 -0.0598
## 14 Sergio Casti… 12 8 8 0.837 -0.170
## 15 Tyler Bass 28 22 22 0.817 -0.0314
## # ℹ 2 more variables: pressure_weighted_performance <dbl>,
## # high_pressure_attempts <int>kicker_pressure_final |>
arrange(desc(high_pressure_attempts)) |>
select(
displayName,
attempts,
high_pressure_attempts,
pressure_weighted_performance
)## # A tibble: 48 × 4
## displayName attempts high_pressure_attempts pressure_weighted_performance
## <chr> <int> <int> <dbl>
## 1 Dustin Hopkins 85 3 0.123
## 2 Daniel Carlson 77 3 -0.0915
## 3 Matthew McCrane 11 2 0.138
## 4 Jason Sanders 83 2 0.0841
## 5 Cairo Santos 50 2 0.0210
## 6 Matt Bryant 34 1 0.143
## 7 Justin Tucker 92 1 0.109
## 8 Harrison Butker 84 1 0.0913
## 9 Jake Elliott 66 1 0.0453
## 10 Younghoe Koo 57 1 -0.0330
## # ℹ 38 more rowsfield_goals <- field_goals |>
select(-any_of("season")) |>
left_join(
games |> select(gameId, season),
by = "gameId"
)kicker_season <- field_goals |>
group_by(season, displayName) |>
summarise(
attempts = n(),
made = sum(made),
accuracy = mean(made) * 100,
above_expected = mean(performance) * 100,
pressure_weighted_performance = ifelse(
sum(total_pressure, na.rm = TRUE) > 0,
sum(performance * total_pressure, na.rm = TRUE) /
sum(total_pressure, na.rm = TRUE) * 100,
NA_real_
),
.groups = "drop"
)library(plotly)
library(dplyr)
plot_data <- kicker_season |>
filter(attempts >= 10) |>
mutate(
season = factor(season),
hover_text = paste0(
"Kicker: ", displayName,
"<br>Season: ", season,
"<br>Attempts: ", attempts,
"<br>Made: ", made,
"<br>Accuracy: ", round(accuracy, 1), "%",
"<br>Above expected: ", round(above_expected, 2),
" percentage points",
"<br>Pressure performance: ",
round(pressure_weighted_performance, 2)
)
)
plot_ly(
data = plot_data,
x = ~pressure_weighted_performance,
y = ~reorder(displayName, pressure_weighted_performance),
color = ~season,
text = ~hover_text,
hoverinfo = "text",
type = "bar",
orientation = "h"
) |>
layout(
barmode = "group",
title = "NFL Kicker Pressure Performance by Season",
xaxis = list(title = "Pressure-Weighted Performance"),
yaxis = list(title = "Kicker", automargin = TRUE),
legend = list(title = list(text = "Season")),
height = 900
)## Warning: Specifying width/height in layout() is now deprecated.
## Please specify in ggplotly() or plot_ly()library(ggplot2)
library(dplyr)
top15_season <- kicker_season |>
filter(attempts >= 10) |>
group_by(season) |>
slice_max(
order_by = pressure_weighted_performance,
n = 15,
with_ties = FALSE
) |>
ungroup()
ggplot(
top15_season,
aes(
x = pressure_weighted_performance,
y = reorder(displayName, pressure_weighted_performance),
fill = pressure_weighted_performance
)
) +
geom_col() +
facet_wrap(~ season, scales = "free_y") +
scale_fill_gradient2(
low = "darkred",
mid = "white",
high = "darkgreen",
midpoint = 0,
limits = c(-0.20, 0.20),
oob = scales::squish,
name = "Pressure\nPerformance"
) +
labs(
title = "Top 15 NFL Kickers Under Pressure by Season",
x = "Pressure-Weighted Performance",
y = "Kicker"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.y = element_text(size = 7),
legend.position = "bottom"
)
Conclusion
Here are some takeaway conclusions from my project.
