#' Calculate Projected Points
#'
#' Calculate projected fantasy points, confidence intervals, risk, tiers, etc.
#' @param scrapeData The scraped projections data from \link{runScrape}.
#' @param avgMethod A string specifying which average method to use for aggregating the
#' projections from different sources: mean ("average"), robust average ("robust"), or weighted average ("weighted"). Defaults to mean. Edit the analysts' weights for the weighted average in the \link{analysts} table.
#' @param leagueScoring List of scoring rules for the league see \link{scoringRules}
#' for an example.
#' @param vorBaseline The numbers (position rank values or point values) at each position to use for the baseline when
#' calculating VOR.
#' @param vorType Whether the baseline numbers are ranks or points. Defaults to position ranks.
#' @param d.thresholds Named vector containing Cohen's d thresholds for each position to create player tiers.
#' Higher d values result in fewer tiers, while lower d values result in more tiers. Suggested values lie
#' within the range 0.2 <= d <= 2. Defaults to tierDValues, whereby d = 1 for all positions.
#' @param teams Number of teams in the league (integer).
#' @param format League format ("standard" for standard leagues or "ppr" for Point-Per-Reception leagues).
#' @param mflMocks Whether to include mock drafts from MyFantasyLeague.com (MFL). Set to 1 to use only mock drafts,
#' 0 to use only real drafts. If not specified, all draft types will be used.
#' @param mflLeagues What type of leagues to include for MyFantasyLeague.com (MFL). Set to 0 to use
#' only redraft leagues; 1 to use only keeper leagues, 2 for rookie drafts, and
#' 3 for MFL Public Leagues. If not specified, all draft types will be used.
#' @param ADPsource Character vector with one or more of \code{c("CBS", "ESPN", "FFC", "MFL", "NFL")}.
#' @examples
#' getProjections(scrapeData, ## Based on data in scrapeData
#' avgMethod = "weighted", ## calculate the projections using a weighted average
#' leagueScoring = scoringRules, ## using defined scoringRules,
#' vorBaseline, vorType, ## VOR Baselines, VOR types,
#' d.thresholds = tierDValues, ## and Cohen's d threshold
#' teams = 12, format = "ppr", ## for a 12 team ppr league
#' mflMocks = 0, mflLeagues = 0, ## using only real MFL redraft league
#' adpSources = c("FFC", "MFL")) ## and ADP data from MFL and FFC
#' @export getProjections
getProjections <- function(scrapeData = NULL,
avgMethod = "average",
leagueScoring = scoringRules,
vorBaseline, vorType,
d.thresholds = tierDValues,
teams = 12, format = "standard", mflMocks = NULL,
mflLeagues = NULL,
adpSources = c("CBS", "ESPN", "FFC", "MFL", "NFL"),
getADP = TRUE, getECR = TRUE, writeFile = TRUE)
{
# Run data scrape if scrapeData is not passed.
if(is.null(scrapeData))
scrapeData <- runScrape()
getADP <- !is.null(adpSources) & getADP
scrapePositions <- intersect(position.name, names(scrapeData))
scrapePeriod <- scrapeData$period
week <- scrapePeriod["weekNo"]
season <- scrapePeriod["season"]
scrapeAnalysts <- scrapeData$analysts
cat("\n")
# Add on weights for analysts
analystWeights <- analysts[analystId %in% scrapeAnalysts, c("analystId", "weight"), with = FALSE]
data.table::setnames(analystWeights, "analystId", "analyst")
allProjections <- data.table::rbindlist(lapply(scrapeData[scrapePositions],
getMeltedData), fill = TRUE)
if(exists("analystId", allProjections))
data.table::setnames(allProjections, "analystId", "analyst")
allProjections <- merge(allProjections, analystWeights, by = "analyst")
# Redistributing WalterFootballData
if(any(allProjections$analyst == 20)){
cat("Redistributing WalterFootball Data \r")
wafoKicker <- redistributeValues(valueTable = allProjections[position == "K"],
calcType = avgMethod,
fromVar = "fg0039",
toVars = c("fg0019", "fg2029", "fg3039"),
excludeAnalyst = 20)
allProjections <- allProjections[!(analyst== 20 & dataCol %in% c("fg0019", "fg2029", "fg3039"))]
allProjections <- data.table::rbindlist(list(allProjections, wafoKicker[, names(allProjections), with = FALSE]))
allProjections <- allProjections[dataCol != "fg0039"]
wafoTDs <- redistributeValues(valueTable = allProjections[position %in% c("RB", "WR", "TE")],
calcType = avgMethod,
fromVar = "regTds", toVars = c("rushTds", "recTds"),
excludeAnalyst = 20)
allProjections <- allProjections[!(analyst == 20 & dataCol %in% c("rushTds", "recTds"))]
allProjections <- rbindlist(list(allProjections, wafoTDs[, names(allProjections), with = FALSE]))
allProjections[position == "QB" & dataCol == "regTds", dataCol := "rushTds"]
allProjections <- allProjections[dataCol != "regTds"]
}
# Redistributing Field goals to field goals by distance if these are missing
if(any(allProjections$position == "K")){
cat("Redistributing Field Goal Data \r")
kickerFG <- redistributeValues(valueTable = allProjections[position == "K"],
calcType = avgMethod,
fromVar = "fg",
toVars = c("fg0019", "fg2029", "fg3039", "fg4049", "fg50"),
excludeAnalyst = NULL)
allProjections <- merge(allProjections, kickerFG[, names(allProjections), with = FALSE],
by = c("playerId", "analyst", "position", "dataCol"),
suffixes = c("", "_new"), all.x = TRUE)
allProjections[is.na(value) & !is.na(value_new), value := value_new]
allProjections[, (names(allProjections)[grep("_new", names(allProjections))]) := NULL]
kickerFGMiss <- redistributeValues(valueTable = allProjections[position == "K"],
calcType = avgMethod,
fromVar = "fgMiss",
toVars = c("fgMiss0019", "fgMiss2029", "fgMiss3039", "fgMiss4049", "fgMiss50"),
excludeAnalyst = NULL)
allProjections <- merge(allProjections, kickerFGMiss[, names(allProjections), with = FALSE],
by = c("playerId", "analyst", "position", "dataCol"),
suffixes = c("", "_new"), all.x = TRUE)
allProjections[is.na(value) & !is.na(value_new), value := value_new]
allProjections[, (names(allProjections)[grep("_new", names(allProjections))]) := NULL]
}
# Replacing data that is missing for analysts
cat("Replacing Missing Data \r")
missData <- replaceMissingData(statData = allProjections, calcType = avgMethod)
allProjections <- merge(allProjections, missData,
by = c("playerId", "analyst", "position", "dataCol"),
all.x = TRUE)
allProjections[!is.finite(value) & is.finite(replValue), value := replValue]
allProjections[, replValue := NULL]
# Calculate Points, Confidence intervals, standard deviation, and position ranks
cat("Calculating Points \r")
projectedPoints <- projectPoints(allProjections, leagueScoring, avgType = avgMethod, d.thresholds)
avgProjections <- projectedPoints$avgStats
projectedPoints <- projectedPoints$pointsTable
# If seasonal data then we will calculate Value Over Replacement. We also
# get the ADP data for the season
if(week == 0){
cat("Calculate VOR \r")
projectedPoints[, vor := calculateVor(positionRank, points, unlist(.BY)),
by = "position"]
projectedPoints[, overallRank := rank(-vor, ties.method = "min")]
if(getADP){
cat("Adding ADP data \r")
draftValues <- getDraftData(adpSources, season, teams, format, mflMocks, mflLeagues)
draftValues[, playerId := as.numeric(playerId)]
projectedPoints <- merge(projectedPoints, draftValues[, c("playerId", "adp", "aav"),
with = FALSE],
by = "playerId", all.x = TRUE)
projectedPoints[, adpDiff := overallRank - adp]
}
}
# Adding player information
cat("Adding player information \r")
players <- playerData[, c("playerId", "player", "team", "draftYear", "birthdate"),
with = FALSE]
players[, playerId := as.numeric(playerId)]
projectedPoints <- merge(players, projectedPoints, by = "playerId")
projectedPoints[, exp := season - as.numeric(draftYear)]
projectedPoints[, c("draftYear") := NULL]
playerColumns <- c("playerId", "player", "team", "position", "birthdate")
dataColumns <- names(projectedPoints)[which(!(names(projectedPoints) %in% playerColumns))]
projectedPoints <- projectedPoints[, c(playerColumns, dataColumns), with = FALSE]
if(getECR){
# Retrieving expert ranking information
if(format == "ppr"){
rankFormat = "ppr"
} else {
rankFormat = "std"
}
cat("Retrieving ECR ranks for position \r")
rankTable <- data.table::rbindlist(lapply(scrapePositions, getRanks,
leagueType = rankFormat,
weekNo = week), fill = TRUE)
rankTable <- rankTable[, c("player", "position", "team", "avgRank", "sdRank"),
with = FALSE]
data.table::setnames(rankTable, "avgRank", "ecrPosition")
cat("Retrieving overall ECR ranks \r")
overallRanks <- getRanks("consensus", leagueType = rankFormat, weekNo = week)
overallRanks <- overallRanks[, c("player", "position", "team", "avgRank"),
with = FALSE]
data.table::setnames(overallRanks, "avgRank", "ecrRank")
if(nrow(rankTable) > 0 & nrow(overallRanks) > 0)
rankTable <- merge(rankTable, overallRanks, by = c("player", "position", "team"))
# Adding ranking info to table
projectedPoints <- merge(projectedPoints, rankTable,
by = c("player", "position", "team"), all.x = TRUE)
# Caluclate risk
cat("Calculating risk \r")
projectedPoints[, risk := calculateRisk(sdPts, sdRank), by = "position"]
}
if(exists("vor", projectedPoints))
projectedPoints <- projectedPoints[order(-vor)]
if(writeFile){
write.csv(projectedPoints, file = "projectedPoints.csv", row.names = FALSE,
na = "")
projectedPoints <- dataGadget(projectedPoints)
}
avgTbl <- lapply(split(avgProjections, avgProjections$position),
data.table::dcast,
as.formula("playerId + position ~ dataCol"))
avgData <- lapply(names(avgTbl),
function(p)ffanalytics::dataResult(resultData = avgTbl[[p]],
position = p))
names(avgData) <- names(avgTbl)
avgData$period <- scrapeData$period
return(list(scrape = scrapeData,
avgStats = avgData,
projections = projectedPoints))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.