Code to create a plot of weekly dakota smoothed for selected QBs by @mrcaseb

weekly_dakota.R

library(tidyverse)

# Lee Sharpe's brightness function ----------------------------------------

brightness <- function(hex) {
  result <- rep(0, length(hex))
  for (i in 2:7)
  {
    ch <- substr(hex, i, i)
    result <- result + ifelse(i %% 2 == 0, 16, 1) * case_when(
      ch == "0" ~ 0, ch == "1" ~ 1, ch == "2" ~ 2, ch == "3" ~ 3, ch == "4" ~ 4,
      ch == "5" ~ 5, ch == "6" ~ 6, ch == "7" ~ 7, ch == "8" ~ 8, ch == "9" ~ 9,
      ch == "a" | ch == "A" ~ 10,
      ch == "b" | ch == "B" ~ 11,
      ch == "c" | ch == "C" ~ 12,
      ch == "d" | ch == "D" ~ 13,
      ch == "e" | ch == "E" ~ 14,
      ch == "f" | ch == "F" ~ 15,
      TRUE ~ 0
    )
  }
  return(result)
}

# load and prepare data ---------------------------------------------------

stats <- nflfastR::load_player_stats()

all <- stats %>%
  filter(season >= 2006) %>% 
  filter(!is.na(dakota)) %>%
  mutate(gid = glue::glue("{season}_{formatC(week, width=2, flag='0')}")) %>%
  left_join(nflfastR::teams_colors_logos, by = c("recent_team" = "team_abbr")) %>%
  group_by(player_id) %>%
  arrange(season) %>%
  mutate(team_color = last(team_color), team_color2 = last(team_color2)) %>%
  ungroup()

breaks <- all %>%
  filter(week == 1) %>%
  pull(gid) %>%
  unique()

players <- c(
  "A.Luck",
  "R.Tannehill",
  "N.Foles",
  "K.Cousins",
  "R.Wilson"
)

cols_breaks <- all %>% 
  filter(player_name %in% players) %>% 
  mutate(use_color=ifelse(brightness(team_color) > 140,team_color,team_color2)) %>%
  select(player_name, use_color) %>% 
  distinct() %>% 
  arrange(player_name)

# create and save plot ----------------------------------------------------

ggplot(mapping = aes(x = gid, y = dakota)) +
  geom_point(data = all, aes(size = attempts/25), alpha = 0.1) +
  geom_hline(data = all, aes(yintercept = weighted.mean(dakota, attempts)), linetype = "dashed", color = "red", size = 1) +
  geom_smooth(
    data = all %>% filter(player_name %in% players), 
    mapping = aes(group = player_name, color = player_name), 
    size = 1.5, se = FALSE
  ) +
  geom_label(aes(x = "2006_01", y = 0.09, label = "League Average"), color = "red", hjust = 0, vjust = 1, size = 3) +
  scale_color_manual(
    values = cols_breaks$use_color, 
    breaks = cols_breaks$player_name, 
    name = ""
  ) +
  scale_size_identity() +
  scale_x_discrete(breaks = breaks, labels = 2006:2020) +
  scale_y_continuous(breaks = scales::breaks_pretty(n = 7)) +
  labs(
    title = "Weekly Dakota of Selected QBs",
    subtitle = "Predictive EPA + CPOE composite, dakota, for each player with minimum 5 pass attempts per game (dots)\nSmoothed for some selected QBs",
    x = "Beginning of Season",
    y = "Dakota (EPA+CPOE index)",
    caption = "Figure: @mrcaseb, Data: @nflfastR"
  ) +
  coord_cartesian(ylim = c(-0.2, 0.5)) +
  theme_minimal() +
  theme(
    plot.title = element_text(face = "bold"),
    plot.caption = element_text(face = "italic"),
    legend.position = "bottom"
  ) +
  NULL

ggsave("plots/weekly_dakota.png", dpi = 600, width = 30, height = 30*10/16, unit = "cm")