# Set CRAN mirror
options(repos = c(CRAN = "https://cloud.r-project.org"))
# Load required packages
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.1 ✔ readr 2.1.6
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.1 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.1
## ── 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(data.table)
##
## Attaching package: 'data.table'
##
## The following objects are masked from 'package:lubridate':
##
## hour, isoweek, isoyear, mday, minute, month, quarter, second, wday,
## week, yday, year
##
## The following objects are masked from 'package:dplyr':
##
## between, first, last
##
## The following object is masked from 'package:purrr':
##
## transpose
library(janitor)
##
## Attaching package: 'janitor'
##
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.test
library(skimr)
library(corrplot)
## corrplot 0.95 loaded
library(GGally)
library(broom)
library(knitr)
# Set working directory
project_path <- "/Users/nathanaeljeffries/Documents/NFL-Big-Data-Bowl-Project"
# Set data folder
data_path <- file.path(project_path, "data", "raw")
# Set visual theme
theme_set(theme_minimal())
# Load player information
players <- fread(
file.path(data_path, "players.csv"),
data.table = FALSE
)
# Load combine results
combine_results <- fread(
file.path(data_path, "combine_results.csv"),
data.table = FALSE
)
# Load player career success
career_success <- fread(
file.path(data_path, "player_career_successes.csv"),
data.table = FALSE
)
# Load games
games <- fread(
file.path(data_path, "games.csv"),
data.table = FALSE
)
# Load player play information
player_play <- fread(
file.path(data_path, "player_play.csv"),
data.table = FALSE
)
# Load combine tracking
combine_tracking <- fread(
file.path(data_path, "combine_tracking.csv"),
data.table = FALSE
)
# Load smaller datasets
players <- data.table::fread(
"data/raw/players.csv",
data.table = FALSE
)
combine_results <- data.table::fread(
"data/raw/combine_results.csv",
data.table = FALSE
)
combine_tracking <- data.table::fread(
"data/raw/combine_tracking.csv",
data.table = FALSE
)
career_success <- data.table::fread(
"data/raw/player_career_successes.csv",
data.table = FALSE
)
player_play <- data.table::fread(
"data/raw/player_play.csv",
data.table = FALSE
)
games <- data.table::fread(
"data/raw/games.csv",
data.table = FALSE
)
# Standardize column names
players <- janitor::clean_names(players)
combine_results <- janitor::clean_names(combine_results)
combine_tracking <- janitor::clean_names(combine_tracking)
career_success <- janitor::clean_names(career_success)
player_play <- janitor::clean_names(player_play)
games <- janitor::clean_names(games)
Details of the Data:
Here are some details about the data sets such as rows, columns, and number of players at each position.
# Create a list of loaded datasets
datasets <- list(
Players = players,
Combine_Results = combine_results,
Combine_Tracking = combine_tracking,
Career_Success = career_success,
Player_Play = player_play,
Games = games
)
# Summarize dataset dimensions
dataset_summary <- data.frame(
Dataset = names(datasets),
Rows = sapply(datasets, nrow),
Columns = sapply(datasets, ncol)
)
knitr::kable(
dataset_summary,
caption = "Dataset Dimensions"
)
| Dataset | Rows | Columns | |
|---|---|---|---|
| Players | Players | 510 | 10 |
| Combine_Results | Combine_Results | 510 | 18 |
| Combine_Tracking | Combine_Tracking | 463189 | 14 |
| Career_Success | Career_Success | 510 | 9 |
| Player_Play | Player_Play | 314197 | 64 |
| Games | Games | 1002 | 7 |
# Display column names for every dataset
for (dataset_name in names(datasets)) {
cat("\n-----------------------------\n")
cat(dataset_name, "\n")
cat("-----------------------------\n")
print(names(datasets[[dataset_name]]))
}
##
## -----------------------------
## Players
## -----------------------------
## [1] "nfl_id" "display_name"
## [3] "draft_year" "nfl_position"
## [5] "birth_date" "college_name"
## [7] "college_conference" "draft_round"
## [9] "draft_pick_within_round" "draft_overall_pick"
##
## -----------------------------
## Combine_Results
## -----------------------------
## [1] "draft_year" "nfl_id"
## [3] "combine_position" "combine_height"
## [5] "combine_weight" "hand_size"
## [7] "arm_length" "wing_span"
## [9] "ten_yd_split" "forty"
## [11] "vertical" "broad_jump"
## [13] "three_cone" "short_shuttle"
## [15] "bench_reps" "ngs_athleticism_score"
## [17] "ngs_college_production_score" "ngs_final_score"
##
## -----------------------------
## Combine_Tracking
## -----------------------------
## [1] "draft_year" "event_id" "nfl_id" "entity_type" "time"
## [6] "drill_type" "drill_name" "attempt" "x" "y"
## [11] "s" "a" "dis" "dir"
##
## -----------------------------
## Career_Success
## -----------------------------
## [1] "nfl_id" "career_offensive_snaps"
## [3] "career_defensive_snaps" "career_special_teams_snaps"
## [5] "career_games_active" "career_games_started"
## [7] "ap_all_pro_1st_team" "ap_all_pro_2nd_team"
## [9] "pro_bowl_original_ballot"
##
## -----------------------------
## Player_Play
## -----------------------------
## [1] "game_id"
## [2] "play_id"
## [3] "team_abbr"
## [4] "nfl_id"
## [5] "lined_up_position"
## [6] "play_description"
## [7] "quarter"
## [8] "down"
## [9] "yards_to_go"
## [10] "possession_team"
## [11] "yardline_side"
## [12] "yardline_number"
## [13] "game_clock"
## [14] "pre_snap_home_score"
## [15] "pre_snap_visitor_score"
## [16] "play_direction"
## [17] "pre_snap_home_team_win_probability"
## [18] "pre_snap_visitor_team_win_probability"
## [19] "home_team_win_probability_added"
## [20] "visitor_team_win_probility_added"
## [21] "expected_points_added"
## [22] "expected_points"
## [23] "offense_formation"
## [24] "receiver_alignment"
## [25] "pass_result"
## [26] "pass_length"
## [27] "play_nullified_by_penalty"
## [28] "penalty_yards"
## [29] "pre_penalty_yards_gained"
## [30] "yards_gained"
## [31] "team_coverage_man_zone"
## [32] "team_coverage_type"
## [33] "in_motion_at_ball_snap"
## [34] "target"
## [35] "rec_yards"
## [36] "rush_yards"
## [37] "yards_after_catch"
## [38] "fumble"
## [39] "fumble_lost"
## [40] "route_ran"
## [41] "separation_at_pass_forward"
## [42] "cushion"
## [43] "expected_yards_after_catch"
## [44] "dropback_duration"
## [45] "extended_sack_allowed"
## [46] "pass_rushers_encountered"
## [47] "peak_pressure_probability_allowed"
## [48] "pressure_allowed"
## [49] "sack_allowed"
## [50] "time_to_pressure_allowed"
## [51] "quick_pressure"
## [52] "unblocked_pressure"
## [53] "blitzing"
## [54] "player_get_off"
## [55] "sack"
## [56] "tackle"
## [57] "assist"
## [58] "caused_forced_fumble"
## [59] "recovered_fumble"
## [60] "tackle_for_loss"
## [61] "time_to_pressure"
## [62] "time_to_qb_hurry"
## [63] "coverage_assignment"
## [64] "coverage_assignment_at_snap"
##
## -----------------------------
## Games
## -----------------------------
## [1] "game_id" "game_key" "season"
## [4] "season_type" "week" "home_team_abbr"
## [7] "visitor_team_abbr"
# Count players by position
position_summary <- players %>%
count(nfl_position, sort = TRUE)
knitr::kable(
position_summary,
caption = "Number of Players by Position"
)
| nfl_position | n |
|---|---|
| WR | 106 |
| CB | 60 |
| G | 51 |
| T | 50 |
| DT | 47 |
| TE | 42 |
| DE | 36 |
| OLB | 30 |
| SS | 28 |
| FS | 25 |
| C | 20 |
| DB | 5 |
| NT | 5 |
| ILB | 2 |
| FB | 1 |
| MLB | 1 |
| RB | 1 |
Here I will begin conducting some initial Exploratory Data Analysis on both of my research questions.
This first part is just additional setup:
# Load packages
library(dplyr)
library(tidyr)
library(ggplot2)
library(scales)
##
## Attaching package: 'scales'
## The following object is masked from 'package:purrr':
##
## discard
## The following object is masked from 'package:readr':
##
## col_factor
library(knitr)
# Establish a consistent chart theme
theme_set(
theme_minimal(base_size = 12)
)
nfl_theme <- theme(
plot.title = element_text(face = "bold", size = 14),
plot.subtitle = element_text(color = "gray40"),
axis.title = element_text(face = "bold"),
legend.position = "bottom",
panel.grid.minor = element_blank()
)
# Keep one record per player
players_clean <- players |>
dplyr::distinct(nfl_id, .keep_all = TRUE)
# Summarize combine results by player
combine_clean <- combine_results |>
dplyr::group_by(nfl_id) |>
dplyr::summarise(
dplyr::across(
dplyr::where(is.numeric),
function(x) {
if (all(is.na(x))) {
NA_real_
} else {
median(x, na.rm = TRUE)
}
}
),
combine_position = dplyr::first(combine_position),
.groups = "drop"
)
# Keep one career record per player
career_clean <- career_success |>
dplyr::distinct(nfl_id, .keep_all = TRUE)
# Join player, combine, and career information
player_analysis <- players_clean |>
dplyr::left_join(combine_clean, by = "nfl_id") |>
dplyr::left_join(career_clean, by = "nfl_id")
# Check the resulting dataset
dim(player_analysis)
## [1] 510 35
head(player_analysis)
## nfl_id display_name draft_year.x nfl_position birth_date college_name
## 1 55867 Will Anderson 2023 DE 2001-09-02 Alabama
## 2 55870 Paris Johnson 2023 T 2001-07-31 Ohio State
## 3 55874 Darnell Wright 2023 T 2001-08-10 Tennessee
## 4 55875 Peter Skoronski 2023 G 2001-07-31 Northwestern
## 5 55877 Lukas Van Ness 2023 DE 2001-07-06 Iowa
## 6 55878 Broderick Jones 2023 T 2001-05-16 Georgia
## college_conference draft_round draft_pick_within_round
## 1 Southeastern Conference 1 3
## 2 Big Ten Conference 1 6
## 3 Southeastern Conference 1 10
## 4 Big Ten Conference 1 11
## 5 Big Ten Conference 1 13
## 6 Southeastern Conference 1 14
## draft_overall_pick draft_year.y combine_height combine_weight hand_size
## 1 3 2023 75.500 253 9.875
## 2 6 2023 78.375 313 9.500
## 3 10 2023 77.375 333 9.000
## 4 11 2023 76.000 313 10.000
## 5 13 2023 77.000 272 11.000
## 6 14 2023 77.375 311 10.625
## arm_length wing_span ten_yd_split forty vertical broad_jump three_cone
## 1 33.875 81.000 1.61 4.60 NA NA NA
## 2 36.125 85.125 NA NA NA 110 NA
## 3 33.750 82.000 1.81 5.01 29.0 114 NA
## 4 32.250 79.500 1.75 5.16 34.5 115 7.80
## 5 34.000 81.750 1.64 4.58 31.0 118 7.02
## 6 34.750 82.750 1.74 4.97 30.0 108 NA
## short_shuttle bench_reps ngs_athleticism_score ngs_college_production_score
## 1 NA NA 76 99
## 2 NA 29 81 76
## 3 NA NA 84 70
## 4 NA 30 84 93
## 5 4.32 17 77 74
## 6 NA NA 82 81
## ngs_final_score combine_position career_offensive_snaps
## 1 91 DL 0
## 2 80 OL 2802
## 3 78 OL 3222
## 4 89 OL 3011
## 5 80 DL 0
## 6 82 OL 2468
## career_defensive_snaps career_special_teams_snaps career_games_active
## 1 1884 92 51
## 2 0 169 47
## 3 0 167 51
## 4 0 170 51
## 5 1056 387 51
## 6 0 149 45
## career_games_started ap_all_pro_1st_team ap_all_pro_2nd_team
## 1 44 1 0
## 2 43 0 0
## 3 49 0 1
## 4 48 0 0
## 5 2 0 0
## 6 38 0 0
## pro_bowl_original_ballot
## 1 1
## 2 0
## 3 0
## 4 0
## 5 0
## 6 0
Offensive Line - Is there a correlation between offensive line performance in agility/change of direction drills and performance in the league?
Here I will show some visuals for the exploratory analysis I conducted on this first research question.
# Identify offensive line positions
ol_positions <- c("T", "G", "C")
# Filter player data to include offensive linemen
ol_data <- player_analysis |>
dplyr::filter(nfl_position %in% ol_positions)
# Check the results
cat("Number of offensive linemen:", nrow(ol_data), "\n")
## Number of offensive linemen: 121
# Display player counts by position
ol_data |>
dplyr::count(nfl_position)
## nfl_position n
## 1 C 20
## 2 G 51
## 3 T 50
# Filter players to include offensive linemen
ol_players <- players %>%
filter(nfl_position %in% ol_positions)
# Count players by position
ol_position_counts <- ol_players %>%
count(nfl_position, sort = TRUE)
# Display counts
knitr::kable(
ol_position_counts,
col.names = c("Position", "Number of Players"),
caption = "Offensive Line Players by Position"
)
| Position | Number of Players |
|---|---|
| G | 51 |
| T | 50 |
| C | 20 |
ggplot(
ol_position_counts,
aes(
x = reorder(nfl_position, n),
y = n
)
) +
geom_col(fill = "steelblue") +
geom_text(
aes(label = n),
hjust = -0.2,
size = 4
) +
coord_flip() +
scale_y_continuous(
expand = expansion(mult = c(0, 0.15))
) +
labs(
title = "Distribution of Offensive Linemen",
subtitle = "Number of players by offensive line position",
x = "Position",
y = "Number of Players"
) +
nfl_theme
ol_combine_long <- ol_data |>
dplyr::select(
nfl_position,
forty,
ten_yd_split,
three_cone,
short_shuttle,
vertical,
broad_jump,
bench_reps
) |>
tidyr::pivot_longer(
cols = -nfl_position,
names_to = "measurement",
values_to = "result"
) |>
dplyr::filter(!is.na(result))
ggplot(
ol_combine_long,
aes(x = result)
) +
geom_histogram(
bins = 20,
fill = "steelblue",
color = "white"
) +
facet_wrap(
~ measurement,
scales = "free",
ncol = 2
) +
labs(
title = "NFL Combine Performance Among Offensive Linemen",
subtitle = "Distribution of combine measurements",
x = "Combine Result",
y = "Number of Players"
) +
nfl_theme
ggplot(
ol_data |>
dplyr::filter(!is.na(forty)),
aes(
x = nfl_position,
y = forty,
fill = nfl_position
)
) +
geom_boxplot(
alpha = 0.8,
show.legend = FALSE
) +
labs(
title = "40-Yard Dash Performance by Offensive Line Position",
subtitle = "Comparing straight-line speed among tackles, guards, and centers",
x = "Offensive Line Position",
y = "40-Yard Dash Time (Seconds)"
) +
nfl_theme
ggplot(
ol_data |>
dplyr::filter(!is.na(three_cone)),
aes(
x = nfl_position,
y = three_cone,
fill = nfl_position
)
) +
geom_boxplot(
alpha = 0.8,
show.legend = FALSE
) +
labs(
title = "3-Cone Drill Performance by Offensive Line Position",
subtitle = "Comparing change-of-direction ability",
x = "Offensive Line Position",
y = "3-Cone Time (Seconds)"
) +
nfl_theme
ol_speed_agility <- ol_data |>
dplyr::filter(
!is.na(forty),
!is.na(short_shuttle)
)
ggplot(
ol_speed_agility,
aes(
x = forty,
y = short_shuttle,
color = nfl_position
)
) +
geom_point(
alpha = 0.7,
size = 2.5
) +
geom_smooth(
method = "lm",
se = FALSE,
color = "black",
linetype = "dashed"
) +
labs(
title = "Offensive Line Speed versus Agility",
subtitle = "Relationship between 40-yard dash and 20-yard shuttle times",
x = "40-Yard Dash Time (Seconds)",
y = "20-Yard Shuttle Time (Seconds)",
color = "Position"
) +
nfl_theme
## `geom_smooth()` using formula = 'y ~ x'
ol_career_data <- ol_data |>
dplyr::filter(
!is.na(short_shuttle),
!is.na(career_offensive_snaps)
)
ggplot(
ol_career_data,
aes(
x = short_shuttle,
y = career_offensive_snaps,
color = nfl_position
)
) +
geom_point(
alpha = 0.7,
size = 2.5
) +
geom_smooth(
method = "lm",
se = FALSE,
color = "black",
linetype = "dashed"
) +
scale_y_continuous(
labels = scales::comma
) +
labs(
title = "Offensive Line Agility and NFL Career Snaps",
subtitle = "Examining the relationship between shuttle times and career playing time",
x = "20-Yard Shuttle Time (Seconds)",
y = "Career Offensive Snaps",
color = "Position"
) +
nfl_theme
## `geom_smooth()` using formula = 'y ~ x'
ggplot(
ol_data |>
dplyr::filter(
!is.na(three_cone),
!is.na(career_offensive_snaps)
),
aes(
x = three_cone,
y = career_offensive_snaps,
color = nfl_position
)
) +
geom_point(
alpha = 0.7,
size = 2.5
) +
geom_smooth(
method = "lm",
se = FALSE,
color = "black",
linetype = "dashed"
) +
scale_y_continuous(
labels = scales::comma
) +
labs(
title = "Offensive Line 3-Cone Performance and Career Snaps",
subtitle = "Examining the relationship between change-of-direction ability and NFL playing time",
x = "3-Cone Time (Seconds)",
y = "Career Offensive Snaps",
color = "Position"
) +
nfl_theme
## `geom_smooth()` using formula = 'y ~ x'
ol_games_long <- ol_data |>
dplyr::select(
nfl_position,
career_games_active,
career_games_started
) |>
tidyr::pivot_longer(
cols = c(
career_games_active,
career_games_started
),
names_to = "career_measure",
values_to = "games"
) |>
dplyr::filter(!is.na(games))
ggplot(
ol_games_long,
aes(
x = nfl_position,
y = games,
fill = nfl_position
)
) +
geom_boxplot(
alpha = 0.8,
show.legend = FALSE
) +
facet_wrap(
~ career_measure,
scales = "free_y"
) +
labs(
title = "NFL Career Experience by Offensive Line Position",
subtitle = "Comparing career games active and games started",
x = "Position",
y = "Number of Games"
) +
nfl_theme
ol_correlation_data <- ol_data |>
dplyr::select(
forty,
ten_yd_split,
three_cone,
short_shuttle,
vertical,
broad_jump,
bench_reps,
career_offensive_snaps,
career_games_active,
career_games_started
)
ol_correlations <- cor(
ol_correlation_data,
use = "pairwise.complete.obs"
)
ol_correlation_long <- as.data.frame(
as.table(ol_correlations)
)
ggplot(
ol_correlation_long,
aes(
x = Var1,
y = Var2,
fill = Freq
)
) +
geom_tile(color = "white") +
scale_fill_gradient2(
low = "red",
mid = "white",
high = "darkgreen",
midpoint = 0,
limits = c(-1, 1)
) +
labs(
title = "Offensive Line Combine and Career Statistics Correlation",
subtitle = "Exploring relationships between athletic measurements and NFL experience",
x = NULL,
y = NULL,
fill = "Correlation"
) +
theme_minimal() +
theme(
axis.text.x = element_text(
angle = 45,
hjust = 1
),
axis.title = element_blank()
)
Defensive Backs - Can you sort defensive backs into categories based on their NFL combine drills and predict if they will be better scheme fits for man or zone coverage?
Here I will dive into some exploratory analysis for this second research question:
# Common Defensive Back position labels
possible_db_positions <- c(
"CB",
"S",
"FS",
"SS",
"DB"
)
# Keep only labels actually found in the dataset
db_positions <- intersect(
possible_db_positions,
unique(players_clean$nfl_position)
)
# Display the positions selected
print(db_positions)
## [1] "CB" "FS" "SS" "DB"
# Display the number of players in each position
players_clean |>
dplyr::filter(nfl_position %in% db_positions) |>
dplyr::count(nfl_position, sort = TRUE)
## nfl_position n
## 1 CB 60
## 2 SS 28
## 3 FS 25
## 4 DB 5
db_data <- player_analysis |>
dplyr::filter(nfl_position %in% db_positions)
# Display the number of players included
nrow(db_data)
## [1] 118
# Display player counts by position
db_data |>
dplyr::count(nfl_position, sort = TRUE) |>
knitr::kable(
col.names = c("Position", "Number of Players"),
caption = "Defensive Back Players by Position"
)
| Position | Number of Players |
|---|---|
| CB | 60 |
| SS | 28 |
| FS | 25 |
| DB | 5 |
db_combine_long <- db_data |>
dplyr::select(
nfl_position,
forty,
ten_yd_split,
three_cone,
short_shuttle,
vertical,
broad_jump
) |>
tidyr::pivot_longer(
cols = -nfl_position,
names_to = "measurement",
values_to = "result"
) |>
dplyr::filter(!is.na(result))
ggplot(
db_combine_long,
aes(x = result)
) +
geom_histogram(
bins = 20,
fill = "darkgreen",
color = "white"
) +
facet_wrap(
~ measurement,
scales = "free",
ncol = 2
) +
labs(
title = "NFL Combine Performance Among Defensive Backs",
subtitle = "Distribution of speed, agility, and athletic measurements",
x = "Combine Result",
y = "Number of Players"
) +
nfl_theme
ggplot(
db_data |>
dplyr::filter(!is.na(forty)),
aes(
x = nfl_position,
y = forty,
fill = nfl_position
)
) +
geom_boxplot(
alpha = 0.8,
show.legend = FALSE
) +
labs(
title = "40-Yard Dash Performance by Defensive Back Position",
subtitle = "Comparing straight-line speed across positions",
x = "Defensive Back Position",
y = "40-Yard Dash Time (Seconds)"
) +
nfl_theme
db_speed_agility <- db_data |>
dplyr::filter(
!is.na(forty),
!is.na(short_shuttle)
)
ggplot(
db_speed_agility,
aes(
x = forty,
y = short_shuttle,
color = nfl_position
)
) +
geom_point(
alpha = 0.7,
size = 2.5
) +
geom_smooth(
method = "lm",
se = FALSE,
color = "black",
linetype = "dashed"
) +
labs(
title = "Defensive Back Speed versus Agility",
subtitle = "Relationship between 40-yard dash and 20-yard shuttle times",
x = "40-Yard Dash Time (Seconds)",
y = "20-Yard Shuttle Time (Seconds)",
color = "Position"
) +
nfl_theme
## `geom_smooth()` using formula = 'y ~ x'
These next visuals will all focus on building the athletic profile for defensive backs and comparing the different profiles in various contexts.
db_profiles <- db_speed_agility |>
dplyr::mutate(
speed_score = as.numeric(
scale(-forty)
),
agility_score = as.numeric(
scale(-short_shuttle)
)
) |>
dplyr::mutate(
speed_level = ifelse(
speed_score >= median(speed_score, na.rm = TRUE),
"Stronger Speed",
"Weaker Speed"
),
agility_level = ifelse(
agility_score >= median(agility_score, na.rm = TRUE),
"Stronger Agility",
"Weaker Agility"
),
athletic_profile = dplyr::case_when(
speed_level == "Stronger Speed" &
agility_level == "Stronger Agility" ~ "Well-Rounded",
speed_level == "Stronger Speed" &
agility_level == "Weaker Agility" ~ "Speed Specialist",
speed_level == "Weaker Speed" &
agility_level == "Stronger Agility" ~ "Agility Specialist",
TRUE ~ "Neither Specialty"
)
)
# Display the number of players in each profile
db_profiles |>
dplyr::count(athletic_profile, sort = TRUE) |>
knitr::kable(
col.names = c("Athletic Profile", "Number of Players")
)
| Athletic Profile | Number of Players |
|---|---|
| Well-Rounded | 9 |
| Speed Specialist | 7 |
| Neither Specialty | 6 |
| Agility Specialist | 5 |
ggplot(
db_profiles,
aes(
x = forty,
y = short_shuttle,
color = athletic_profile
)
) +
geom_point(
alpha = 0.75,
size = 2.5
) +
labs(
title = "Defensive Back Athletic Profiles",
subtitle = "Players classified by relative speed and agility",
x = "40-Yard Dash Time (Seconds)",
y = "20-Yard Shuttle Time (Seconds)",
color = "Athletic Profile"
) +
nfl_theme
ggplot(
db_profiles |>
dplyr::filter(!is.na(career_defensive_snaps)),
aes(
x = athletic_profile,
y = career_defensive_snaps,
fill = athletic_profile
)
) +
geom_boxplot(
alpha = 0.8,
show.legend = FALSE
) +
scale_y_continuous(
labels = scales::comma
) +
labs(
title = "NFL Career Defensive Snaps by Athletic Profile",
subtitle = "Comparing career playing time across four athletic categories",
x = "Athletic Profile",
y = "Career Defensive Snaps"
) +
nfl_theme +
theme(
axis.text.x = element_text(
angle = 20,
hjust = 1
)
)
ggplot(
db_profiles |>
dplyr::filter(!is.na(career_games_started)),
aes(
x = athletic_profile,
y = career_games_started,
fill = athletic_profile
)
) +
geom_boxplot(
alpha = 0.8,
show.legend = FALSE
) +
labs(
title = "Career Games Started by Defensive Back Athletic Profile",
subtitle = "Comparing starting experience across athletic categories",
x = "Athletic Profile",
y = "Career Games Started"
) +
nfl_theme +
theme(
axis.text.x = element_text(
angle = 20,
hjust = 1
)
)
db_play_stats <- player_play |>
dplyr::inner_join(
players_clean |>
dplyr::select(nfl_id, nfl_position),
by = "nfl_id"
) |>
dplyr::filter(nfl_position %in% db_positions) |>
dplyr::group_by(nfl_id) |>
dplyr::summarise(
plays_recorded = dplyr::n(),
tackles = sum(tackle, na.rm = TRUE),
assists = sum(assist, na.rm = TRUE),
tackles_for_loss = sum(tackle_for_loss, na.rm = TRUE),
forced_fumbles = sum(caused_forced_fumble, na.rm = TRUE),
sacks = sum(sack, na.rm = TRUE),
.groups = "drop"
)
# Connect defensive statistics to athletic profiles
db_performance <- db_profiles |>
dplyr::left_join(
db_play_stats,
by = "nfl_id"
)
head(db_performance)
## nfl_id display_name draft_year.x nfl_position birth_date college_name
## 1 55909 Julius Brents 2023 CB 2000-01-18 Kansas State
## 2 55921 Tyrique Stevenson 2023 CB 2000-05-26 Miami
## 3 55978 Clark Phillips 2023 CB 2001-12-19 Utah
## 4 56020 Darrell Luter 2023 CB 2000-04-24 South Alabama
## 5 56023 Daniel Scott 2023 SS 1998-10-26 California
## 6 56045 Kei'Trel Clark 2023 CB 2001-03-19 Louisville
## college_conference draft_round draft_pick_within_round
## 1 Big Twelve Conference 2 13
## 2 Atlantic Coast Conference 2 25
## 3 Pacific Twelve Conference 4 11
## 4 Sun Belt Conference 5 21
## 5 Pacific Twelve Conference 5 24
## 6 Atlantic Coast Conference 6 3
## draft_overall_pick draft_year.y combine_height combine_weight hand_size
## 1 44 2023 74.750 198 9.625
## 2 56 2023 72.375 198 9.625
## 3 113 2023 69.000 184 9.125
## 4 155 2023 71.750 189 10.375
## 5 158 2023 72.875 208 10.000
## 6 180 2023 70.250 181 8.250
## arm_length wing_span ten_yd_split forty vertical broad_jump three_cone
## 1 34.000 82.625 1.57 4.53 41.5 138 6.63
## 2 32.375 77.625 1.51 4.45 38.5 125 7.09
## 3 29.125 70.750 1.51 4.51 33.0 NA NA
## 4 32.375 77.875 1.57 4.46 40.5 123 6.90
## 5 30.250 74.375 1.55 4.45 39.5 128 6.75
## 6 29.625 72.375 1.49 4.42 34.5 122 NA
## short_shuttle bench_reps ngs_athleticism_score ngs_college_production_score
## 1 4.05 NA 80 74
## 2 4.41 NA 75 71
## 3 4.32 18 60 87
## 4 4.43 NA 69 58
## 5 4.17 22 88 63
## 6 4.21 NA 70 68
## ngs_final_score combine_position career_offensive_snaps
## 1 79 DB 0
## 2 75 DB 0
## 3 76 DB 0
## 4 63 DB 0
## 5 71 DB 0
## 6 69 DB 0
## career_defensive_snaps career_special_teams_snaps career_games_active
## 1 675 95 30
## 2 2228 254 51
## 3 821 162 39
## 4 338 420 34
## 5 13 50 4
## 6 762 369 50
## career_games_started ap_all_pro_1st_team ap_all_pro_2nd_team
## 1 11 0 0
## 2 40 0 0
## 3 7 0 0
## 4 3 0 0
## 5 0 0 0
## 6 9 0 0
## pro_bowl_original_ballot speed_score agility_score speed_level
## 1 0 -0.4337771 1.3347567 Weaker Speed
## 2 0 0.6431868 -1.2600104 Stronger Speed
## 3 0 -0.1645362 -0.6113186 Stronger Speed
## 4 0 0.5085663 -1.4041641 Stronger Speed
## 5 0 0.6431868 0.4698344 Stronger Speed
## 6 0 1.0470483 0.1815269 Stronger Speed
## agility_level athletic_profile plays_recorded tackles assists
## 1 Stronger Agility Agility Specialist 757 44 22
## 2 Weaker Agility Speed Specialist 2450 162 64
## 3 Weaker Agility Speed Specialist 931 54 13
## 4 Weaker Agility Speed Specialist 541 31 14
## 5 Stronger Agility Well-Rounded 169 5 2
## 6 Stronger Agility Well-Rounded 972 65 19
## tackles_for_loss forced_fumbles sacks
## 1 0 1 0
## 2 4 5 0
## 3 4 2 0
## 4 1 0 0
## 5 0 0 0
## 6 4 1 1
ggplot(
db_performance |>
dplyr::filter(!is.na(tackles)),
aes(
x = athletic_profile,
y = tackles,
fill = athletic_profile
)
) +
geom_boxplot(
alpha = 0.8,
show.legend = FALSE
) +
labs(
title = "Defensive Back Tackles by Athletic Profile",
subtitle = "Observed tackle totals in the player-play dataset",
x = "Athletic Profile",
y = "Tackles"
) +
nfl_theme +
theme(
axis.text.x = element_text(
angle = 20,
hjust = 1
)
)
Here I will begin looking at the different types of coverages in order to begin understanding how to qualify them.
# Reset the NA printing option
options(na.print = "NA")
# Inspect team-level coverage schemes
print(
player_play |>
dplyr::count(team_coverage_man_zone, sort = TRUE)
)
## team_coverage_man_zone n
## 1 ZONE_COVERAGE 197851
## 2 MAN_COVERAGE 77427
## 3 <NA> 38919
# Inspect player coverage assignments
print(
player_play |>
dplyr::count(coverage_assignment, sort = TRUE)
)
## coverage_assignment n
## 1 <NA> 241545
## 2 NO_ASSIGNMENT 29442
## 3 MAN 10745
## 4 CURL_FLAT_LEFT 2988
## 5 DEEP_THIRD_RIGHT 2859
## 6 CURL_FLAT_RIGHT 2781
## 7 DEEP_THIRD_MIDDLE 2655
## 8 DEEP_THIRD_LEFT 2065
## 9 QUARTERS_OUTSIDE_RIGHT 2042
## 10 QUARTERS_INSIDE_LEFT 2036
## 11 QUARTERS_INSIDE_RIGHT 1771
## 12 FLAT_RIGHT 1718
## 13 DEEP_HALF_LEFT 1692
## 14 DEEP_HALF_RIGHT 1481
## 15 DEEP_FREE 1469
## 16 HOOK_CURL_LEFT 1403
## 17 FLAT_LEFT 1361
## 18 HOOK_CURL_RIGHT 1358
## 19 QUARTERS_OUTSIDE_LEFT 1335
## 20 HOLE 1274
## 21 PREVENT 177
# Inspect coverage assignments at the snap
print(
player_play |>
dplyr::count(coverage_assignment_at_snap, sort = TRUE)
)
## coverage_assignment_at_snap n
## 1 <NA> 242072
## 2 NO_ASSIGNMENT 29153
## 3 MAN 10744
## 4 CURL_FLAT_LEFT 3098
## 5 CURL_FLAT_RIGHT 2929
## 6 DEEP_THIRD_RIGHT 2857
## 7 DEEP_THIRD_MIDDLE 2650
## 8 QUARTERS_INSIDE_LEFT 2355
## 9 QUARTERS_OUTSIDE_RIGHT 2301
## 10 QUARTERS_INSIDE_RIGHT 2132
## 11 DEEP_THIRD_LEFT 2011
## 12 DEEP_HALF_LEFT 1563
## 13 FLAT_RIGHT 1546
## 14 QUARTERS_OUTSIDE_LEFT 1418
## 15 DEEP_HALF_RIGHT 1340
## 16 DEEP_FREE 1297
## 17 FLAT_LEFT 1172
## 18 HOOK_CURL_LEFT 1151
## 19 HOOK_CURL_RIGHT 1151
## 20 HOLE 1071
## 21 PREVENT 186
db_coverage <- player_play |>
dplyr::inner_join(
players_clean |>
dplyr::select(nfl_id, nfl_position),
by = "nfl_id"
) |>
dplyr::filter(
nfl_position %in% db_positions,
!is.na(team_coverage_man_zone)
)
ggplot(
db_coverage,
aes(
x = team_coverage_man_zone,
fill = team_coverage_man_zone
)
) +
geom_bar(show.legend = FALSE) +
labs(
title = "Defensive Back Records by Team Coverage Scheme",
subtitle = "Distribution of player-play records in man and zone coverage",
x = "Team Coverage Scheme",
y = "Number of Records"
) +
nfl_theme
This concludes my Exploratory Analysis
I intend to continue looking into how to qualify Defensive Back performance in man and zone coverage in order to compare with the different athletic profiles of these DBs.
Thank you for reading through my work!