Phase 2

Setup:

# 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 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"
)
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

Exploratory Analysis:

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

Research Question 1:

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"
)
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()
  )

Research Question 2:

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"
  )
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'

DB Athletic Profile:

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
    )
  )

Coverages:

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!