how to value upcoming projected fantasy football stats

weighted-scoring.R

x <- matrix(NA, 200, 20)
pmean <- c(20, 10, 8, 5, 8, 6)
psd <- c(5, 2, 2, 2, 2, 3)
for(i in seq(nrow(x))) {
    pos <- (i - 1) %% 6 + 1
    x[i,1] <- i
    x[i,2] <- pos
    x[i,3] <- ifelse(i <= 100, (i - 1) %/% 10 + 1, 0)
    x[i,4:20] <- sample(c(0, rnorm(16, pmean[pos], psd[pos])))
}
relPoints <- function(dat, week, weights = c(1, 1, 1, 1)) {
    dat2 <- dat[,seq(4,19)]
    # given week
    a <- dat2[,week]
    # next 4 weeks
    b <- rowSums(dat2[,seq(week, min(week + 3, 16))])
    # rest of season (week 16)
    c <- rowSums(dat2[,seq(week, 16)])
    # playoffs (14-16)
    d <- rowSums(dat2[,seq(max(week, 14), 16)])
    e <- data.frame(cbind(a, b, c, d))
    unsplit(lapply(split(e, dat[,2]), function(i) apply(i, 2, scale) %*% weights), dat[,2])
}
compare <- function(dat, week, team, position) {
    if(week < 9) {
        w <- c(1, 2, 1, 1)
    } else {
        w <- c(2, 1, 1, 3)
    }
    z <- relPoints(dat, week, w)
    ix <- which(dat[,2] == position & dat[,3] == team)
    a <- dat[ix,,drop=FALSE]
    b <- z[ix]
    ix <- which(dat[,2] == position & dat[,3] == 0)
    ix2 <- ix[order(z[ix], decreasing=TRUE)[1:3]]
    c <- dat[ix2,]
    d <- z[ix2]
    cbind(rbind(a,c), score = c(b,d))
}
# score all players in week 3
relPoints(x, 3)
# weight week 3 high
relPoints(x, 3, c(3,0.5,0.5,0.5))
# compare qb's in week 3 for team 3
compare(x, 3, 3, 1)
# week 10
compare(x, 10, 3, 1)