Skip to content

Instantly share code, notes, and snippets.

@elsherbini

elsherbini/tidy_nfl_salaries.R

Last active April 9, 2018 18:44
Show Gist options
  • Save elsherbini/3c8f85b9e9c28f0c5b1c78728201d313 to your computer and use it in GitHub Desktop.
Save elsherbini/3c8f85b9e9c28f0c5b1c78728201d313 to your computer and use it in GitHub Desktop.
Download ZIP
A submission for #tidytuesday week 2
Raw
tidy_nfl_salaries.R
library(tidyverse)
library(cowplot)
library(colorblindr)
library(ggbeeswarm)
library(ggrepel)
# human_usd from https://github.com/fdryan/R/blob/master/ggplot2_formatter.r copy and source that!
df <- read_csv("nfl_salaries.csv") # from week 2 @ https://github.com/rfordatascience/tidytuesday
abbreviations <- tribble(
~position, ~abrv,
"Defensive Lineman", "DE",
"Linebacker", "LB",
"Cornerback", "CB",
"Special Teamer", "ST",
"Safety", "S",
"Quarterback", "QB",
"Running Back", "RB",
"Wide Receiver", "WR",
"Tight End", "TE",
"Offensive Lineman", "OL"
)
manual_colors <- c("#984ea3","#e41a1c","#56B4E9", "#009E73", "#E69F00", "#0072B2", "#D55E00", "#CC79A7", "#F0E442", "#addd8e", "#fccde5", "#8dd3c7")
p1 <- df %>% gather("position", "Salary", -year, na.rm = TRUE) %>%
mutate(position=factor(position, c("Defensive Lineman", "Linebacker", "Cornerback", "Special Teamer", "Safety", "Quarterback", "Running Back", "Wide Receiver", "Tight End", "Offensive Lineman"))) %>%
group_by(year, position) %>%
top_n(40, Salary) %>%
mutate(q=ifelse(ntile(Salary,4)==2|ntile(Salary,4)==3, 1,-1)) %>%
ggplot(aes(x=year, y=Salary, group=year)) +
geom_quasirandom(alpha=0.5,size=1,aes(color=q), show.legend = FALSE) +
stat_summary(fun.y = "median", geom="point",shape="-", size=12, aes(group=year))+
facet_wrap(~position, nrow=2) +
scale_y_continuous("Salary", labels=human_usd) +
scale_x_continuous("Year") +
theme(strip.background = element_blank(), strip.text.x = element_text(face="bold"), axis.text.x = element_text(angle=30, hjust=1)) +
ggtitle("NFL Salaries by Position", "Top 40 players at each position. Middle quartiles in light blue, median marked as line")
p2 <- df %>% gather("position", "Salary", -year, na.rm = TRUE) %>%
mutate(position=factor(position, c("Defensive Lineman", "Linebacker", "Cornerback", "Special Teamer", "Safety", "Quarterback", "Running Back", "Wide Receiver", "Tight End", "Offensive Lineman"))) %>%
filter(position != "Special Teamer") %>%
group_by(year, position) %>%
top_n(16, Salary) %>%
summarise(total_top_16=sum(Salary)) %>%
group_by(year) %>%
mutate(percent=100*total_top_16/sum(total_top_16)) %>%
mutate(o_or_d=factor(ifelse(position %in% c("Defensive Lineman", "Linebacker", "Cornerback","Safety"), "Defense", "Offense"), c("Offense", "Defense"))) %>%
ungroup() %>%
left_join(abbreviations) %>%
{ggplot(., aes(x=year, y=percent, color=position)) +
geom_point(aes(color=position), show.legend = FALSE)+
facet_wrap(~o_or_d) +
stat_smooth(aes(color=position, size=position=="Running Back"),se=FALSE, show.legend = FALSE) +
scale_color_manual(values=manual_colors)+
scale_size_discrete(range=c(0.7,1.6)) +
scale_y_continuous("Percent spent on each position") +
coord_cartesian(ylim=c(0, 25)) +
geom_label_repel(
data = subset(., year== 2016),
aes(label = abrv),
size = 4,
segment.color = NA, show.legend = FALSE) +
ggtitle("", "Percent of money spent on the top 16 players at each position") +
theme(strip.background = element_blank(), strip.text.x = element_text(face="bold"))}
ggsave("./nfl_salaries_plot.png", plot_grid(p1, p2, nrow=2), width=9, height=9)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment