R/EloPackages.R

In bbwieland/NBAEloRatings: Elo rating generation for NBA teams.

#' Build an Elo model
#'
#'This function generates an NBA Elo model for the given time parameters.
#'
#' @param year The year for which the model should be built. Defaults to "back half" of years; for 2021-22, you would use year = 2022.
#' @param throughDate The date through which the Elo ratings should be calculated. Should use YYYY-mm-dd format.
#' @return An Elo model for the specified time parameters.
#' @export
elo.model.builder <- function(year,throughDate = Sys.Date()) {
  Sys.setenv("VROOM_CONNECTION_SIZE" = 131072*2)

  season22 <- nbastatR::game_logs(seasons = year, season_types = "Regular Season",result_types = "team",assign_to_environment = F)

  test <- season22 %>% dplyr::group_by(idGame) %>% dplyr::summarise(winner = slugTeamWinner,
                                                      loser = slugTeamLoser,
                                                      date = dateGame)

  test <- test %>% dplyr::filter(date <= throughDate)



  test2 <- test[order(test$idGame,decreasing=TRUE),]
  test2 <- test[!duplicated(test$idGame),]
  elo_results <- EloRating::elo.seq(winner = test2$winner,
                         loser = test2$loser,
                         Date = test2$date,
                         runcheck = F, k = 25)
  elo_results
}

#' Get team Elo ratings
#'
#'This function extracts Elo ratings for individual teams from an Elo model
#'
#' @param elo.model An Elo model, which should be generated via elo.model.builder
#' @return A dataframe of Elo ratings by team.
#' @export
elo.by.team <- function(elo.model) {
  elo_by_team <- data.frame(elo = EloRating::extract_elo(elo.model))
  elo_by_team <- elo_by_team %>% dplyr::mutate(Abbreviation = rownames(elo_by_team))
  rownames(elo_by_team) = NULL
  elo_by_team
}

#' Get information on each team
#'
#'This function generates generic info about each NBA team for a given year.
#'
#' @param year The year for which data should be collected.
#' @return A table with information on team records, divisions, conferences, etc.
#' @export
team.info.table <- function(year){

  site <- rvest::read_html("https://en.wikipedia.org/wiki/Wikipedia:WikiProject_National_Basketball_Association/National_Basketball_Association_team_abbreviations")
  Abbreviation <- site %>% rvest::html_nodes("tr+ tr td:nth-child(1)") %>% rvest::html_text()
  Team <- site %>% rvest::html_nodes("tr+ tr td+ td") %>% rvest::html_text()
  team_names <- data.frame(Abbreviation,Team) %>% dplyr::mutate(Abbreviation = gsub("\n","",Abbreviation),
                                                         Team = gsub("\n","",Team))

  standings <- nbastatR::standings(seasons = year) %>%
    dplyr::select(slugTeam,nameTeam,nameConference,nameDivison,pctWinTeam,recordOverall) %>%
    dplyr::rename(Abbreviation = slugTeam, Team = nameTeam, Record = recordOverall,
           Conference = nameConference, Division = nameDivison, WinPct = pctWinTeam)
  standings[13,1] = "LAC"
  standings[8,1] = "DEN"

  team_info <- dplyr::inner_join(team_names,standings,by = "Abbreviation") %>%
    dplyr::select(-Team.x) %>%
    dplyr::rename(Team = Team.y)

  team_info
}

#' Combine an Elo table and an information table
#'
#'This function combines the outputs of the elo.by.team and team.info.table functions into a single output.
#'
#' @param elo.table The Elo table generated by elo.by.team
#' @param info.table The team info table generated via team.info.table
#' @return A merged table.
#' @export
overall.table <- function(elo.table,info.table) {
  newtable <- dplyr::inner_join(elo.table,info.table)
  newtable
}

#' Build a visualizable Elo rating table
#'
#'This function stylizes an input table, turning it into a HTML table using gt.
#'
#' @param overall.table A table built using overall.table
#' @return A GT table of overall ranks.
#' @export
elo.table.generator <- function(overall.table){
  overall.table <- overall.table %>%
    dplyr::select(Abbreviation,Team,Conference,Division,WinPct,Record,elo)

  gt.table = gt::gt(overall.table) %>%
    gt::tab_header(title = gt::md("**NBA Elo Rating Model**"),
               subtitle = gt::md("*Data scraped using nbastatR*")) %>%
    gt::data_color(columns = c(WinPct,elo),colors = RColorBrewer::brewer.pal(5,"RdYlGn")) %>%
    gt::tab_source_note(source_note = paste0("Date generated: ",Sys.Date())) %>%
    espnscrapeR::gt_theme_538()

  return(list(OverallData = overall.table,OverallGT = gt.table))

}

#' Build a visualizable Elo rating table sorted by conference and division.
#'
#'This function stylizes an input table, turning it into a HTML table using gt.
#'
#' @param overall.table A table built using overall.table
#' @return A GT table of overall ranks.
#' @export
elo.standings.generator <- function(overall.table){
  overall.table <- overall.table %>%
    dplyr::select(Abbreviation,Team,Conference,Division,WinPct,Record,elo) %>%
    dplyr::group_by(Conference,Division)

  gt.table= gt::gt(overall.table) %>%
    gt::tab_header(title = gt::md("**NBA Elo Rating Model**"),
               subtitle = gt::md("*Data scraped using nbastatR*")) %>%
    gt::data_color(columns = c(WinPct,elo),colors = RColorBrewer::brewer.pal(5,"RdYlGn")) %>%
    gt::tab_source_note(source_note = paste0("Date generated: ",Sys.Date())) %>%
    espnscrapeR::gt_theme_538()

  return(list(DivisionData = overall.table,DivisionGT = gt.table))

}

#' Build a visualizable Elo rating table sorted by conference
#'
#'This function stylizes an input table, turning it into a HTML table using gt.
#'
#' @param overall.table A table built using overall.table
#' @return A GT table of overall ranks.
#' @export
elo.conference.generator <- function(overall.table){
  overall.table <- overall.table %>%
    dplyr::select(Abbreviation,Team,Conference,Division,WinPct,Record,elo) %>%
    dplyr::group_by(Conference)

  gt.table = gt::gt(overall.table) %>%
    gt::tab_header(title = gt::md("**NBA Elo Rating Model**"),
               subtitle = gt::md("*Data scraped using nbastatR*")) %>%
    gt::data_color(columns = c(WinPct,elo),colors = RColorBrewer::brewer.pal(5,"RdYlGn")) %>%
    gt::tab_source_note(source_note = paste0("Date generated: ",Sys.Date())) %>%
    espnscrapeR::gt_theme_538()

  return(list(ConferenceData = overall.table,ConferenceGT = gt.table))

}

#' Elo calculator
#'
#'This function computes the probability of Team 1 beating Team 2, given each team's Elo rating.
#'
#' @param elorating1 Elo rating of Team 1.
#' @param elorating2 Elo rating of Team 2.
#' @return The probability of Team 1 beating Team 2.
#' @export
elo.prediction <- function(elorating1,elorating2) {
  team1.odds <- 1/(10 ** (-(elorating1 - elorating2) / 400) + 1)
  team1.odds
}

#' Build an Elo model
#'
#'This function generates predictions using an Elo table for the slate of games on a given date.
#'
#' @param elo.table An Elo table generated using elo.table.generator
#' @param date The date through which the Elo ratings should be calculated. Should use YYYY-mm-dd format. Defaults to current date.
#' @return A list of predictions for the given date.
#' @export
current.day.prediction <- function(elo.table,date = Sys.Date()){
  Sys.setenv("VROOM_CONNECTION_SIZE" = 131072 * 2)

  home.teams <- nbastatR::current_schedule() %>%
    dplyr::select(dateGame,idGame,slugTeamHome) %>%
    dplyr::filter(dateGame == date) %>%
    dplyr::inner_join(elo.table,by = c("slugTeamHome" = "Abbreviation")) %>%
    dplyr::rename(HomeTeam = slugTeamHome, HomeElo = elo)

  away.teams <- nbastatR::current_schedule() %>%
    dplyr::select(dateGame,idGame,slugTeamAway) %>%
    dplyr::filter(dateGame == date) %>%
    dplyr::inner_join(elo.table,by = c("slugTeamAway" = "Abbreviation")) %>%
    dplyr::rename(AwayTeam = slugTeamAway, AwayElo = elo)

  day.games <- dplyr::inner_join(home.teams,away.teams,by = "idGame") %>%
    dplyr::mutate(HomeWP = round(elo.prediction(HomeElo,AwayElo),3),
           AwayWP = round(elo.prediction(AwayElo,HomeElo),3)) %>%
    dplyr::rename(dateGame = dateGame.x) %>% select(-dateGame.y) %>%
    dplyr::mutate(WinnerPick = ifelse(HomeWP >= .5,HomeTeam,AwayTeam)) %>%
    dplyr::mutate(HCAHomeElo = HomeElo + 50,
           HCAHomeWP = round(elo.prediction(HCAHomeElo,AwayElo),3),
           HCAAwayWP = round(elo.prediction(AwayElo,HCAHomeElo),3),
           HCAWinnerPick = ifelse(HCAHomeWP >= .5,HomeTeam,AwayTeam))

  winner.picks <- day.games %>%
    dplyr::mutate(Matchup = paste0(AwayTeam," @ ",HomeTeam)) %>%
    dplyr::select(idGame,Matchup,HCAWinnerPick)

  picks.gt.data <- day.games %>%
    dplyr::mutate(Matchup = paste0(HomeTeam," vs. ",AwayTeam)) %>%
    dplyr::select(Matchup,HomeElo,AwayElo,HCAHomeElo,HCAHomeWP,HCAAwayWP,HCAWinnerPick)

  picks.gt <- picks.gt.data %>% gt::gt() %>%
    gt::tab_header(title = gt::md("**NBA Daily Picks**"),
               subtitle = gt::md("*Win probabilities based on Elo rating model inputs*")) %>%
    gt::data_color(columns = c(HCAHomeWP,HCAAwayWP),colors = RColorBrewer::brewer.pal(5,"RdYlGn")) %>%
    gt::data_color(columns = c(HCAWinnerPick),colors = "lightgrey") %>%
    gt::tab_source_note(source_note = paste0("Date generated: ",Sys.Date())) %>%
    espnscrapeR::gt_theme_538() %>%
    gt::fmt_percent(columns = c(HCAHomeWP,HCAAwayWP),
                decimals = 1) %>%
    gt::cols_label(HomeElo = "Home Team Elo",
               AwayElo = "Away Team Elo",
               HCAHomeElo = "Home Team Elo Home-Court Adjusted",
               HCAHomeWP = "Home Win Probability",
               HCAAwayWP = "Away Win Probability",
               HCAWinnerPick = "Predicted Winner") %>%
    gt::cols_align(
      align = "center",
      columns = everything()
    )

  set <- list(fullpredictions = day.games,picks = winner.picks,picktable = picks.gt)
  set
}


#' Return all sorts of models
#'
#'This function generates an NBA Elo model, GT tables, etc. for the given time parameters.
#'
#' @param year The year for which the model should be built. Defaults to "back half" of years; for 2021-22, you would use year = 2022.
#' @param date The date through which the Elo ratings should be calculated. Should use YYYY-mm-dd format.
#' @return A list of tons of info for the given parameters.
#' @export
overall.function.wrapper = function(year,date = Sys.Date()){

  eloModel = elo.model.builder(year,throughDate = date)

  teamElos = elo.by.team(eloModel)

  teamInfo = team.info.table(year)

  teamElosAndInfo = overall.table(teamElos,teamInfo)

  divisionTable = elo.standings.generator(teamElosAndInfo)

  conferenceTable = elo.conference.generator(teamElosAndInfo)

  standingsTable = elo.table.generator(teamElosAndInfo)

  dailyPredictions = current.day.prediction(teamElos,date = date)

  return(list(TeamElo = teamElos,TeamInfo = teamInfo,TeamTable = teamElosAndInfo,
              OverallStandings = standingsTable,ConferenceStandings = conferenceTable,
              DivisionStandings = divisionTable,DailyPicks = dailyPredictions))
}