Casey’s Fantasy Grades

Hey guys, so since I’m a nerd and do biology statistical analytics for a living, I wrote a quick bit of code to give us a visual view of how our draft went. I agreed with Casey so I thought it would be fun to mark this down and be able to look back at it and see how much a draft really affects our season. Hopefully at the end of the season, I can do another write up to see how much the draft affects outcome in this league.

Data

Grades

Ignore the code but I converted Casey’s grades to a table for each player in the league.

setwd("~/Documents/")
library(ggplot2)
library(knitr)
## Read in shit
grades <- read.table("Fant.csv", header = TRUE, sep = ",", stringsAsFactors = FALSE)
kable(grades, align = "c")

Players	QB	RB.Core	WR.core	TE	Starters	Bench
Ryan	A-	B	A	C+	B+	C
Ari	A	A-	C	A	B+	C
Tommy	A+	B	A	B+	A	C
Sam	A	C	A	A-	A-	B-
Casey	B	A-	B+	B-	B	A
Turtle	A+	C	A-	B-	B	C
Alex	B	A	A	B	A	B+
Urbach	A	B+	A	A-	B+	B
Connor	A	A+	B	B	B+	C
Sean	B+	B-	A-	A+	B-	B+

GPA

The next thing I did was convert each draft grade to a GPA total, the same system U of O had (A+ = 4.3, A = 4.0, etc).

converttoGPA <- function(list) {
   list[which(list == "A+")] <- 4.3
   list[which(list == "A")] <- 4.0
   list[which(list == "A-")] <- 3.7
   list[which(list == "B+")] <- 3.3
   list[which(list == "B")] <- 3.0
   list[which(list == "B-")] <- 2.7
   list[which(list == "C+")] <- 2.3
   list[which(list == "C")] <- 2.0
   list[which(list == "C-")] <- 1.7
   return(as.numeric(list))
}

## Convert grades to GPA
gpa <- grades
for (i in 2:ncol(gpa)) {
  gpa[,i] <- converttoGPA(gpa[,i])
}
kable(gpa, align="c")

Players	QB	RB.Core	WR.core	TE	Starters	Bench
Ryan	3.7	3.0	4.0	2.3	3.3	2.0
Ari	4.0	3.7	2.0	4.0	3.3	2.0
Tommy	4.3	3.0	4.0	3.3	4.0	2.0
Sam	4.0	2.0	4.0	3.7	3.7	2.7
Casey	3.0	3.7	3.3	2.7	3.0	4.0
Turtle	4.3	2.0	3.7	2.7	3.0	2.0
Alex	3.0	4.0	4.0	3.0	4.0	3.3
Urbach	4.0	3.3	4.0	3.7	3.3	3.0
Connor	4.0	4.3	3.0	3.0	3.3	2.0
Sean	3.3	2.7	3.7	4.3	2.7	3.3

Make a bar plot of the outcome

A function that will plot all of the categories.

## Creat ggplot plot function
plotbar <- function(category, color, title ) {
  reorder_teams <- function(x) {
      factor(gpa$Players, levels = gpa$Players[order(x, decreasing = TRUE)])
    
  }
  ggplot(gpa, aes(x = reorder_teams(category), y= category)) + 
    geom_bar(stat = "identity", fill=color) +
    scale_y_continuous(breaks=rev(c(1.7, 2, 2.3, 2.7, 3, 3.3, 3.7, 4.0, 4.3)), 
                       labels=c("A+", "A", "A-", "B+", "B", "B-", "C+", "C", "C-")) +
    ggtitle(title) +
    ylab("Grade") +
    xlab("Jabroni")
}

Overall team power index

Lastly, this is the one that I will think will be most interesting. This is the average of all of the categories combinded, so (QB + RB + WR + TE + STARTERS + BENCH) / 6. I call it just the overall team power index. At the end of the season I’ll do a regression of each of our team’s placement vs the overall team power index to see how draft (or casey’s interpretation) affects overall outcome. Also, I’ll say it’s pretty cool all of our teams fall in the A-B range, we are all looking good.. May the best team win!

averageplot <- function(table) {
  rownames(table) <- table$Players
  table <- table[,-1]
  avg <- rowMeans(table)
  assign("Average", data.frame(OPI=avg), envir = .GlobalEnv)
  print(kable(data.frame(Team=names(avg), score=avg, row.names = 1:10)))
  avg <- data.frame(Player = names(avg), Average = as.numeric(avg))
  plotbar(avg$Average, color = "#CC79A7", title = "Overall Team Power Index")
}
averageplot(gpa)

## 
## 
## Team         score
## -------  ---------
## Ryan      3.050000
## Ari       3.166667
## Tommy     3.433333
## Sam       3.350000
## Casey     3.283333
## Turtle    2.950000
## Alex      3.550000
## Urbach    3.550000
## Connor    3.266667
## Sean      3.333333

Week 3 Update

Stats

Intresting to update how we are doing after three games. The team in first looks the best :)

library(ggplot2)
Games <- read.table("~/Documents/final_test.csv", sep=",", header=T)
Average$Players <- row.names(Average)
Complete <- merge(Average, Games, by.x = "Players",by.y = "TEAMOWNER")
rownames(Complete) <- sort(rownames(Average))
rownames(Complete) <- sort(rownames(Average))
PF <- lm(formula = Complete$OPI ~ Complete$PF)
scatter <- function(dataframe, x, y, title) {
  dat <- dataframe
  lin<- coef(lm(dat[[x]]~dat[[y]]))
  ggplot(dat, aes_string(y, x, label = "rownames(Complete)"), environment = .GlobalEnv) +
    geom_point() +
    stat_smooth(method = "lm", se = FALSE, col = "red") +
    geom_text(vjust = 0) +
    ggtitle(title)
}

winPCT <- function(df) {
  record <- read.table(text = as.character(df$DIV), sep="-", colClasses = "character")  
  colnames(record) <- c("Wins", "Losses", "Ties")
  record$PCT <- as.numeric(record$Wins)/(as.numeric(record$Losses) + as.numeric(record$Wins))
  record$PCT[which(record$PCT == Inf)] <- 1.00
  return(record$PCT)
}
Complete$WinPCT <- winPCT(Complete)

plotbar2 <- function(category, color, title ) {
  reorder_teams <- function(x) {
      factor(Complete$Players, levels = Complete$Players[order(x, decreasing = TRUE)])
    
  }
  ggplot(gpa, aes(x = reorder_teams(category), y= category)) + 
    geom_bar(stat = "identity", fill=color) +
    ggtitle(title) +
    ylab(title) +
    xlab("Jabroni")
}

plotbar2(Complete$WinPCT, color = "#009E73", title = "Win Percentage")

plotbar2(Complete$PF, color = "#E69F00", title = "Points For")

plotbar2(Complete$PA, color = "#0072B2", title = "Points Allowed")

Regressions

Intresting to see how the Overall Power Index (draft GPA) has affected the season. Moral of the story. Singer and Urbach are outliers! Also I think Singer is an Outlier cause he’s traded SO MANY PLAYERS already lol

scatter(Complete, x = "PF", y = "OPI", title = "PF vs OPI")

scatter(Complete, x = "WinPCT", y = "OPI", title = "Win% vs OPI")

scatter(Complete, x = "PF", y = "PA", title = "PF vs PA")

Week 4 Update

Stats

My team rules

library(ggplot2)

winPCT <- function(df) {
  record <- read.table(text = as.character(df$DIV), sep="-", colClasses = "character")  
  colnames(record) <- c("Wins", "Losses", "Ties")
  record$PCT <- as.numeric(record$Wins)/(as.numeric(record$Losses) + as.numeric(record$Wins))
  record$PCT[which(record$PCT == Inf)] <- 1.00
  return(record$PCT)
}

add_columns <- function(filepath) {
  Games <- read.table(filepath, sep=",", header=T)
  Complete <- merge(Average, Games, by.x = "Players",by.y = "TEAMOWNER")
  rownames(Complete) <- sort(rownames(Average))
  rownames(Complete) <- sort(rownames(Average))
  Complete$WinPCT <- winPCT(Complete)
  Complete$PlusMinus <- Complete$PF - Complete$PA
  return(Complete)
}
Complete <- add_columns("~/Documents/week4.csv")
plotbar2(Complete$WinPCT, color = "#009E73", title = "Win Percentage")

plotbar2(Complete$PF, color = "#E69F00", title = "Points For")

plotbar2(Complete$PA, color = "#0072B2", title = "Points Allowed")

Regressions

This is pretty crazy to me, it’s week 4 and we can already statistically say that there is no correlation between the draft grades and how your team is doing lol. All the OPI charts have non-significant linnear regresion p-values. For Points For vs OPI, pvalue = 0.725. For WinPCT vs OPI, pval = 0.7886.

scatter(Complete, x = "PF", y = "OPI", title = "PF vs OPI")

scatter(Complete, x = "WinPCT", y = "OPI", title = "Win% vs OPI")

scatter(Complete, x = "PF", y = "PA", title = "PF vs PA")

Week 5 Update

This picture kind of sums up my season so far.. Although I’m still getting lucky with my opponents this year.. 5-0 FEELS SO GOOD!!!

Stats

I added a new category of Plus Minus which is PF - PA

Complete <- add_columns("~/Documents/week5.csv")
plotbar2(Complete$WinPCT, color = "#009E73", title = "Win Percentage")

plotbar2(Complete$PF, color = "#E69F00", title = "Points For")

plotbar2(Complete$PA, color = "#0072B2", title = "Points Allowed")

plotbar2(Complete$PlusMinus, color = "#CC79A7", title = "Plus Minus")

Regressions

scatter(Complete, x = "PF", y = "OPI", title = "PF vs OPI")

scatter(Complete, x = "WinPCT", y = "OPI", title = "Win% vs OPI")

scatter(Complete, x = "PF", y = "PA", title = "PF vs PA")

week 6

Stats

Guys the Vikings are 5-0 and I’m 6-0. EVERYTHING IS GOING RIGHT, LIFE IS AWESOME. Reminds me of the good old days! Vikes

Anyway here are my two cents:

My team is really good.
Poor sean. Poor poor sean. I calculated average margin of vitory and Sean has been losing by 40.5 a week :(. Now that is just horrible luck. Season never over though so don’t give up hope. SORRY SEAN

More remarkably than Sean is how bad Ari is, He’s only had 683 points scored against him (to put it in perspective Sean has had 834 against him), and he’s still 1-5. FIGURE IT OUT ARI. Season never over though so don’t give up hope. SORRY ARI

My team is really good.
Singer is awful. No I’m just kidding, I just wanted to provoke a little, Singer has had turrible (charles barkley voice) luck. To put it in perspective how bad of luck he’s had, in the other Sigma Pi league we are in (Sacko Bowl), he’s 2nd in PF and 9th in the standings lolol. Singer it’ll all equal out man! SORRY SINGER

Complete <- add_columns("~/Documents/week6.csv")
plotbar2(Complete$WinPCT, color = "#009E73", title = "Win Percentage")

plotbar2(Complete$PF, color = "#E69F00", title = "Points For")

plotbar2(Complete$PA, color = "#0072B2", title = "Points Allowed")

plotbar2(Complete$PlusMinus, color = "#CC79A7", title = "Plus Minus")

Complete$AverageWin <- Complete$PlusMinus / 6
plotbar2(Complete$AverageWin, color = "#009E73", title = "Average Margin of Vitory")

Regressions

scatter(Complete, x = "PA", y = "WinPCT", title = "PA vs Win%")

scatter(Complete, x = "PF", y = "WinPCT", title = "Win% vs PF")

scatter(Complete, x = "PF", y = "PA", title = "PF vs PA")

week 7

Stats

I AM STILL UNDEFEATED. 7-0. IT FEELS SO GOOD! I wish I could say the vikings were undefeated :(((

Anways wow this has been a crazy year, the Raiders and Vikings are doing well, while the Ducks suck (WTF?!).

So, since Singer has been fairly loud about his unluckiness I looked into it last night. He is right.

For example, I’m 7-0 and Singer is 4-3, this is a box plot of our individual performances.Also, Tommy is kind of a control becuase he’s got a pretty large range of values.

library(tidyr)
Alex <-  c(121.5,130,135.5,122,153.5,133.5,113)
Singer <- c(177.5,132.5,121,147.5,113,137.5, 159.3)
Tommy <- c(141.5,102.5,125,186,104.5,75.5, 158)
scores <- data.frame(Alex, Singer, Tommy)
all.scores <- scores %>% gather(Jabroni, Score, Alex:Tommy)
ggplot(all.scores, aes(y=Score, x=Jabroni, fill=Jabroni)) + geom_boxplot() + geom_point(col="black", alpha = .8) +
  ggtitle("Weekly Score")

He literally is doing better than me in every category, but somehow I’m 7-0 and he’s 4-3. Sometimes all of the fantasy gods are watching over you and somtimes they tell you to GTFO. This is just the tip of the ice burg too, in the other sigma pi league (12 team), he’s 2nd in points yet 11th in the standings. Ask him, he’s pretty happy about (I’d crying jordan him but I’ve done it to him too much recently so I’ll spare him lol).

Here is a recap of the updated stats:

Complete <- add_columns("~/Documents/week7.csv")
plotbar2(Complete$WinPCT, color = "#009E73", title = "Win Percentage")

plotbar2(Complete$PF, color = "#E69F00", title = "Points For")

plotbar2(Complete$PA, color = "#0072B2", title = "Points Allowed")

plotbar2(Complete$PlusMinus, color = "#CC79A7", title = "Plus Minus")

Complete$AverageWin <- Complete$PlusMinus / 7
plotbar2(Complete$AverageWin, color = "#009E73", title = "Average Margin of Vitory")

Regressions

scatter(Complete, x = "PA", y = "WinPCT", title = "PA vs Win%")

scatter(Complete, x = "PF", y = "WinPCT", title = "Win% vs PF")

scatter(Complete, x = "PF", y = "PA", title = "PF vs PA")

LOL YOU KNOW I CAN’T RESIST CRYING JORDAN-ING SINGER!

week 8

Stats

2007 Patriots. 2016 Warriors. 2015 Kentucky. 2016 LaQuontum Physics (My team). What do all these teams have in common? Amazing regular seasons, no championship. I’M TERRIFIED. Anyways, here is the updated stats.

Complete <- add_columns("~/Documents/week8.csv")
plotbar2(Complete$WinPCT, color = "#009E73", title = "Win Percentage")

plotbar2(Complete$PF, color = "#E69F00", title = "Points For")

plotbar2(Complete$PA, color = "#0072B2", title = "Points Allowed")

plotbar2(Complete$PlusMinus, color = "#CC79A7", title = "Plus Minus")

Complete$AverageWin <- Complete$PlusMinus / 8
plotbar2(Complete$AverageWin, color = "#009E73", title = "Average Margin of Vitory")

Regressions

scatter(Complete, x = "PA", y = "WinPCT", title = "PA vs Win%")

scatter(Complete, x = "PF", y = "WinPCT", title = "Win% vs PF")

scatter(Complete, x = "PF", y = "PA", title = "PF vs PA")

A look back at 2015

Intresting to take a look at last year’s results. Remember that final playoff standings is much different than WinPCT, which is how the season went. Also crazy that last year’s standings doesn’t really have any correlation with this years success.

Complete2015 <- add_columns("2015.csv")
Ord <- c("Tommy", "Turtle", "Connor", "Ryan", "Alex", "Casey", "Ari", "Urbach", "Sean", "Sam")
rank.i <- match(Ord, Complete2015$Players)
Complete2015$Final.Standings[rank.i] <- seq(100, 10, by = -10)
plotbar2(Complete2015$Final.Standings, color = "#009E73", title = "Final Standings")

plotbar2(Complete2015$WinPCT, color = "#0072B2", title = "Win Percentage")

plotbar2(Complete2015$PF, color = "#E69F00", title = "Points For")

plotbar2(Complete2015$PA, color = "#0072B2", title = "Points Allowed")

plotbar2(Complete2015$PlusMinus, color = "#CC79A7", title = "Plus Minus")

scatter(Complete2015, x = "PF", y = "PA", title = "PF vs PA")

scatter(Complete2015, x="PF", y="WinPCT", title = "PF vs WinPCT")

Compared to this year WinPCT

Combine <- merge(Complete, Complete2015, by="Players")
colnames(Combine)[which(colnames(Combine) == "WinPCT.x")] <- "WinPCT2016"
colnames(Combine)[which(colnames(Combine) == "WinPCT.y")] <- "WinPCT2015"
scatter(Combine, x = "WinPCT2016", y = "WinPCT2015", title="2016 vs 2015")

Week 9

Complete <- add_columns("~/Documents/week10.csv")
plotbar2(Complete$WinPCT, color = "#009E73", title = "Win Percentage")

plotbar2(Complete$PF, color = "#E69F00", title = "Points For")

plotbar2(Complete$PA, color = "#0072B2", title = "Points Allowed")

plotbar2(Complete$PlusMinus, color = "#CC79A7", title = "Plus Minus")

Complete$AverageWin <- Complete$PlusMinus / 8
plotbar2(Complete$AverageWin, color = "#009E73", title = "Average Margin of Vitory")

Regressions

scatter(Complete, x = "PA", y = "WinPCT", title = "PA vs Win%")

scatter(Complete, x = "PF", y = "WinPCT", title = "Win% vs PF")

scatter(Complete, x = "PF", y = "PA", title = "PF vs PA")

Cheers and Go Ducks!

Chitz

The Premier Fantasy Football League

Alex Chitsazan

August 31, 2016

Casey’s Fantasy Grades

Data

Grades

GPA

Make a bar plot of the outcome

Overall team power index

Week 3 Update

Stats

Regressions

Week 4 Update

Stats

Regressions

Week 5 Update

Stats

Regressions

week 6

Stats

Regressions

week 7

Stats

Regressions

week 8

Stats

Regressions

A look back at 2015

Compared to this year WinPCT

Week 9

Regressions