NFL Names Analysis

knitr::opts_chunk$set(
  fig.width = 12,
  fig.height = 9,
  out.width = "100%",
  dpi = 150,
  message = FALSE,
  warning = FALSE
)

library(data.table)
library(nflreadr)
library(ggplot2)
library(dplyr)
library(tidyverse)

name_theme <- theme_minimal(base_family = 'mono', base_size = 16) +
  theme(
    plot.margin  = margin(20, 20, 20, 20),
    text         = element_text(color = 'black', face = 'bold'),
    plot.title   = element_text(color = 'black', face = 'bold', size = 16),
    axis.title   = element_text(color = 'black', face = 'bold'),
    axis.text    = element_text(color = 'black', face = 'bold')
  )

#It's time to find THE NFL player -- or rather the player in the NFL with the most common name in the nfl

#let's use the 2026 player state data set as that will have the most up-to-date names in it
player_stats <- load_player_stats(2026, file_type = "csv")

#players are in the data set for each game they play and to find the most common name in the league, we want to account for each player only once. Some players may also have the same name as each other, so we'll need to do a few things first

# 1) subset player_id (a unique identifier) and player_display_name
# 2) remove all rows with duplicate player_id
# 3) make new columns with just first names and just last names
# 4) count each instance of unique first names, and each instance of unique last names
# 5) see what first and last names are the most common
# 6) find the player(s) with the most common full name

#first we only need the player_id and player_display_name columns


#1)
#storing the subset into a new variable 'names'
#I didn't show this form of subsetting earlier, oh well here it is: writing in the name of the column you want WITH NO COMMA
names <- player_stats[,c('player_id', 'player_display_name', 'headshot_url', 'team')]


#2)
#now remove all rows with duplicate player_id
#using the dplyr package to do some spice here
library(dplyr)

#update the names df use the %>% function to funnel the names df into the distinct() function
#distinct() will get the first instance of a unque value from a df, the .keep_all=TRUE argument keeps all the columns (it will drop them otherwise)
names <- names %>% distinct(player_id, .keep_all = TRUE)


#3)
#Now it's time to isolate the first and last names

#mutate() can add new columns to the data frame. In this case the new column first_name = (function)

#sub() separates a string into pieces based on the regular expression rules given to it. I'm not getting into regular expression right now, but what I have here splits names in the player_display_name column on the ' ' between first and last name.
names <- names %>%
  mutate(
    first_name = sub(" .*", "", player_display_name),
    last_name = sub("^\\S+ ", "", player_display_name)
  )

#4)


first_count <- names %>% count(first_name, sort = TRUE)
last_count <- names %>% count(last_name, sort = TRUE)

#let's see the 5 most common first names
head(first_count, 5)

#the most common first name is ......JORDAN

#now last names
head(last_count, 5)

#the most common last name is .......WILLIAMS

#is there a JORDAN WILLIAMS in the NFL, making him THE NFL player to exist?
#the tryCatch() function will attempt to run a function, and if an error occurs (if no Jordan Williams exists) it won't throw an error and send a message to the console instead.
tryCatch({
  names[player_display_name == "Jordan Williams",]
}, error = function(e) {
  message("There is no Jordan Williams")
})

#There is NO Jordan Williams in the NFL, but then who is THE football player, THE guy who has THE name of the NFL? This is where data analysis becomes a bit subjective, but we can still get somewhere. Let's then say that the person with THE NFL name is the player with the first/last name combination that has the HIGHEST total name count. For example a player named Chris (n=13) Williams (n=19) would have a total name count of 32 (13 + 19). Whoever has this highest value (and I think I know who it is just looking at the top 5 first/last names) will be named as THE NFL player to EVER EXIST (in 2026).

#I'll do this by adding a NEW column called total_count that has the value of each players sum of first/last name values

names <- names %>%
  #funnel names into the left_join() function, left_join() matches rows in the second df (first_count) to values in the first df (names), via a common value ('first_name)
  left_join(first_count, by = "first_name") %>%
  #each player's first name's count will be in a new column, want to rename it to first_n
  rename(first_n = n) %>%
  #same logic with the last name
  left_join(last_count, by = "last_name") %>%
  rename(last_n = n) %>%
  #add the new columns together to get each players total value
  mutate(total_count = first_n + last_n)

#now all that's left to do is order the names df by descending order on the total_count column
names <- names %>% arrange(desc(total_count))


#now let's see who have the top 5 most common names in the NFL
head(names[c('player_display_name','total_count')])

#And there it is JORDAN WILLIAMS is THE NFL player. As of this writing he's a running back on the Tampa Bay Buccaneers in his 2nd year in the league. I was really really close with my earlier guess (I was thinking of Chris Jones). But there's the answer, we've solved a mystery that otherwise may have gone completely unsolved

library(ggplot2)
library(ggimage)


theme_set(theme_classic(base_size = 20))


g <- ggplot(head(first_count), aes(reorder(first_name, -n), n)) #reorder(first_name, -n) organizes the bar plot in descending order
g <- g + geom_bar(stat="identity", width = 0.5, fill="darkorchid3") + 
      labs(title="Most Common NFL First Names", y='Frequency',x='First Name') +
      name_theme +
      theme(axis.text.x = element_text(angle=65, vjust=0.6), plot.title = element_text(hjust = 0.5))

g

ggsave(filename = "~/Documents/NFL_names/common_first_names.png", g, width = 12, height = 9, dpi = 300, bg = "white")

g <- ggplot(head(last_count), aes(reorder(last_name, -n), n))
g <- g + geom_bar(stat="identity", width = 0.5, fill="darkorchid3") + 
      labs(title="Most Common NFL Last Names", y='Frequency',x='Last Name') +
      name_theme +
      theme(axis.text.x = element_text(angle=65, vjust=0.6), plot.title = element_text(hjust = 0.5))

g

ggsave(filename = "~/Documents/NFL_names/common_last_names.png", g, width = 12, height = 9, dpi = 300, bg = "white")

top_names <- head(names) %>%
  mutate(label = paste0(player_display_name, " (", team, ")"))

g <- ggplot(top_names, aes(reorder(label, -total_count), total_count)) 
g <- g + geom_bar(stat="identity", width = 0.5, fill="darkorchid3") +
  geom_image(aes(image = headshot_url), size = 0.15, by = "width", asp = 1.5) + #add player portraits to the tops of each bar
  expand_limits(y = max(head(names)$total_count) * 1.15) + #increase y-axis so player portraits aren't clipped
      labs(title="Highest Name Scores", y='Name Score',x='Full Name') +
      name_theme +
      theme(axis.text.x = element_text(angle=45, vjust=0.6), plot.title = element_text(hjust = 0.5))

g

ggsave(filename = "~/Documents/NFL_names/most_common_full_names.png", g, width = 12, height = 9, dpi = 300, bg = "white")

#get same info but at the team level

team_counts <- names %>%
  filter(!is.na(team)) %>%
  group_by(team) %>%
  summarise(
    first_n = sum(first_n),
    last_n  = sum(last_n)) %>%
  mutate(total_score = first_n + last_n)



team_logo <- load_teams(current = TRUE) |>
  select(team_abbr, team_logo_espn)


team_counts <- left_join(team_counts, team_logo, by = c('team' = 'team_abbr'))

team_counts <- team_counts %>% arrange(desc(total_score))

head(team_counts)

top5_teams <- head(team_counts, 5)
top5_teams$group <- 'top'

bottom5_teams <- tail(team_counts, 5)
bottom5_teams$group <- 'bottom'

top_bottom <- bind_rows(top5_teams, bottom5_teams)



g <- ggplot(top_bottom, aes(reorder(team, -total_score), total_score, fill=group)) 
g <- g + geom_bar(stat="identity", width = 0.5) +
  geom_image(aes(image = team_logo_espn), size = 0.07, by = "width", asp = 1.5) +
  scale_fill_manual(values = c(top = "steelblue", bottom = "red"),
                    breaks = c("top", "bottom"),
                    labels = c("Top 5", "Bottom 5")) +
  expand_limits(y = max(top_bottom$total_score) * 1.15) + 
      labs(title="Team Highest/Lowest Name Scores", y='Name Score',x='Team') +
      name_theme +
      theme(axis.text.x = element_text(angle=30, vjust=0.6), plot.title = element_text(hjust = 0.5))

g

ggsave(filename = "~/Documents/NFL_names/most_common_team_names.png", g, width = 12, height = 9, dpi = 300, bg = "white")

last_mean <- mean(team_counts$last_n)
first_mean <- mean(team_counts$first_n)
y_min <- min(team_counts$last_n)
x_min <- min(team_counts$first_n)
y_max <- max(team_counts$last_n)
x_max <- max(team_counts$first_n)

g <- ggplot(team_counts, aes(x=first_n, y=last_n)) +
  geom_image(aes(image = team_logo_espn), size = 0.05, asp = 1.5) +
  geom_vline(aes(xintercept = first_mean), linewidth = .5, linetype = "dashed", show.legend = FALSE) +
  geom_hline(aes(yintercept = last_mean), linewidth = .5, linetype = "dashed", show.legend = FALSE) + 
  annotate("text", x = x_min, y = y_max, hjust = 0, vjust = 1,
           label = "common last names,\nrare first names", color = "grey40") +
  annotate("text", x = x_max, y = y_max, hjust = 1, vjust = 1,
           label = "common last names,\ncommon first names", color = "grey40") +
  annotate("text", x = x_min, y = y_min, hjust = 0, vjust = 0,
           label = "rare last names,\nrare first names", color = "grey40") +
  annotate("text", x = x_max, y = y_min, hjust = 1, vjust = 0,
           label = "rare last names,\ncommon first names", color = "grey40") +
  expand_limits(x = c(x_min - 0.5, x_max + 0.5),
                y = c(y_min - 0.5, y_max + 0.5)) +
  labs(title=str_wrap('Team First Name Frequency Score vs. Last Name Frequency Score', width=40), x = 'First Name Frequency Score', y = 'Last Name Frequency Score') +
  theme(plot.title = element_text(hjust = 0.5)) +
  name_theme

g

ggsave(filename = "~/Documents/NFL_names/team_name_scatter.png", g, width = 12, height = 9, dpi = 300, bg = "white")