Eskimo Boywl 2019 Report
Evan R. DeLancey
2019-08-27
Here we have the long awaited Eskimo Bowyl 2019 report. New in this years report: data on trades, waiver moves, weekly scoring records, and number of collusions per year! Also included in some plots are error bars which represent the high and low of a given stat (i.e., wins) over the five seasons of the Eskimo Bowyl.
- Note: the league was standard scoring from 2014-2016 and half PPR from 2017-2018 which may impact some stats.
- Note: Matt = Matt Reilander and Matthew = Matt Davis
Championships
#load libraries for entire document
library(ggplot2)
library(dplyr)
library(scales)
library(plotly)
library(RColorBrewer)
library(tidyr)
library(knitr)
#set base size for all figures
bs <- 16
#champ data
setwd("~/Desktop/YearlyFantasyReport/2019")
d <- read.csv("Champs.csv")
ordr <- c("Evan", "Justin", "Chris", "Taylor", "Andrew", "Matt", "Matthew", "Reid",
"Shawn", "Rachel", "Guy", "Curtis")
#champ plot
ggplot(d, aes(x=Player, y=champ, fill=Type)) + geom_bar(stat="identity") +
scale_x_discrete(limits = ordr) +
theme_minimal(base_size = bs, base_family = "Avenir") +
scale_fill_manual(values = c("#D4AF37", "#FF69B4")) +
ylab("Number of championships") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5))
Wins per seaons
#Manipulate NFL.com data
setwd("~/Desktop/YearlyFantasyReport/2019")
#Data
season <- read.csv("SeasonData.csv")
moves <- read.csv("Moves.csv")
#check number of players
players.season <- season %>% distinct(Player)
players.moves <- moves %>% distinct(Player)
#merge season and moves
dat <- merge(season, moves, by = c("Player", "year"))
dat$wins <- round(dat$winPer * 13, digits = 0)
plyrs <- dat %>% distinct(Player)
plyrs <- as.character(plyrs[,1])
dat$movesPLUStrades <- dat$moves + dat$trades
#Wins per year plot
dat.W <- aggregate(wins ~ Player, dat, FUN = 'mean')
dat.m <- aggregate(wins ~ Player, dat, FUN = 'min')
dat.ma <- aggregate(wins ~ Player, dat, FUN = 'max')
ggplot(dat.W, aes(x=reorder(Player, -wins), y=wins, fill = wins)) +
geom_bar(stat = "identity") +
xlab("Player") + ylab("Wins per season") +
scale_y_continuous(limits = c(0, 11), breaks = seq(0, 14, 2)) +
theme_minimal(base_size = bs, base_family = "Avenir") +
scale_fill_gradient(low = "#92c5de", high = "#053061") +
theme(legend.position = "none") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
geom_errorbar(aes(ymin = dat.m[,2], ymax = dat.ma[,2]), width = 0.2, size = 1)
Weekly scoring records
setwd("~/Desktop/YearlyFantasyReport/2019")
ws <- read.csv("WeeklyScores.csv")
ws[,3] <- gsub("[[:space:]]", "-", ws[,3])
ws[,3] <- gsub("---", "-", ws[,3])
ws <- separate(ws, Score, into = c("yourScore", "oppScore", "Result"), sep = "-")
ws$yourScore <- as.numeric(ws$yourScore)
ws$oppScore <- as.numeric(ws$oppScore)
ws$ptDiff <- abs(ws$yourScore - ws$oppScore)
ws.max <- ws %>% arrange(-yourScore) %>% head()
ws.min <- ws %>% arrange(yourScore) %>% head()
ws.diff <- arrange(ws, ptDiff)
ws.blow <- ws.diff[(length(ws.diff[,1]) - 10):length(ws.diff[,1]),]
ws.diff <- ws.diff[1:10,]
ws.blow <- ws.blow %>% arrange(-ptDiff)
#make tables - max score
ws.max <- ws.max[,-c(2, 4, 8)]
ws.max <- ws.max[,c(4, 5, 1, 3, 2)]
colnames(ws.max) <- c("Player", "Year", "Week", "Result", "Score")
kable(ws.max, caption = "Most points in one week")| Player | Year | Week | Result | Score |
|---|---|---|---|---|
| Shawn | 2017 | 12 | Win | 170.38 |
| Evan | 2017 | 12 | Loss | 169.16 |
| Evan | 2018 | 1 | Win | 168.96 |
| Evan | 2017 | 11 | Win | 168.14 |
| Evan | 2018 | 10 | Win | 159.04 |
| Matthew | 2018 | 6 | Win | 158.40 |
#make tables - min score
ws.min <- ws.min[,-c(2, 4, 8)]
ws.min <- ws.min[,c(4, 5, 1, 3, 2)]
colnames(ws.min) <- c("Player", "Year", "Week", "Result", "Score")
kable(ws.min, caption = "Least points in one week")| Player | Year | Week | Result | Score |
|---|---|---|---|---|
| Chris | 2016 | 8 | Loss | 43.50 |
| Taylor | 2015 | 5 | Loss | 45.06 |
| Andrew | 2014 | 3 | Loss | 46.84 |
| Andrew | 2016 | 14 | Loss | 47.10 |
| Guy | 2014 | 9 | Loss | 48.32 |
| Guy | 2016 | 12 | Loss | 49.84 |
#make tables - margin of victory
ws.diff <- ws.diff[c(1, 3, 5, 6, 8),]
ws.diff$Player1 <- c("Taylor", "Taylor", "Steve", "Taylor", "Taylor")
ws.diff$Result <- rep("Player2 win", 5)
ws.diff <- ws.diff[,-2]
ws.diff <- ws.diff[,c(8, 5, 6, 1, 3, 2, 7, 4)]
colnames(ws.diff) <- c("Player1", "Player2", "Year", "Week", "Player1 score",
"Player2 score", "Point diff", "Result")
kable(ws.diff, caption = "Closest matchups (ft. heartbreak for Taylor)")| Player1 | Player2 | Year | Week | Player1 score | Player2 score | Point diff | Result | |
|---|---|---|---|---|---|---|---|---|
| 1 | Taylor | Evan | 2017 | 4 | 116.56 | 116.68 | 0.12 | Player2 win |
| 3 | Taylor | Matt | 2016 | 1 | 76.10 | 76.46 | 0.36 | Player2 win |
| 5 | Steve | Curtis | 2014 | 6 | 87.84 | 88.34 | 0.50 | Player2 win |
| 6 | Taylor | Matt | 2016 | 12 | 100.16 | 100.92 | 0.76 | Player2 win |
| 8 | Taylor | Chris | 2016 | 13 | 87.54 | 88.32 | 0.78 | Player2 win |
#make tables - blow outs
ws.blow <- ws.blow[c(1, 4, 6, 8, 11),]
ws.blow$Player2 <- c("Shawn", "Andrew", "Matt", "Chris", "Matt")
ws.blow$Result <- rep("Player1 win", 5)
ws.blow <- ws.blow[,-2]
ws.blow <- ws.blow[,c(5, 8, 6, 1, 2, 3, 7, 4)]
colnames(ws.blow) <- c("Player1", "Player2", "Year", "Week", "Player1 score",
"Player2 score", "Point diff", "Result")
kable(ws.blow, caption = "Biggest blowouts (ft. Matt D blowing Shawn)")| Player1 | Player2 | Year | Week | Player1 score | Player2 score | Point diff | Result | |
|---|---|---|---|---|---|---|---|---|
| 1 | Matthew | Shawn | 2017 | 1 | 145.08 | 65.02 | 80.06 | Player1 win |
| 4 | Reid | Andrew | 2018 | 3 | 136.74 | 57.62 | 79.12 | Player1 win |
| 6 | Curtis | Matt | 2018 | 12 | 145.76 | 70.92 | 74.84 | Player1 win |
| 8 | Shawn | Chris | 2016 | 8 | 118.20 | 43.50 | 74.70 | Player1 win |
| 11 | Matthew | Matt | 2014 | 11 | 145.22 | 76.02 | 69.20 | Player1 win |
Points for per week
- distribution of weekly scores across all seasons, for each league member
rnk <- c("Evan", "Justin", "Matthew", "Shawn", "Rachel", "Chris", "Taylor", "Andrew",
"Matt", "Reid", "Curtis", "Guy")
ggplot(ws, aes(x=Player, y=yourScore)) + geom_violin(fill = "#bdbdbd") +
ylab("Weekly score") +
theme_minimal(base_size = bs, base_family = "Avenir") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
scale_x_discrete(limits = rnk)
Points for per season
#Points for per year plot
dat.W <- aggregate(ptsFor ~ Player, dat, FUN = 'mean')
dat.m <- aggregate(ptsFor ~ Player, dat, FUN = 'min')
dat.ma <- aggregate(ptsFor ~ Player, dat, FUN = 'max')
ggplot(dat.W, aes(x=reorder(Player, -ptsFor), y=ptsFor, fill = ptsFor)) +
geom_bar(stat = "identity") +
xlab("Player") + ylab("Points for per season") +
scale_y_continuous(limits = c(1000, 1600), breaks = seq(1000, 1600, 100), oob = rescale_none) +
theme_minimal(base_size = bs, base_family = "Avenir") +
scale_fill_gradient(low = "#92c5de", high = "#053061") +
theme(legend.position = "none") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
geom_errorbar(aes(ymin = dat.m[,2], ymax = dat.ma[,2]), width = 0.2, size = 1)
Points against per season
dat.W <- aggregate(ptsAgainst ~ Player, dat, FUN = 'mean')
dat.m <- aggregate(ptsAgainst ~ Player, dat, FUN = 'min')
dat.ma <- aggregate(ptsAgainst ~ Player, dat, FUN = 'max')
ggplot(dat.W, aes(x=reorder(Player, -ptsAgainst), y=ptsAgainst, fill = ptsAgainst)) +
geom_bar(stat = "identity") +
xlab("Player") + ylab("Points against per season") +
scale_y_continuous(limits = c(1000, 1650), breaks = seq(1000, 1700, 100), oob = rescale_none) +
theme_minimal(base_size = bs, base_family = "Avenir") +
scale_fill_gradient(low = "#92c5de", high = "#053061") +
theme(legend.position = "none") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
geom_errorbar(aes(ymin = dat.m[,2], ymax = dat.ma[,2]), width = 0.2, size = 1)
Waiver moves per seaon
- i.e., the people who play running back roulette
dat.W <- aggregate(moves ~ Player, dat, FUN = 'mean')
dat.m <- aggregate(moves ~ Player, dat, FUN = 'min')
dat.ma <- aggregate(moves ~ Player, dat, FUN = 'max')
ggplot(dat.W, aes(x=reorder(Player, -moves), y=moves, fill = moves)) +
geom_bar(stat = "identity") +
xlab("Player") + ylab("Waiver moves per season") +
theme(legend.position = "none") +
scale_y_continuous(limits = c(10, 75), breaks = seq(10, 70, 10), oob = rescale_none) +
theme_minimal(base_size = bs, base_family = "Avenir") +
scale_fill_gradient(low = "#92c5de", high = "#053061") +
theme(legend.position = "none") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
geom_errorbar(aes(ymin = dat.m[,2], ymax = dat.ma[,2]), width = 0.2, size = 1)
Trades per season
- does Justin trade?
dat.W <- aggregate(trades ~ Player, dat, FUN = 'mean')
dat.m <- aggregate(trades ~ Player, dat, FUN = 'min')
dat.ma <- aggregate(trades ~ Player, dat, FUN = 'max')
ggplot(dat.W, aes(x=reorder(Player, -trades), y=trades, fill = trades)) +
geom_bar(stat = "identity") +
xlab("Player") + ylab("Trades per season") +
scale_y_continuous(limits = c(0, 8), breaks = seq(0, 8, 2), oob = rescale_none) +
theme_minimal(base_size = bs, base_family = "Avenir") +
scale_fill_gradient(low = "#92c5de", high = "#053061") +
theme(legend.position = "none") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
geom_errorbar(aes(ymin = dat.m[,2], ymax = dat.ma[,2]), width = 0.2, size = 1)
Collusions per season (according to Justin)
dat.W[,2] <- c(0,0,0,10,0,0,0,0,0,0,0,0)
ggplot(dat.W, aes(x=reorder(Player, -trades), y=trades, fill = trades)) +
geom_bar(stat = "identity") +
xlab("Player") + ylab("Number of collusions") +
scale_y_continuous(limits = c(0, 10), breaks = seq(0, 10, 2), oob = rescale_none) +
theme_minimal(base_size = bs, base_family = "Avenir") +
scale_fill_gradient(low = "#92c5de", high = "#053061") +
theme(legend.position = "none") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5))
Correlation between roster moves and points for
lbls <- c("#e41a1c", "#469990", "#3cb44b", "#984ea3", "#ff7f00", "#ffff33", "#a65628", "#f781bf",
"#737373","#000000", "#08519c", "#808000")
ggplot(dat, aes(x = movesPLUStrades, y = ptsFor, colour = Player)) + geom_jitter(size = 3.3) +
xlab("All roster moves") + ylab("Points for") +
theme_minimal(base_size = bs, base_family = "Avenir") +
scale_color_manual(values = lbls) +
scale_y_continuous(limits = c(1000, 1600), breaks = seq(1000, 1600, 100)) +
scale_x_continuous(limits = c(0, 80), breaks = seq(0, 80, 10)) +
theme(panel.background = element_rect(fill = "#bdbdbd",
colour = "lightblue",
size = 0.5, linetype = "solid"),
panel.grid.major = element_line(size = 0.5, linetype = 'solid',
colour = "#d9d9d9"),
panel.grid.minor = element_line(size = 0)) +
geom_smooth(color="black", method="lm", se=FALSE, linetype="dashed", fullrange=TRUE)
That’s all! #deepthroatjustin #buttfuckevan