R/get_weekly_matchups.R

Defines functions get_weekly_matchups

Documented in get_weekly_matchups

#' Gather All Weekly Matchup Data Available for League
#'
#' Given a league ID and the type of data (all, team, or player data),
#' grab the matchup data for each week that matchup data is available.
#'
#' @return If type is "all", will return a list containing data frames for
#'         both team and player data. Otherwise, will return team or player
#'         data depending on what is specified in the type argument. Note that
#'         with the player data, the aggregated player points could differ
#'         from the total team points due to the custom (manual) points that
#'         can be present.
#' @author Nick Bultman, \email{njbultman74@@gmail.com}, April 2024
#' @keywords matchups league
#' @importFrom dplyr left_join across mutate
#' @importFrom tidyr separate_longer_delim
#' @importFrom stringr str_replace_all
#' @export
#' @examples
#' \dontrun{get_weekly_matchups(688281863499907072)}
#' \dontrun{get_weekly_matchups(688281863499907072, type = "player")}
#'
#' @param league_id League ID generated by Sleeper (numeric or character)
#' @param type Type of data returned ("all", "team", "player") (string).
#'
get_weekly_matchups <- function(league_id, type = "all") {
  # Check to see if type argument is "all", "team" or "player"
  if (!(type == "all" || type == "team" || type == "player")) {
    stop('Type argument should be "all", "team", or "player."')
  }
  # Get matchup information for first week as a test
  test_matchup_df <- suppressMessages(get_matchups(league_id, 1))
  # If matchup information returns nothing, stop and inform user
  if (is.null(test_matchup_df)) {
    stop("No matchup data present for this league ID.")
  }
  # Get roster information
  roster_df <- get_rosters(league_id)
  # Get only relevant roster information
  roster_df_clean <- roster_df[, c("roster_id", "owner_id")]
  # Get league information
  league_df <- get_league_users(league_id)
  # Get only relevant league information
  league_df_clean <- league_df[, c("user_id", "display_name", "team_name")]
  # Get matchup information for first week as a test
  test_matchup_df <- suppressMessages(get_matchups(league_id, 1))
  # Create a while loop to continuously grab matchup information by week
  # Once null is returned, have full data set
  master_matchup_df <- data.frame()
  matchup_week <- 1
  while (!is.null(test_matchup_df)) {
    test_matchup_df <- test_matchup_df[, c("starters_points", "starters", "matchup_id", "custom_points", "roster_id", "players", "points")] # nolint
    test_matchup_df$week <- matchup_week
    master_matchup_df <- dplyr::bind_rows(master_matchup_df, test_matchup_df)
    matchup_week <- matchup_week + 1
    test_matchup_df <- suppressMessages(get_matchups(league_id, matchup_week))
  }
  # Remove NA matchup IDs (gets rid of weeks where no matchup)
  master_matchup_df <- master_matchup_df[!is.na(master_matchup_df$matchup_id),] # nolint
  # Join roster information to matchup information via roster ID for owner ID
  master_matchup_df_part <- dplyr::left_join(master_matchup_df, roster_df_clean, by = "roster_id") # nolint
  # Join league information via owner ID & user ID to get display/team names
  master_matchup_df_full <- dplyr::left_join(master_matchup_df_part, league_df_clean, by = c("owner_id" = "user_id")) # nolint
  # Join duplicate matchup df to get matchups by matchup ID
  master_matchup_df_join <- dplyr::left_join(master_matchup_df_full,
                                             master_matchup_df_full,
                                             by = c("matchup_id" = "matchup_id",
                                                    "week" = "week"),
                                             relationship = "many-to-many")
  # Filter out matchups against same roster ID
  master_matchup_df_join_filter <- master_matchup_df_join[which(master_matchup_df_join$roster_id.x != master_matchup_df_join$roster_id.y), ] # nolint
  # Filter out duplicate matchup records based on matchup ID and week
  master_matchup_df_join_filter_distinct <- master_matchup_df_join_filter[!duplicated(master_matchup_df_join_filter[, c("matchup_id", "week")]),] # nolint
  # Create total point columns (summation of points & custom points)
  master_matchup_df_join_filter_distinct$custom_points.x[is.na(master_matchup_df_join_filter_distinct$custom_points.x)] <- 0 # nolint
  master_matchup_df_join_filter_distinct$tot_points.x <- master_matchup_df_join_filter_distinct$points.x + master_matchup_df_join_filter_distinct$custom_points.x # nolint
  master_matchup_df_join_filter_distinct$custom_points.y[is.na(master_matchup_df_join_filter_distinct$custom_points.y)] <- 0 # nolint
  master_matchup_df_join_filter_distinct$tot_points.y <- master_matchup_df_join_filter_distinct$points.y + master_matchup_df_join_filter_distinct$custom_points.y # nolint
  # Get wins/losses
  master_matchup_df_join_filter_distinct$win_loss.x <- ifelse(master_matchup_df_join_filter_distinct$tot_points.x > master_matchup_df_join_filter_distinct$tot_points.y, # nolint
                                                              "W",
                                                              ifelse(master_matchup_df_join_filter_distinct$tot_points.x < master_matchup_df_join_filter_distinct$tot_points.y, # nolint
                                                                     "L",
                                                                     "T"))
  master_matchup_df_join_filter_distinct$win_loss.y <- ifelse(master_matchup_df_join_filter_distinct$tot_points.y > master_matchup_df_join_filter_distinct$tot_points.x, # nolint
                                                              "W",
                                                              ifelse(master_matchup_df_join_filter_distinct$tot_points.y < master_matchup_df_join_filter_distinct$tot_points.x, # nolint
                                                                     "L",
                                                                     "T"))
  # Reset index
  rownames(master_matchup_df_join_filter_distinct) <- 1:nrow(master_matchup_df_join_filter_distinct) # nolint
  # Split data into team information and team/player information
  team_df <- master_matchup_df_join_filter_distinct[, c("week", "matchup_id","roster_id.x", "roster_id.y", # nolint
                                                       "display_name.x", "display_name.y", "team_name.x",  # nolint
                                                       "team_name.y","points.x", "points.y", # nolint
                                                       "custom_points.x", "custom_points.y", "tot_points.x", # nolint
                                                       "tot_points.y", "win_loss.x", "win_loss.y")] # nolint
  player_df <- master_matchup_df_join_filter_distinct[, c("week", "matchup_id", "roster_id.x", "roster_id.y", # nolint
                                                          "display_name.x", "display_name.y", "team_name.x",  # nolint
                                                          "team_name.y", "custom_points.x", # nolint
                                                          "custom_points.y", "tot_points.x", "tot_points.y", # nolint
                                                          "starters.x", "starters.y", "starters_points.x", # nolint
                                                          "starters_points.y", "win_loss.x", "win_loss.y")] # nolint
  # Rename custom/total point columns to reflect they are team level
  player_df <- dplyr::rename(player_df,
                             "custom_team_points.x" = "custom_points.x",
                             "custom_team_points.y" = "custom_points.y",
                             "tot_team_points.x" = "tot_points.x",
                             "tot_team_points.y" = "tot_points.y",
                             "team_win_loss.x" = "win_loss.x",
                             "team_win_loss.y" = "win_loss.y")

  # Separate embedded lists into multiple records
  player_df_long <- suppressWarnings(tidyr::separate_longer_delim(player_df,
                                                                  c("starters.x", "starters.y", "starters_points.x", "starters_points.y"), # nolint
                                                                  delim = ","))
  # Clean transformed columns
  player_df_long <- dplyr::mutate(player_df_long,
                                  dplyr::across(c("starters.x",
                                                  "starters.y",
                                                  "starters_points.x",
                                                  "starters_points.y"),
                                                ~ stringr::str_replace_all(., "c\\(", ""))) # nolint
  player_df_long <- dplyr::mutate(player_df_long,
                                  dplyr::across(c("starters.x",
                                                  "starters.y",
                                                  "starters_points.x",
                                                  "starters_points.y"),
                                                ~ stringr::str_replace_all(., "\\)", ""))) # nolint
  player_df_long <- dplyr::mutate(player_df_long,
                                  dplyr::across(c("starters.x",
                                                  "starters.y",
                                                  "starters_points.x",
                                                  "starters_points.y"),
                                                ~ stringr::str_replace_all(., " ", ""))) # nolint
  player_df_long <- dplyr::mutate(player_df_long,
                                  dplyr::across(c("starters.x",
                                                  "starters.y",
                                                  "starters_points.x",
                                                  "starters_points.y"),
                                                ~ stringr::str_replace_all(., '"', ""))) # nolint
  # Parse transformed columns to appropriate data type
  player_df_long$starters_points.x <- as.numeric(player_df_long$starters_points.x) # nolint
  player_df_long$starters_points.y <- as.numeric(player_df_long$starters_points.y) # nolint
  # Check if player data exists in temporary directory
  if (file.exists(paste0(tempdir(), "/nfl_data.RDS"))) {
    # If data exists, load it
    player_info_df <- readRDS(paste0(tempdir(), "/nfl_data.RDS"))
    # If data does not exist, inform user and get data, save it
  } else {
    message("Player data does not exist. Loading now.")
    plot_generate_nfl_player_data()
    player_info_df <- readRDS(paste0(tempdir(), "/nfl_data.RDS"))
  }
  # Get relevant player info before joining
  player_info_df_slice <- player_info_df[, c("player_id", "full_name")]
  # Join player info to player matchup data
  player_df_long_full <- dplyr::left_join(player_df_long,
                                          player_info_df_slice,
                                          by = c("starters.x" = "player_id"))
  player_df_long_full <- dplyr::left_join(player_df_long_full,
                                          player_info_df_slice,
                                          by = c("starters.y" = "player_id"))
  # If player name is NA, grab the ID (normally DEF)
  player_df_long_full$full_name.x <- ifelse(is.na(player_df_long_full$full_name.x), # nolint
                                            player_df_long_full$starters.x,
                                            player_df_long_full$full_name.x)
  player_df_long_full$full_name.y <- ifelse(is.na(player_df_long_full$full_name.y), # nolint
                                            player_df_long_full$starters.y,
                                            player_df_long_full$full_name.y)
  # Given user selection, return appropriate data
  if (type == "all") {
    # If "all" then return a list with both data frames
    return(list(team_data = team_df,
                player_data = player_df_long_full))
  } else if (type == "team") {
    # If "team" return the team data frame
    return(team_df)
  } else if (type == "player") {
    # Otherwise, return the player data frame
    return(player_df_long_full)
  }
}
njbultman/sleepr documentation built on Nov. 20, 2024, 1:35 a.m.