Skip to content

Instantly share code, notes, and snippets.

@mrcaseb
Created March 2, 2021 16:03
Show Gist options
  • Save mrcaseb/c96b055f3c3f522b653d1518728ecd87 to your computer and use it in GitHub Desktop.
Save mrcaseb/c96b055f3c3f522b653d1518728ecd87 to your computer and use it in GitHub Desktop.
Code to create a plot of weekly dakota smoothed for selected QBs by @mrcaseb
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")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment