R/calculate_standings.R

In nflfastR: Functions to Efficiently Access NFL Play by Play Data

#' Compute Division Standings and Conference Seeds from Play by Play
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' This function was deprecated and replaced by [nflseedR::nfl_standings()].
#'
#' This function calculates division standings as well as playoff
#'   seeds per conference based on either nflverse play-by-play data or nflverse
#'   schedule data.
#'
#' @param nflverse_object Data object of class `nflverse_data`. Either schedules
#'   as returned by [`fast_scraper_schedules()`] or [`nflreadr::load_schedules()`].
#'   Or play-by-play data as returned by [`load_pbp()`], [`build_nflfastR_pbp()`], or
#'  [`fast_scraper()`].
#' @param playoff_seeds Number of playoff teams per conference. If `NULL` (the
#'   default), the function will try to split `nflverse_object` into seasons prior
#'   2020 (6 seeds) and 2020ff (7 seeds). If set to a numeric, it will be used
#'   for all seasons in `nflverse_object`!
#' @inheritParams nflseedR::compute_conference_seeds
#'
#' @keywords internal
#' @return A tibble with NFL regular season standings
#' @export
#'
#' @examples
#' \donttest{
#' try({# to avoid CRAN test problems
#'   # load nflverse data both schedules and pbp
#'   # scheds <- fast_scraper_schedules(2014)
#'   # pbp <- load_pbp(c(2018, 2021))
#'
#'   # calculate standings based on pbp
#'   # calculate_standings(pbp)
#'
#'   # calculate standings based on schedules
#'   # calculate_standings(scheds)
#' })
#' }
calculate_standings <- function(
  nflverse_object,
  tiebreaker_depth = 3,
  playoff_seeds = NULL
) {
  lifecycle::deprecate_warn(
    "5.1.0",
    "calculate_standings()",
    "nflseedR::nfl_standings()"
  )

  if (!inherits(nflverse_object, "nflverse_data")) {
    cli::cli_abort(
      "The function argument {.arg nflverse_object} has to be
                   of class {.cls nflverse_data}"
    )
  }

  rlang::check_installed(
    "nflseedR",
    "to compute standings.",
    compare = ">=",
    version = "1.0.2"
  )

  type <- attr(nflverse_object, "nflverse_type")

  if (type == "play by play data") {
    .standings_from_pbp(
      nflverse_object,
      tiebreaker_depth = tiebreaker_depth,
      playoff_seeds = playoff_seeds
    )
  } else if (type == "games and schedules") {
    .standings_from_games(
      nflverse_object,
      tiebreaker_depth = tiebreaker_depth,
      playoff_seeds = playoff_seeds
    )
  } else {
    cli::cli_abort(
      "Can only handle nflverse_type {.val play by play data} or
                   {.val games and schedules} and not {.val {type}}"
    )
  }
}

.standings_from_pbp <- function(pbp, tiebreaker_depth, playoff_seeds) {
  g <- pbp |>
    dplyr::filter(.data$season_type == "REG") |>
    dplyr::group_by(.data$game_id) |>
    dplyr::summarise(
      sim = dplyr::first(.data$season),
      game_type = dplyr::first(.data$season_type),
      week = dplyr::first(.data$week),
      away_team = dplyr::first(.data$away_team),
      home_team = dplyr::first(.data$home_team),
      result = dplyr::last(.data$home_score) - dplyr::last(.data$away_score)
    ) |>
    dplyr::ungroup() |>
    dplyr::select(-"game_id")

  if (is.null(playoff_seeds)) {
    g6 <- g |>
      dplyr::filter(.data$sim %in% 1999:2019)
    g7 <- g |>
      dplyr::filter(.data$sim >= 2020)
    dplyr::bind_rows(
      .compute_standings(
        g6,
        tiebreaker_depth = tiebreaker_depth,
        playoff_seeds = 6
      ),
      .compute_standings(
        g7,
        tiebreaker_depth = tiebreaker_depth,
        playoff_seeds = 7
      )
    )
  } else {
    .compute_standings(
      g,
      tiebreaker_depth = tiebreaker_depth,
      playoff_seeds = playoff_seeds
    )
  }
}

.standings_from_games <- function(games, tiebreaker_depth, playoff_seeds) {
  g <- games |>
    dplyr::filter(.data$game_type == "REG", !is.na(.data$result)) |>
    dplyr::select(
      "sim" = "season",
      "game_type",
      "week",
      "away_team",
      "home_team",
      "result"
    )

  if (is.null(playoff_seeds)) {
    g6 <- g |>
      dplyr::filter(.data$sim %in% 1999:2019)
    g7 <- g |>
      dplyr::filter(.data$sim >= 2020)
    dplyr::bind_rows(
      .compute_standings(
        g6,
        tiebreaker_depth = tiebreaker_depth,
        playoff_seeds = 6
      ),
      .compute_standings(
        g7,
        tiebreaker_depth = tiebreaker_depth,
        playoff_seeds = 7
      )
    )
  } else {
    .compute_standings(
      g,
      tiebreaker_depth = tiebreaker_depth,
      playoff_seeds = playoff_seeds
    )
  }
}

.compute_standings <- function(games, tiebreaker_depth, playoff_seeds) {
  if (nrow(games) == 0) {
    return(data.frame())
  }
  suppressMessages({
    div <- nflseedR::compute_division_ranks(
      games,
      tiebreaker_depth = tiebreaker_depth
    )
    conf <- nflseedR::compute_conference_seeds(
      div,
      h2h = div$h2h,
      tiebreaker_depth = tiebreaker_depth,
      playoff_seeds = playoff_seeds
    )
  })
  conf$standings |>
    dplyr::select(-"exit", -"wins") |>
    dplyr::select("sim":"division", "div_rank", "seed", dplyr::everything()) |>
    dplyr::rename("season" = "sim", "wins" = "true_wins") |>
    dplyr::arrange(.data$season, .data$division, .data$div_rank, .data$seed) |>
    tibble::as_tibble()
}