From 7e6fe86f514c081edaa6b5ebd369f34950e5002f Mon Sep 17 00:00:00 2001 From: Mike Filicicchia <33882347+TheMathNinja@users.noreply.github.com> Date: Tue, 18 Aug 2026 11:08:44 -0400 Subject: [PATCH] Handle empty FanDuel projection responses --- R/source_scrapes.R | 3516 ++++++++++++++++++++++---------------------- 1 file changed, 1768 insertions(+), 1748 deletions(-) diff --git a/R/source_scrapes.R b/R/source_scrapes.R index cfb433b..c4ed0a3 100644 --- a/R/source_scrapes.R +++ b/R/source_scrapes.R @@ -1,1756 +1,1776 @@ - - -# CBS ---- -scrape_cbs = function(pos = c("QB", "RB", "WR", "TE", "K", "DST"), season = NULL, week = NULL, - draft = TRUE, weekly = TRUE) { - - if(is.null(season)) { - season = get_scrape_year() - } - if(is.null(week)) { - week = get_scrape_week() - } - - if(week %in% c(0, "ros")) { - scrape_week = "restofseason" - } else { - scrape_week = week - } - - curr_cache = list_ffanalytics_cache(quiet = TRUE) - is_cached = "CBS Scrape" %in% curr_cache$object - - if(is_cached) { - l_pos = get_cached_object("cbs_scrape.rds") - - pos_match = all(toupper(pos) %in% toupper(sort(names(l_pos)))) - - if(isTRUE(pos_match)) { - - scrape_message = paste0( - "\n", - "Using the CBS scrape that was cached ", - curr_cache$hr_min_since_cache[curr_cache$object == "CBS Scrape"], - " ago:" - ) - message(scrape_message) - return(l_pos[pos]) - - } else { - clear_ffanalytics_cache("CBS Scrape") - } - } - - - message("\nThe CBS scrape uses a 2 second delay between pages") - - base_link = paste0("https://www.cbssports.com/fantasy/football/") - site_session = rvest::session(base_link) - - l_pos = lapply_safe(pos, function(position) { - scrape_link = paste0("https://www.cbssports.com/fantasy/football/stats/", position, "/", - season, "/", scrape_week, "/projections/nonppr/") - - if(position != pos[1]) { - Sys.sleep(2L) - } - - cat(paste0("Scraping ", position, " projections from"), scrape_link, sep = "\n ") - - html_page = site_session %>% - session_jump_to(scrape_link) %>% - read_html() - - # Get column names - col_names = html_page %>% - html_element("#TableBase > div > div > table > thead > tr.TableBase-headTr") %>% - html_text2() %>% - strsplit("\\\n|\\\t") - - col_names = grep("[A-Z]", col_names[[1]], value = TRUE) - col_names = rename_vec(col_names, cbs_columns) - - # Get PID - if(position == "DST") { - cbs_id = html_page %>% - rvest::html_elements("span.TeamName a") %>% - rvest::html_attr("href") %>% - sub(".*?([A-Z]{2,3}).*", "\\1", .) - } else { - cbs_id = html_page %>% - rvest::html_elements("table > tbody > tr > td:nth-child(1) > span.CellPlayerName--long > span > a") %>% - rvest::html_attr("href") %>% - sub(".*?([0-9]+).*", "\\1", .) - } - - # Creating and cleaning table - out_df = html_page %>% - rvest::html_element("#TableBase > div > div > table > tbody") %>% - rvest::html_table() %>% - `names<-`(col_names) - - if(position != "DST") { - out_df = out_df %>% - tidyr::extract(player, c("player", "pos", "team"), - ".*?\\s{2,}[A-Z]{1,3}\\s{2,}[A-Z]{2,3}\\s{2,}(.*?)\\s{2,}(.*?)\\s{2,}(.*)") %>% - dplyr::mutate(src_id = cbs_id, - data_src = "CBS", - id = player_ids$id[match(src_id, player_ids$cbs_id)]) - out_df$id = get_mfl_id( - id_col = cbs_id, - player_name = out_df$player, - pos = out_df$pos, - team = out_df$team - ) - } else { - out_df$team = cbs_id - out_df$data_src = "CBS" - out_df$id = get_mfl_id(pos = "DST", team = rename_vec(cbs_id, unlist(team_corrections))) - out_df$pos = position - out_df$src_id = player_ids$cbs_id[match(out_df$id, player_ids$id)] - } - - # Misc cleanup before done - out_df[out_df == "—"] = NA - - idx = names(out_df) %in% c("id", "src_id") - out_df[!idx] = type.convert(out_df[!idx], as.is = TRUE) - out_df[out_df$site_pts > 0,] - }) - names(l_pos) = pos - attr(l_pos, "season") = season - attr(l_pos, "week") = week - - cache_object(l_pos, "cbs_scrape.rds") - l_pos -} - -# NFL ---- -scrape_nfl = function(pos = c("QB", "RB", "WR", "TE", "K", "DST"), season = NULL, week = NULL, - draft = TRUE, weekly = TRUE) { - - if(is.null(season)) { - season = get_scrape_year() - } - if(is.null(week)) { - week = get_scrape_week() - } - - curr_cache = list_ffanalytics_cache(quiet = TRUE) - is_cached = "NFL Scrape" %in% curr_cache$object - - if(is_cached) { - l_pos = get_cached_object("nfl_scrape.rds") - - pos_match = all(toupper(pos) %in% toupper(sort(names(l_pos)))) - - if(isTRUE(pos_match)) { - scrape_message = paste0( - "\n", - "Using the NFL scrape that was cached ", - curr_cache$hr_min_since_cache[curr_cache$object == "NFL Scrape"], - " ago:" - ) - message(scrape_message) - return(l_pos[pos]) - } else { - clear_ffanalytics_cache("NFL Scrape") - } - } - - message("\nThe NFL.com scrape uses a 2 second delay between pages") - - pos_scrape = nfl_pos_idx[pos] - - base_link = paste0("https://fantasy.nfl.com/research/projections?position=", pos_scrape[1], - "&sort=projectedPts&statCategory=projectedStats&statSeason=", season, - "&statType=seasonProjectedStats") - - site_session = session(base_link) - - l_pos = lapply_safe(pos, function(pos) { - pos_scrape = nfl_pos_idx[pos] - - n_records = case_when( - pos == "QB" ~ 42, - pos == "RB" ~ 100, - pos == "WR" ~ 150, - pos == "TE" ~ 60, - pos == "K" ~ 64, - pos == "DST" ~ 32 - ) - - if(week == 0) { - scrape_link = paste0("https://fantasy.nfl.com/research/projections?position=", pos_scrape, - "&count=", n_records, - "&sort=projectedPts&statCategory=projectedStats&statSeason=", season, - "&statType=seasonProjectedStats") - } else { - scrape_link = paste0("https://fantasy.nfl.com/research/projections?position=", pos_scrape[1], - "&count=", n_records, - "&sort=projectedPts&statCategory=projectedStats&statSeason=", season, - "&statType=weekProjectedStats&statWeek=", week) - } - - cat(paste0("Scraping ", pos, " projections from"), scrape_link, sep = "\n ") - - html_page = site_session %>% - session_jump_to(scrape_link) %>% - read_html() - - # Get PID - site_id = html_page %>% - html_elements("table td:first-child a.playerName") %>% - html_attr("href") %>% - sub(".*=", "", .) - - # Getting column names - col_names = html_page %>% - html_element("table > thead") %>% - html_table(header = FALSE) - - col_names = trimws(paste(col_names[1, ], col_names[2, ])) - col_names = nfl_columns[col_names] - - # Creating and cleaning table - out_df = html_page %>% - html_element("table > tbody") %>% - html_table(header = FALSE) %>% - `names<-`(col_names) - - # Breaking out first column / cleaning (for DST) - if(pos != "DST") { - out_df = out_df %>% - extract(player, c("player", "pos", "team"), - "(.*?)\\s+\\b(QB|RB|WR|TE|K)\\b.*?([A-Z]{2,3})") - } else { - out_df$team = sub("\\s+DEF$", "", out_df$team) - out_df$pos = "DST" - } - - if(pos %in% c("RB", "WR", "TE") && "pass_int" %in% names(out_df)) { - out_df$pass_int = NULL - } - - # Misc column cleanup before done - out_df$data_src = "NFL" - out_df$nfl_id = as.character(site_id) - out_df$opp = NULL - - # Type cleanup - out_df[out_df == "-"] = NA - idx = names(out_df) %in% c("id", "nfl_id") - out_df[!idx] = type.convert(out_df[!idx], as.is = TRUE) - - # Combining df's, removing NA's, filtering out rows with - out_df = out_df[out_df$site_pts > 0 & !is.na(out_df$site_pts), ] - # Adding IDs - out_df$id = get_mfl_id( - out_df$nfl_id, - player_name = if(pos == "DST") NULL else out_df$player, - pos = out_df$pos, - team = out_df$team - ) - out_df = out_df %>% - dplyr::select(id, src_id = nfl_id, any_of("player"), pos, team, dplyr::everything()) - - - Sys.sleep(2L) # temporary, until I get an argument for honoring the crawl delay - - # Removing all NA columns - Filter(function(x) any(!is.na(x)), out_df) - - }) - - names(l_pos) = pos - attr(l_pos, "season") = season - attr(l_pos, "week") = week - - cache_object(l_pos, "nfl_scrape.rds") - l_pos -} - -# Fantasysharks ---- -scrape_fantasysharks <- function(pos = c("QB", "RB", "WR", "TE", "K", "DST", "DL", "LB", "DB"), - season = NULL, week = NULL, draft = TRUE, weekly = TRUE) { - if(is.null(season)) { - season = get_scrape_year() - } - if(is.null(week)) { - week = get_scrape_week() - } - - curr_cache = list_ffanalytics_cache(quiet = TRUE) - is_cached = "FantasySharks Scrape" %in% curr_cache$object - - if(is_cached) { - l_pos = get_cached_object("fantasysharks_scrape.rds") - - pos_match = all(toupper(pos) %in% toupper(sort(names(l_pos)))) - - if(isTRUE(pos_match)) { - scrape_message = paste0( - "\n", - "Using the FantasySharks scrape that was cached ", - curr_cache$hr_min_since_cache[curr_cache$object == "FantasySharks Scrape"], - " ago:" - ) - message(scrape_message) - return(l_pos[pos]) - } else { - clear_ffanalytics_cache("FantasySharks Scrape") - } - } - - message("\nThe FantasySharks scrape uses a 2 second delay between pages") - - # historical scrapes (doesn't work) - year = dplyr::case_when( - season == 2025 ~ 842, - season == 2024 ~ 810, - season == 2023 ~ 778, - season == 2022 ~ 746, - season == 2021 ~ 714, - season == 2020 ~ 682, - season == 2019 ~ 650, - season == 2018 ~ 618, - season == 2017 ~ 586 - ) - - # segment for url from user week input - if (week == 0) { - segment <- year - } else if (week %in% c(1:22)) { - segment <- year + week + 8 - } else if (week %in% "ros") { - segment <- 813 - } - - l_pos <- lapply_safe(pos, function(pos){ - - position = dplyr::case_when( - pos %in% "QB" ~ 1, - pos %in% "RB" ~ 2, - pos %in% "WR" ~ 4, - pos %in% "TE" ~ 5, - pos %in% "K" ~ 7, - pos %in% "DST" ~ 6, - pos %in% "DL" ~ 8, - pos %in% "LB" ~ 9, - pos %in% "DB" ~ 10 - ) - scrape_link <- paste0("https://www.fantasysharks.com/apps/bert/forecasts/projections.php?csv=1&Sort=", - "&League=-1&Position=",position, "&scoring=1&Segment=", segment, "&uid=4") - - Sys.sleep(2L) # temporary, until I get an argument for honoring the crawl delay - cat(paste0("Scraping ", pos, " projections from"), scrape_link, sep = "\n ") - - pos_df = suppressMessages(readr::read_csv(scrape_link, progress = FALSE, name_repair = "minimal")) - pos_df$Rank = NULL - - # Rename columns with new names - names(pos_df) = rename_vec(names(pos_df), fantasysharks_columns) - names(pos_df)[duplicated(names(pos_df))] = c("rec_50_yds", "rec_100_yds") - - if(pos == "K") { - names(pos_df) = replace(names(pos_df), names(pos_df) == "pass_att", "fg_att") - } - if(pos == "DST") { - names(pos_df) = replace(names(pos_df), names(pos_df) == "pass_int", "dst_int") - pos_df$id = sprintf("%04d", as.numeric(pos_df$id)) - } - if(pos %in% c("DL", "LB", "DB")) { - names(pos_df) = gsub("^(dst|pass)_", "idp_", names(pos_df)) - } - - pos_df$id = as.character(pos_df$id) - pos_df$data_src = "FantasySharks" - pos_df[-1] = type.convert(pos_df[-1], as.is = TRUE) - pos_df = pos_df[pos_df$site_pts > 0, ] - dplyr::as_tibble(pos_df) - - }) - - - # list elements named by position - names(l_pos) = pos - attr(l_pos, "season") = season - attr(l_pos, "week") = week - - cache_object(l_pos, "fantasysharks_scrape.rds") - l_pos - -} - -# Numberfire ---- -scrape_numberfire <- function(pos = c("QB", "RB", "WR", "TE", "K", "DST", "LB", "DB", "DL"), - season = NULL, week = NULL, draft = TRUE, weekly = TRUE) { - - if(is.null(season)) { - season = get_scrape_year() - } - if(is.null(week)) { - week = get_scrape_week() - } - - curr_cache = list_ffanalytics_cache(quiet = TRUE) - is_cached = "NumberFire Scrape" %in% curr_cache$object - - if(is_cached) { - l_pos = get_cached_object("numberfire_scrape.rds") - - pos_match = all(toupper(pos) %in% toupper(sort(names(l_pos)))) - - if(isTRUE(pos_match)) { - scrape_message = paste0( - "\n", - "Using the NumberFire scrape that was cached ", - curr_cache$hr_min_since_cache[curr_cache$object == "NumberFire Scrape"], - " ago:" - ) - message(scrape_message) - return(l_pos[pos]) - } else { - clear_ffanalytics_cache("NumberFire Scrape") - } - } - - message("\nThe numberFire scrape uses a 2 second delay between pages") - - message("\nThe numberFire scrape uses a 2 second delay between pages") - - base_link <- paste0("https://www.numberfire.com/nfl/fantasy/fantasy-football-projections") - site_session <- rvest::session(base_link) - - # That IDP scrapes grabs everyone, this only hits website once grabs the positions later - if(any(pos %in% c("LB", "DB", "DL"))) { - site_pos <- c(setdiff(pos, c("LB", "DB", "DL")), "LB") - } else { - site_pos <- pos - } - - - l_pos <- lapply_safe(site_pos, function(pos){ - - position <- dplyr::case_when( - pos %in% "QB" ~ "qb", - pos %in% "RB" ~ "rb", - pos %in% "WR" ~ "wr", - pos %in% "TE" ~ "te", - pos %in% "K" ~ "k", - pos %in% "DST" ~ "d", - pos %in% "LB" ~ "idp" - ) - - scrape_link <- dplyr::case_when( - week %in% c(0, "ros") ~ paste0("https://www.numberfire.com/nfl/fantasy/remaining-projections/", position), - week > 0 ~ paste0("https://www.numberfire.com/nfl/fantasy/fantasy-football-projections/", position) - ) - - Sys.sleep(2L) # temporary, until I get an argument for honoring the crawl delay - cat(paste0("Scraping ", pos, " projections from"), scrape_link, sep = "\n ") - - - # grabbing position page - html_page <- site_session %>% - rvest::session_jump_to(scrape_link) %>% - rvest::read_html() - - - # numberFire unique player ID's - numfire_id <- html_page %>% - rvest::html_elements(css = "td[class='player'] a") %>% - rvest::html_attr("href") %>% - basename() - - # scrape contains list of player names and a list of data - scrape <- html_page %>% - rvest::html_elements(css = 'table.projection-table') %>% - rvest::html_table() - - - # player names - players = scrape[[1]] %>% - dplyr::rename(Player = 1) %>% - dplyr::slice(-1L) %>% - tidyr::extract(Player, into = c("Player", "position", "team"), - "(.*?)\\n.*\\n.*?([A-Z]{1,3}),\\s*([A-Z]{2,3})") - - - # Data - # rename columns by combining column names with first row of data (numberFire has double row names) - names(scrape[[2]]) <- paste(names(scrape[[2]]), scrape[[2]][1, ]) - - if(pos %in% "QB") { - - # remove first row that contains second half of column names - # replace the "-" in confidence interval with "," - # separate the confidence interval and pass c/a into two columns each - # remove "#"'s from rank columns - table <- scrape[[2]] %>% - slice(-1L) %>% - mutate(`numberFire CI` = sub("(\\d|\\.)\\-", "\\1,", `numberFire CI`)) %>% - separate(col = `numberFire CI`, into = c("Lower", "Upper"), sep = ",") %>% - separate(col = `Passing C/A`, into = c("pass_comp", "pass_att"), sep = "/") %>% - mutate(across(starts_with("Ranks"), ~ gsub("#", "", .x, fixed = TRUE))) - - } else if(pos %in% c("LB", "DB")) { - - table <- scrape[[2]] %>% - slice(-1L) - - } else { - - table <- scrape[[2]] %>% - slice(-1L) %>% - mutate(`numberFire CI` = gsub("(\\d|\\.)\\-", "\\1,", `numberFire CI`, perl = TRUE)) %>% - separate(col = `numberFire CI`, into = c("Lower", "Upper"), sep = ",") %>% - mutate(across(starts_with("Ranks"), ~gsub("#", "", .x, fixed = TRUE))) - } - - # combine numberFire ID's with player names and data - pos_df <- players %>% - dplyr::bind_cols(table) %>% - dplyr::mutate(id = get_mfl_id(numfire_id, player_name = Player, pos = position, team = team), - src_id = numfire_id, - data_src = "NumberFire") %>% - dplyr::select(id, src_id, everything()) - - # New column names - # subset by the columns in pos_df - # replicated names between DST and IDP positions - if (pos %in% c("DB", "LB", "DL")) { - names(pos_df) <- rename_vec(names(pos_df), numberfire_idp_columns) - } else { - names(pos_df) <- rename_vec(names(pos_df), numberfire_columns) - } - - - # Changing types before merging - pos_df[] = lapply(pos_df, function(x) gsub("N/A|\\$", "", x)) - - id_idx <- !names(pos_df) %in% "id" - pos_df[id_idx] <- type.convert(pos_df[id_idx], as.is = TRUE) - - if("site_pts" %in% names(pos_df)) { - pos_df[pos_df$site_pts > 0, ] - } else { - pos_df - } - - }) - - # Fixing idp scrapes (all come in with 'idp') - if(any(pos %in% c("LB", "DB", "DL"))) { - idp_idx <- match("LB", site_pos) - df_idp <- l_pos[[idp_idx]] - l_pos[[idp_idx]] <- NULL - l_idp <- split(df_idp, df_idp$pos) - l_idp <- l_idp[intersect(pos, names(l_idp))] - - names(l_pos) <- setdiff(pos, c("LB", "DB", "DL")) - l_pos <- c(l_pos, l_idp) - - } else { - # list elements named by position - names(l_pos) = pos - } - - attr(l_pos, "season") = season - attr(l_pos, "week") = week - - cache_object(l_pos, "numberfire_scrape.rds") - l_pos - -} - -# Walterfootball ---- -scrape_walterfootball <- function(pos = c("QB", "RB", "WR", "TE", "K"), - season = NULL, week = NULL, draft = TRUE, weekly = FALSE) { - - if(is.null(season)) { - season = get_scrape_year() - } - if(is.null(week)) { - week = get_scrape_week() - } - - curr_cache = list_ffanalytics_cache(quiet = TRUE) - is_cached = "WalterFootball Scrape" %in% curr_cache$object - - if(is_cached) { - l_pos = get_cached_object("walterfootball_scrape.rds") - - pos_match = all(toupper(pos) %in% toupper(sort(names(l_pos)))) - - if(isTRUE(pos_match)) { - scrape_message = paste0( - "\n", - "Using the WalterFootball scrape that was cached ", - curr_cache$hr_min_since_cache[curr_cache$object == "WalterFootball Scrape"], - " ago:" - ) - message(scrape_message) - return(l_pos[pos]) - } else { - clear_ffanalytics_cache("WalterFootball Scrape") - } - } - - # Currently unnamed argument for imputing REG TD columns, defaults to TRUE - url <- paste0("http://walterfootball.com/fantasy", season, "rankingsexcel.xlsx") - - xlsx_file <- tempfile("wf", fileext = ".xlsx") - xl_download <- download.file(url = url, destfile = xlsx_file, mode = "wb", quiet = TRUE) - - - l_pos <- lapply_safe(pos, function(pos){ - - cat(paste0("Scraping ", pos, " projections from"), url, sep = "\n ") - - position <- case_when(pos %in% "QB" ~ "QBs", - pos %in% "RB" ~ "RBs", - pos %in% "WR" ~ "WRs", - pos %in% "TE" ~ "TEs", - pos %in% "K" ~ "Ks") - - # Data - data <- if (pos %in% c("QB", "WR")) { - # Supress "New names:..." message - suppressMessages( - readxl::read_xlsx(xlsx_file, sheet = position) %>% - mutate(`First Name` = replace(`First Name`, `First Name` == "Marcua", "Marcus")) %>% - tidyr::unite(col = Player, `First Name`, `Last Name`, sep = " ", remove = FALSE) %>% - select_if(~ any(!is.na(.x))) %>% - select(matches("^Pass|^Rush|^Catch|^Rec|^Reg TD$|^Int|^FG|^XP|name$|^player|^Team$|^Pos|^Bye")) %>% - rename(last_name = `Last Name`, first_name = `First Name`, position = Pos) - ) - } else { - # Supress "New names:..." message - # "BYE" spelled differently for RB, TE, and K - suppressMessages( - read_xlsx(xlsx_file, sheet = position) %>% - unite(col = Player, `First Name`, `Last Name`, sep = " ", remove = FALSE) %>% - select_if(~ any(!is.na(.x))) %>% - select(matches("^Pass|^Rush|^Catch|^Rec|^Reg TD$|^Int|^FG|^XP|name$|^player|^Team$|^Pos|^Bye")) %>% - rename(Bye = BYE, last_name = `Last Name`, first_name = `First Name`, position = Pos) - ) - } - - # Combine data w/ player ID's - pos_df <- data %>% - mutate(id = get_mfl_id(id_col = "fantasypro_id", player_name = Player, pos = position), - data_src = "WalterFootball") %>% - select(id, everything(), -last_name, -first_name) - - # New column names - names(pos_df) = rename_vec(names(pos_df), walterfootball_columns) - df_names = names(pos_df) - - - if("reg_tds" %in% df_names) { - if(all(c("rush_yds", "rec_yds") %in% df_names)) { - total_yds = pos_df$rush_yds + pos_df$rec_yds - pos_df$rush_tds = ifelse(total_yds == 0, 0, - (pos_df$rush_yds / total_yds) * pos_df$reg_tds) - pos_df$rec_tds = ifelse(total_yds == 0, 0, - (pos_df$rec_yds / total_yds) * pos_df$reg_tds) - pos_df$reg_tds = NULL - } else if(any(c("rush_yds", "rec_yds") %in% df_names)) { - col_name = grep("(rush|rec)_yds", df_names, value = TRUE) - names(pos_df)[df_names == "reg_tds"] = sub("(rush|rec)_yds", "\\1_tds", col_name) - } - } - - pos_df - }) - - # list elements named by position - names(l_pos) = pos - attr(l_pos, "season") = season - attr(l_pos, "week") = week - - cache_object(l_pos, "walterfootball_scrape.rds") - l_pos - -} - -# FleaFlicker ---- -scrape_fleaflicker <- function(pos = c("QB", "RB", "WR", "TE", "K", "DST", "DL", "LB", "DB"), - season = NULL, week = NULL, draft = FALSE, weekly = TRUE) { - - if(is.null(season)) { - season = get_scrape_year() - } - if(is.null(week)) { - week = get_scrape_week() - } - - - curr_cache = list_ffanalytics_cache(quiet = TRUE) - is_cached = "FleaFlicker Scrape" %in% curr_cache$object - - if(is_cached) { - l_pos = get_cached_object("fleaflicker_scrape.rds") - pos_match = all(toupper(pos) %in% toupper(sort(names(l_pos)))) - if(isTRUE(pos_match)) { - scrape_message = paste0("\n", "Using the FleaFlicker scrape that was cached ", - curr_cache$hr_min_since_cache[curr_cache$object == "FleaFlicker Scrape"], - " ago:") - message(scrape_message) - return(l_pos[pos]) - } else { - clear_ffanalytics_cache("FleaFlicker Scrape") - } - } - # IDP positions - if("DL" %in% pos) { - pos <- c(pos, "DE", "DT") - pos <- pos[!pos %in% "DL"] - } - if ("DB" %in% pos) { - pos <- c(pos, "CB", "S") - pos <- pos[! pos %in% "DB"] - } - - - base_link <- paste0("https://www.fleaflicker.com/nfl/leaders") - site_session <- session(base_link) - - - l_pos <- lapply_safe(pos, function(pos){ - - position <- case_when(pos %in% "QB" ~ 4, - pos %in% "RB" ~ 1, - pos %in% "WR" ~ 2, - pos %in% "TE" ~ 8, - pos %in% "K" ~ 16, - pos %in% "DST" ~ 256, - pos %in% "DE" ~ 2048, - # 16384, - pos %in% "DT" ~ 64, - # 4096, - pos %in% "LB" ~ 128, - pos %in% "CB" ~ 512, - pos %in% "S" ~ 1024) - - - # Setting up hitting each page - offset = 0L - out_dfs = list() - - scrape_link <- paste0("https://www.fleaflicker.com/nfl/leaders?week=", week, "&statType=7&sortMode=7&position=", - position, "&tableOffset=", offset) - - cat(paste0("Scraping ", pos, " projections from"), scrape_link, sep = "\n ") - - - # The number of pages to scrape by position - pos_pages <- case_when(pos %in% c("K", "DST") ~ 2L, - pos %in% c("QB") ~ 2L, - pos %in% c("DT") ~ 4L, - pos %in% c("TE") ~ 5L, - pos %in% c("DE", "LB", "S") ~ 6L, - pos %in% c("RB") ~ 6L, - pos %in% c("CB") ~ 6L, - pos %in% c("WR") ~ 6L) - - - # Going through pages of fleaflicker.com until a player has projected fantasy points of 0 or less - # while(i == 0L || min(temp_df$site_pts > 1)) { - for (i in seq_len(pos_pages)) { - - page_link = paste0("https://www.fleaflicker.com/nfl/leaders?week=", week, "&statType=7&sortMode=7&position=", - position, "&tableOffset=", offset) - - - if(i != 1L) { - Sys.sleep(2L) - } - - # 20 rows of player data by position - html_page <- site_session %>% - session_jump_to(page_link) %>% - read_html() - - # FleaFlicker player ID's - fleaflicker_id <- html_page %>% - html_elements(css = "a.player-text") %>% - html_attr("href") %>% - sub(".*\\-(\\d+)$", "\\1", .) - - # scrape contains list of player names and a list of data - scrape <- html_page %>% - html_elements(css = '#body-center-main table') %>% - html_table() %>% - base::`[[`(1L) - - bottom_row_check = rapply(scrape, function(x) !grepl("Previous.*Next", x), how = "replace") - scrape = scrape[as.logical(rowMeans(bottom_row_check)), ] - - - # Column names - col_names <- paste(names(scrape), scrape[1, ]) - col_names <- gsub("Week\\s+\\d+|Projected", "", col_names) - col_names <- trimws(gsub("\\s+", " ", col_names)) - - if(pos == "K") { - col_names[c(10, 11, 13, 14)] = c("fg_att", "fg_pct", "xp_att", "xp_pct") - } - - - col_names = rename_vec(col_names, fleaflicker_columns) - col_names[is.na(col_names)] = paste0("...", seq_len(sum(is.na(col_names)))) - names(scrape) <- col_names - - # Filtering out empty columns - scrape = type.convert(scrape[2:(nrow(scrape)), ], - as.is = TRUE, na.strings = c("—", "NA", "")) - scrape = Filter(function(x) any(!is.na(x)), scrape) - - - # Creating and cleaning table - ## Suppress "New names:" message from .name_repair = "unique" - suppressMessages( - if (pos %in% "DST") { - temp_df <- scrape %>% - tidyr::extract(player, c("player", "team", "bye"), - "(.*)\\s+D/ST\\s+([A-Z]{2,3}).*?(\\d+).*") %>% - mutate(pos = "DST", - data_src = "FleaFlicker", - id = get_mfl_id(fleaflicker_id, pos = pos, player_name = team), - src_id = fleaflicker_id) %>% - select(player, pos, team, bye, everything()) - } else { - temp_df <- scrape %>% - as_tibble(.name_repair = "unique") %>% - # Remove "Q" at beginning of Player Name if followed by another uppercase letter - mutate(player = gsub("^Q(?=[A-Z])", "", player, perl = TRUE)) %>% - extract(player, into = c("first_name", "last_name", "pos_temp", "team", "bye"), - regex = "(.*?)\\s+(.*?)\\s+(.*?)\\s+(.*?)\\s+.*(\\d+)\\)$", convert = TRUE) %>% - tidyr::unite("player", first_name:last_name, sep = " ", remove = FALSE) %>% - mutate(data_src = "FleaFlicker") %>% - # rename for now so while loop works - mutate(src_id = fleaflicker_id, - id = get_mfl_id( - id_col = fleaflicker_id, - player_name = player, - first = first_name, - last = last_name, - pos = pos, - team = team - ), - pos_temp = pos) %>% - rename(pos = pos_temp) %>% - select(-first_name, -last_name) - } - ) - - # Adding it to a list of DF's from the pages - out_dfs[[i]] = temp_df - - if(min(temp_df$site_pts) <= 1 || nrow(temp_df) < 20) { - break - } - - # Add 1 to i for page number counter - # Add 20 to offset for next page's URL - offset = offset + 20L - - } - - - # combine df's from each page - out = bind_rows(out_dfs) - - # Converting types of columns - idx = names(out) %in% c("id", "src_id") - out[!idx] = type.convert(out[!idx], as.is = TRUE) - - out - - - }) - - - - # list elements named by position - names(l_pos) = pos - attr(l_pos, "season") = season - attr(l_pos, "week") = week - - ## Combine defensive dataframes - # combine DE and DT into DL - if (exists("DE", where = l_pos) && exists("DT", where = l_pos)) { - l_pos$DL <- bind_rows(l_pos$DE, l_pos$DT) %>% - mutate(pos = "DL") %>% - distinct(src_id, .keep_all = TRUE) - - l_pos$DE <- NULL - l_pos$DT <- NULL - } - - # combine CB and S into DB - if (exists("CB", where = l_pos) && exists("S", where = l_pos)) { - l_pos$DB <- bind_rows(l_pos$CB, l_pos$S) %>% - mutate(pos = "DB") %>% - distinct(src_id, .keep_all = TRUE) - - l_pos$CB <- NULL - l_pos$S <- NULL - } - - cache_object(l_pos, "fleaflicker_scrape.rds") - - - l_pos - -} - -# FFToday ---- -scrape_fftoday <- function(pos = c("QB", "RB", "WR", "TE", "K", "DST", "DL", "LB", "DB"), - season = NULL, week = NULL, draft = TRUE, weekly = TRUE) { - - message("\nThe FFToday scrape uses a 2 second delay between pages") - - # Error on this scrape fixed by this: - # i.e., https://github.com/jeroen/curl/issues/156 - # httr::set_config(httr::config(http_version = 2)) - new_http_v = structure( - list(method = NULL, url = NULL, headers = NULL, fields = NULL, - options = list(http_version = 2), auth_token = NULL, output = NULL), - class = "request") - old_httr_config = getOption("httr_config") - if(!is.null(old_httr_config)) { - configs = c(old_httr_config, new_http_v) - } else { - options(httr_config = new_http_v) - } - on.exit({ - options(httr_config = old_httr_config) - }) - - - if(is.null(season)) { - season = get_scrape_year() - } - if(is.null(week)) { - week = get_scrape_week() - } - - - base_link <- paste0("https://www.fftoday.com/rankings/index.html") - site_session <- rvest::session(base_link) - - if(week > 18) { - week = week + 2L - } - if(week > 0) { - pos = setdiff(pos, c("DST", "DL", "LB", "DB")) - } - - - l_pos <- lapply_safe(pos, function(pos){ - - position = dplyr::case_when( - pos == "QB" ~ 10, - pos == "RB" ~ 20, - pos == "WR" ~ 30, - pos == "TE" ~ 40, - pos == "DL" ~ 50, - pos == "LB" ~ 60, - pos == "DB" ~ 70, - pos == "K" ~ 80, - pos == "DST" ~ 99 - ) - - - # Setting up hitting each page - i = 1L - cur_page = 0L - out_dfs = list() - - if(week == 0) { - scrape_link = paste0("https://www.fftoday.com/rankings/playerproj.php?PosID=", position, - "&LeagueID=1") - } else { - scrape_link = paste0("https://www.fftoday.com/rankings/playerwkproj.php?Season=", season, - "&GameWeek=", week, "&PosID=", position, "&LeagueID=1") - } - - cat(paste0("Scraping ", pos, " projections from"), scrape_link, sep = "\n ") - - - # The number of pages to scrape by position - pos_pages <- dplyr::case_when( - pos %in% c("QB", "TE", "K", "DST") ~ 1L, - pos %in% c("RB") ~ 2L, - pos %in% c("WR", "DL", "DB", "LB") ~ 3L - ) - - # Going through n pages (depending on position) pages - while (i <= pos_pages) { - - Sys.sleep(2L) - - if(week == 0) { - page_link = paste0("https://www.fftoday.com/rankings/playerproj.php?Season=", - season, "&PosID=", position, "&LeagueID=1", - "&order_by=FFPts&sort_order=DESC&cur_page=", cur_page) - } else { - page_link = paste0("https://www.fftoday.com/rankings/playerwkproj.php?Season=", season, - "&GameWeek=", week, "&PosID=", position, "&LeagueID=1", - "&order_by=FFPts&sort_order=DESC&cur_page=", cur_page) - } - - - html_page <- site_session %>% - session_jump_to(page_link) %>% - read_html() - - # FFToday player ID's - if(pos == "DST") { - fftoday_id = html_page %>% - html_elements("a[href *='stats/players']") %>% - html_attr("href") %>% - sub(".*?=(\\d{4}).*", "\\1", .) %>% - grep("\\d{4}", ., value = TRUE) - } else { - fftoday_id = html_page %>% - html_elements("a[href *='stats/players/']") %>% - html_attr("href") %>% - dirname() %>% - basename() - } - - # scrape contains list of player names and a list of data - scrape <- html_page %>% - html_elements(css = "table table table") %>% - html_table() %>% - base::`[[`(1) %>% - dplyr::mutate(dplyr::across(dplyr::everything(), - ~ gsub(",", "", .x, fixed = TRUE))) - - # Column names - scrape[2, ] = as.list(sub("^(.*?)\\n.*", "\\1", scrape[2, ])) - col_names <- trimws(paste(scrape[1, ], scrape[2, ])) - col_names = rename_vec(col_names, fftoday_columns) - - if(pos %in% c("DL", "DB", "LB")) { - col_names = gsub("(dst|pass)_", "idp_", col_names) - } - - scrape[] = rapply(scrape, function(x) gsub("%", "", x, fixed = TRUE), how = "replace") - - - # Dataframe - temp_df = type.convert(scrape[-c(1:2), ], as.is = TRUE) - names(temp_df) = col_names - - - # Create / fix additional columns - temp_df$pos = pos - temp_df$data_src = "FFToday" - temp_df$src_id = fftoday_id - temp_df$chg = NULL - - if(week > 0) { - temp_df$opp = gsub("@", "", temp_df$opp, fixed = TRUE) - } - if(pos == "DST") { - temp_df$id = get_mfl_id(fftoday_id, pos = temp_df$pos) - } else { - temp_df$id = get_mfl_id(fftoday_id, player_name = temp_df$player, - team = temp_df$team, pos = temp_df$pos) - } - if("bye" %in% col_names) { - temp_df$bye = as.integer(gsub("-", "", temp_df$bye, fixed = TRUE)) - } - - # Adding it to a list of DF's from the pages - out_dfs[[i]] = temp_df - - - # Add 1 to i for page number counter - i = i + 1L - cur_page = cur_page + 1L - - } - - # combine df's from each page - dplyr::bind_rows(out_dfs[sapply(out_dfs, nrow) > 0]) # temp fix for zero row dfs - - - }) - - # list elements named by position - names(l_pos) = pos - attr(l_pos, "season") = season - attr(l_pos, "week") = week - l_pos - -} - -# Fantasypros ---- -scrape_fantasypros = function(pos = c("QB", "RB", "WR", "TE", "K", "DST"), - season = NULL, week = NULL, draft = TRUE, weekly = TRUE) { - message("\nThe FantasyPros scrape uses a 2 second delay between pages") - - if(is.null(season)) { - season = get_scrape_year() - } - if(is.null(week)) { - week = get_scrape_week() - } - - - - if(week > 0) { - scrape_week = paste0(".php?week=", week) - } else { - scrape_week = ".php?week=draft" - } - - base_link = paste0("https://www.fantasypros.com/nfl/projections") - site_session = rvest::session(base_link) - - l_pos = lapply_safe(pos, function(pos) { - scrape_link = paste0("https://www.fantasypros.com/nfl/projections/", - tolower(pos), scrape_week) - - Sys.sleep(2L) # temporary, until I get an argument for honoring the crawl delay - cat(paste0("Scraping ", pos, " projections from"), scrape_link, sep = "\n ") - - html_page = site_session %>% - rvest::session_jump_to(scrape_link) %>% - rvest::read_html() - - - # Getting column names - if(pos %in% c("K", "DST")) { - col_names = html_page %>% - rvest::html_element("table > thead") %>% - rvest::html_text2() %>% - strsplit("\\t") %>% - base::`[[`(1) - - col_names = rename_vec(col_names, fantasypros_columns) - - } else { - col_names = html_page %>% - rvest::html_element("table > thead") %>% - rvest::html_table() - - col_names = trimws(paste(col_names[1, ], col_names[2, ])) - col_names = rename_vec(col_names, fantasypros_columns) - } - #data > tbody > tr.mpb-player-19275.js-tr-game-select - # Get PID - fantasypro_num_id = html_page %>% - rvest::html_elements("table > tbody > tr") %>% - rvest::html_attr("class") %>% - sub(".*?(\\d{4,6}).*", "\\1", .) - fantasypro_num_id = fantasypro_num_id[!is.na(fantasypro_num_id)] - - # Creating and cleaning table - out_df = html_page %>% - rvest::html_element("table > tbody") %>% - rvest::html_table() %>% - mutate(across(everything(), ~gsub(",", "", .x, fixed = TRUE))) - - names(out_df) = col_names - - # Adding a few columns - if(pos == "DST") { - out_df$src_id = fantasypro_num_id - out_df$data_src = "FantasyPros" - out_df$pos = pos - out_df$id = get_mfl_id(fantasypro_num_id) - } else { - out_df = out_df %>% - extract(player, c("player", "team"), "(.*)\\s+([A-Z]{2,3})") %>% - mutate(src_id = fantasypro_num_id, - data_src = "FantasyPros", - pos = pos, - id = get_mfl_id(fantasypro_num_id, player_name = player, team = team, pos = pos)) - } - - # Misc cleanup before done - idx = names(out_df) %in% c("id", "src_id") - out_df[!idx] = type.convert(out_df[!idx], as.is = TRUE) - out_df[out_df$site_pts > 0,] - }) - names(l_pos) = pos - attr(l_pos, "season") = season - attr(l_pos, "week") = week - - cache_object(l_pos, "walterfootball_scrape.rds") - l_pos -} - -# RTSports ---- -scrape_rtsports = function(pos = c("QB", "RB", "WR", "TE", "K", "DST"), - season = NULL, week = 0, draft = TRUE, weekly = FALSE) { - - message("\nThe RTSports scrape uses a 5 second delay between pages") - - if(is.null(season)) { - season = get_scrape_year() - } - if(is.null(week)) { - week = get_scrape_week() - } - if(week > 0) { - stop("RTS Sports projections are only available for week 0") - } - - base_url = "https://www.freedraftguide.com/football/draft-guide-rankings-provider.php" - - l_pos = lapply_safe(pos, function(x) { - if(x != pos[1]) { - Sys.sleep(5) - } - req = httr2::request(base_url) %>% - httr2::req_url_query(POS = rts_pos_idx[x]) - - cat(paste0("Scraping ", x, " projections from"), req$url, sep = "\n ") - rts_json = httr2::req_perform(req) %>% - httr2::resp_body_json() - - p_info = rrapply::rrapply( - rts_json, - function(x, .xname, .xpos) { - .xname %in% c("player_id", "stats_id", "name", "nfl_team") & length(.xpos) == 3 - }, - how = "melt") %>% - tidyr::pivot_wider(names_from = L3, values_from = value) %>% - dplyr::select(player_id, stats_id, name, nfl_team) - - p_data = rrapply::rrapply( - rts_json, - function(x, .xparents) "stats" %in% .xparents, - how = "melt" - ) %>% - tidyr::pivot_wider(names_from = L4, values_from = value) %>% - dplyr::select(-c(L1:L3)) %>% - Filter(f = function(x) any(x[1] != x, na.rm = TRUE)) - - if(x %in% c("RB", "WR", "TE") && "pass_yds" %in% names(p_data)) { - if(!"pass_atts" %in% names(p_data)) { - p_data[["pass_atts"]] = 0L - } - } - - out_df = dplyr::bind_cols(p_info, p_data) - - names(out_df) <- rename_vec(names(out_df), rts_columns) - if(x != "DST") { - out_df = out_df[out_df$site_pts > 0, ] - } - - out_df = type.convert(out_df, as.is = TRUE) - out_df$pos = x - out_df$id = get_mfl_id(out_df$stats_id, - player_name = out_df$player, - team = out_df$team, - pos = out_df$pos) - out_df$src_id = as.character(out_df$src_id) - out_df$stats_id = NULL - out_df$data_src = "RTSports" - dplyr::select(out_df, id, src_id, pos, data_src, dplyr::everything()) - }) - - # list elements named by position - names(l_pos) = pos - attr(l_pos, "season") = season - attr(l_pos, "week") = week - l_pos -} - -# ESPN ---- -scrape_espn = function(pos = c("QB", "RB", "WR", "TE", "K", "DST", "DL", "LB", "DB"), season = NULL, week = NULL, - draft = TRUE, weekly = TRUE, espn_league_id = NULL) { - - message("\nThe ESPN scrape uses a 2 second delay between pages") - + + +# CBS ---- +scrape_cbs = function(pos = c("QB", "RB", "WR", "TE", "K", "DST"), season = NULL, week = NULL, + draft = TRUE, weekly = TRUE) { + + if(is.null(season)) { + season = get_scrape_year() + } + if(is.null(week)) { + week = get_scrape_week() + } + + if(week %in% c(0, "ros")) { + scrape_week = "restofseason" + } else { + scrape_week = week + } + + curr_cache = list_ffanalytics_cache(quiet = TRUE) + is_cached = "CBS Scrape" %in% curr_cache$object + + if(is_cached) { + l_pos = get_cached_object("cbs_scrape.rds") + + pos_match = all(toupper(pos) %in% toupper(sort(names(l_pos)))) + + if(isTRUE(pos_match)) { + + scrape_message = paste0( + "\n", + "Using the CBS scrape that was cached ", + curr_cache$hr_min_since_cache[curr_cache$object == "CBS Scrape"], + " ago:" + ) + message(scrape_message) + return(l_pos[pos]) + + } else { + clear_ffanalytics_cache("CBS Scrape") + } + } + + + message("\nThe CBS scrape uses a 2 second delay between pages") + + base_link = paste0("https://www.cbssports.com/fantasy/football/") + site_session = rvest::session(base_link) + + l_pos = lapply_safe(pos, function(position) { + scrape_link = paste0("https://www.cbssports.com/fantasy/football/stats/", position, "/", + season, "/", scrape_week, "/projections/nonppr/") + + if(position != pos[1]) { + Sys.sleep(2L) + } + + cat(paste0("Scraping ", position, " projections from"), scrape_link, sep = "\n ") + + html_page = site_session %>% + session_jump_to(scrape_link) %>% + read_html() + + # Get column names + col_names = html_page %>% + html_element("#TableBase > div > div > table > thead > tr.TableBase-headTr") %>% + html_text2() %>% + strsplit("\\\n|\\\t") + + col_names = grep("[A-Z]", col_names[[1]], value = TRUE) + col_names = rename_vec(col_names, cbs_columns) + + # Get PID + if(position == "DST") { + cbs_id = html_page %>% + rvest::html_elements("span.TeamName a") %>% + rvest::html_attr("href") %>% + sub(".*?([A-Z]{2,3}).*", "\\1", .) + } else { + cbs_id = html_page %>% + rvest::html_elements("table > tbody > tr > td:nth-child(1) > span.CellPlayerName--long > span > a") %>% + rvest::html_attr("href") %>% + sub(".*?([0-9]+).*", "\\1", .) + } + + # Creating and cleaning table + out_df = html_page %>% + rvest::html_element("#TableBase > div > div > table > tbody") %>% + rvest::html_table() %>% + `names<-`(col_names) + + if(position != "DST") { + out_df = out_df %>% + tidyr::extract(player, c("player", "pos", "team"), + ".*?\\s{2,}[A-Z]{1,3}\\s{2,}[A-Z]{2,3}\\s{2,}(.*?)\\s{2,}(.*?)\\s{2,}(.*)") %>% + dplyr::mutate(src_id = cbs_id, + data_src = "CBS", + id = player_ids$id[match(src_id, player_ids$cbs_id)]) + out_df$id = get_mfl_id( + id_col = cbs_id, + player_name = out_df$player, + pos = out_df$pos, + team = out_df$team + ) + } else { + out_df$team = cbs_id + out_df$data_src = "CBS" + out_df$id = get_mfl_id(pos = "DST", team = rename_vec(cbs_id, unlist(team_corrections))) + out_df$pos = position + out_df$src_id = player_ids$cbs_id[match(out_df$id, player_ids$id)] + } + + # Misc cleanup before done + out_df[out_df == "—"] = NA + + idx = names(out_df) %in% c("id", "src_id") + out_df[!idx] = type.convert(out_df[!idx], as.is = TRUE) + out_df[out_df$site_pts > 0,] + }) + names(l_pos) = pos + attr(l_pos, "season") = season + attr(l_pos, "week") = week + + cache_object(l_pos, "cbs_scrape.rds") + l_pos +} + +# NFL ---- +scrape_nfl = function(pos = c("QB", "RB", "WR", "TE", "K", "DST"), season = NULL, week = NULL, + draft = TRUE, weekly = TRUE) { + + if(is.null(season)) { + season = get_scrape_year() + } + if(is.null(week)) { + week = get_scrape_week() + } + + curr_cache = list_ffanalytics_cache(quiet = TRUE) + is_cached = "NFL Scrape" %in% curr_cache$object + + if(is_cached) { + l_pos = get_cached_object("nfl_scrape.rds") + + pos_match = all(toupper(pos) %in% toupper(sort(names(l_pos)))) + + if(isTRUE(pos_match)) { + scrape_message = paste0( + "\n", + "Using the NFL scrape that was cached ", + curr_cache$hr_min_since_cache[curr_cache$object == "NFL Scrape"], + " ago:" + ) + message(scrape_message) + return(l_pos[pos]) + } else { + clear_ffanalytics_cache("NFL Scrape") + } + } + + message("\nThe NFL.com scrape uses a 2 second delay between pages") + + pos_scrape = nfl_pos_idx[pos] + + base_link = paste0("https://fantasy.nfl.com/research/projections?position=", pos_scrape[1], + "&sort=projectedPts&statCategory=projectedStats&statSeason=", season, + "&statType=seasonProjectedStats") + + site_session = session(base_link) + + l_pos = lapply_safe(pos, function(pos) { + pos_scrape = nfl_pos_idx[pos] + + n_records = case_when( + pos == "QB" ~ 42, + pos == "RB" ~ 100, + pos == "WR" ~ 150, + pos == "TE" ~ 60, + pos == "K" ~ 64, + pos == "DST" ~ 32 + ) + + if(week == 0) { + scrape_link = paste0("https://fantasy.nfl.com/research/projections?position=", pos_scrape, + "&count=", n_records, + "&sort=projectedPts&statCategory=projectedStats&statSeason=", season, + "&statType=seasonProjectedStats") + } else { + scrape_link = paste0("https://fantasy.nfl.com/research/projections?position=", pos_scrape[1], + "&count=", n_records, + "&sort=projectedPts&statCategory=projectedStats&statSeason=", season, + "&statType=weekProjectedStats&statWeek=", week) + } + + cat(paste0("Scraping ", pos, " projections from"), scrape_link, sep = "\n ") + + html_page = site_session %>% + session_jump_to(scrape_link) %>% + read_html() + + # Get PID + site_id = html_page %>% + html_elements("table td:first-child a.playerName") %>% + html_attr("href") %>% + sub(".*=", "", .) + + # Getting column names + col_names = html_page %>% + html_element("table > thead") %>% + html_table(header = FALSE) + + col_names = trimws(paste(col_names[1, ], col_names[2, ])) + col_names = nfl_columns[col_names] + + # Creating and cleaning table + out_df = html_page %>% + html_element("table > tbody") %>% + html_table(header = FALSE) %>% + `names<-`(col_names) + + # Breaking out first column / cleaning (for DST) + if(pos != "DST") { + out_df = out_df %>% + extract(player, c("player", "pos", "team"), + "(.*?)\\s+\\b(QB|RB|WR|TE|K)\\b.*?([A-Z]{2,3})") + } else { + out_df$team = sub("\\s+DEF$", "", out_df$team) + out_df$pos = "DST" + } + + if(pos %in% c("RB", "WR", "TE") && "pass_int" %in% names(out_df)) { + out_df$pass_int = NULL + } + + # Misc column cleanup before done + out_df$data_src = "NFL" + out_df$nfl_id = as.character(site_id) + out_df$opp = NULL + + # Type cleanup + out_df[out_df == "-"] = NA + idx = names(out_df) %in% c("id", "nfl_id") + out_df[!idx] = type.convert(out_df[!idx], as.is = TRUE) + + # Combining df's, removing NA's, filtering out rows with + out_df = out_df[out_df$site_pts > 0 & !is.na(out_df$site_pts), ] + # Adding IDs + out_df$id = get_mfl_id( + out_df$nfl_id, + player_name = if(pos == "DST") NULL else out_df$player, + pos = out_df$pos, + team = out_df$team + ) + out_df = out_df %>% + dplyr::select(id, src_id = nfl_id, any_of("player"), pos, team, dplyr::everything()) + + + Sys.sleep(2L) # temporary, until I get an argument for honoring the crawl delay + + # Removing all NA columns + Filter(function(x) any(!is.na(x)), out_df) + + }) + + names(l_pos) = pos + attr(l_pos, "season") = season + attr(l_pos, "week") = week + + cache_object(l_pos, "nfl_scrape.rds") + l_pos +} + +# Fantasysharks ---- +scrape_fantasysharks <- function(pos = c("QB", "RB", "WR", "TE", "K", "DST", "DL", "LB", "DB"), + season = NULL, week = NULL, draft = TRUE, weekly = TRUE) { + if(is.null(season)) { + season = get_scrape_year() + } + if(is.null(week)) { + week = get_scrape_week() + } + + curr_cache = list_ffanalytics_cache(quiet = TRUE) + is_cached = "FantasySharks Scrape" %in% curr_cache$object + + if(is_cached) { + l_pos = get_cached_object("fantasysharks_scrape.rds") + + pos_match = all(toupper(pos) %in% toupper(sort(names(l_pos)))) + + if(isTRUE(pos_match)) { + scrape_message = paste0( + "\n", + "Using the FantasySharks scrape that was cached ", + curr_cache$hr_min_since_cache[curr_cache$object == "FantasySharks Scrape"], + " ago:" + ) + message(scrape_message) + return(l_pos[pos]) + } else { + clear_ffanalytics_cache("FantasySharks Scrape") + } + } + + message("\nThe FantasySharks scrape uses a 2 second delay between pages") + + # historical scrapes (doesn't work) + year = dplyr::case_when( + season == 2025 ~ 842, + season == 2024 ~ 810, + season == 2023 ~ 778, + season == 2022 ~ 746, + season == 2021 ~ 714, + season == 2020 ~ 682, + season == 2019 ~ 650, + season == 2018 ~ 618, + season == 2017 ~ 586 + ) + + # segment for url from user week input + if (week == 0) { + segment <- year + } else if (week %in% c(1:22)) { + segment <- year + week + 8 + } else if (week %in% "ros") { + segment <- 813 + } + + l_pos <- lapply_safe(pos, function(pos){ + + position = dplyr::case_when( + pos %in% "QB" ~ 1, + pos %in% "RB" ~ 2, + pos %in% "WR" ~ 4, + pos %in% "TE" ~ 5, + pos %in% "K" ~ 7, + pos %in% "DST" ~ 6, + pos %in% "DL" ~ 8, + pos %in% "LB" ~ 9, + pos %in% "DB" ~ 10 + ) + scrape_link <- paste0("https://www.fantasysharks.com/apps/bert/forecasts/projections.php?csv=1&Sort=", + "&League=-1&Position=",position, "&scoring=1&Segment=", segment, "&uid=4") + + Sys.sleep(2L) # temporary, until I get an argument for honoring the crawl delay + cat(paste0("Scraping ", pos, " projections from"), scrape_link, sep = "\n ") + + pos_df = suppressMessages(readr::read_csv(scrape_link, progress = FALSE, name_repair = "minimal")) + pos_df$Rank = NULL + + # Rename columns with new names + names(pos_df) = rename_vec(names(pos_df), fantasysharks_columns) + names(pos_df)[duplicated(names(pos_df))] = c("rec_50_yds", "rec_100_yds") + + if(pos == "K") { + names(pos_df) = replace(names(pos_df), names(pos_df) == "pass_att", "fg_att") + } + if(pos == "DST") { + names(pos_df) = replace(names(pos_df), names(pos_df) == "pass_int", "dst_int") + pos_df$id = sprintf("%04d", as.numeric(pos_df$id)) + } + if(pos %in% c("DL", "LB", "DB")) { + names(pos_df) = gsub("^(dst|pass)_", "idp_", names(pos_df)) + } + + pos_df$id = as.character(pos_df$id) + pos_df$data_src = "FantasySharks" + pos_df[-1] = type.convert(pos_df[-1], as.is = TRUE) + pos_df = pos_df[pos_df$site_pts > 0, ] + dplyr::as_tibble(pos_df) + + }) + + + # list elements named by position + names(l_pos) = pos + attr(l_pos, "season") = season + attr(l_pos, "week") = week + + cache_object(l_pos, "fantasysharks_scrape.rds") + l_pos + +} + +# Numberfire ---- +scrape_numberfire <- function(pos = c("QB", "RB", "WR", "TE", "K", "DST", "LB", "DB", "DL"), + season = NULL, week = NULL, draft = TRUE, weekly = TRUE) { + + if(is.null(season)) { + season = get_scrape_year() + } + if(is.null(week)) { + week = get_scrape_week() + } + + curr_cache = list_ffanalytics_cache(quiet = TRUE) + is_cached = "NumberFire Scrape" %in% curr_cache$object + + if(is_cached) { + l_pos = get_cached_object("numberfire_scrape.rds") + + pos_match = all(toupper(pos) %in% toupper(sort(names(l_pos)))) + + if(isTRUE(pos_match)) { + scrape_message = paste0( + "\n", + "Using the NumberFire scrape that was cached ", + curr_cache$hr_min_since_cache[curr_cache$object == "NumberFire Scrape"], + " ago:" + ) + message(scrape_message) + return(l_pos[pos]) + } else { + clear_ffanalytics_cache("NumberFire Scrape") + } + } + + message("\nThe numberFire scrape uses a 2 second delay between pages") + + message("\nThe numberFire scrape uses a 2 second delay between pages") + + base_link <- paste0("https://www.numberfire.com/nfl/fantasy/fantasy-football-projections") + site_session <- rvest::session(base_link) + + # That IDP scrapes grabs everyone, this only hits website once grabs the positions later + if(any(pos %in% c("LB", "DB", "DL"))) { + site_pos <- c(setdiff(pos, c("LB", "DB", "DL")), "LB") + } else { + site_pos <- pos + } + + + l_pos <- lapply_safe(site_pos, function(pos){ + + position <- dplyr::case_when( + pos %in% "QB" ~ "qb", + pos %in% "RB" ~ "rb", + pos %in% "WR" ~ "wr", + pos %in% "TE" ~ "te", + pos %in% "K" ~ "k", + pos %in% "DST" ~ "d", + pos %in% "LB" ~ "idp" + ) + + scrape_link <- dplyr::case_when( + week %in% c(0, "ros") ~ paste0("https://www.numberfire.com/nfl/fantasy/remaining-projections/", position), + week > 0 ~ paste0("https://www.numberfire.com/nfl/fantasy/fantasy-football-projections/", position) + ) + + Sys.sleep(2L) # temporary, until I get an argument for honoring the crawl delay + cat(paste0("Scraping ", pos, " projections from"), scrape_link, sep = "\n ") + + + # grabbing position page + html_page <- site_session %>% + rvest::session_jump_to(scrape_link) %>% + rvest::read_html() + + + # numberFire unique player ID's + numfire_id <- html_page %>% + rvest::html_elements(css = "td[class='player'] a") %>% + rvest::html_attr("href") %>% + basename() + + # scrape contains list of player names and a list of data + scrape <- html_page %>% + rvest::html_elements(css = 'table.projection-table') %>% + rvest::html_table() + + + # player names + players = scrape[[1]] %>% + dplyr::rename(Player = 1) %>% + dplyr::slice(-1L) %>% + tidyr::extract(Player, into = c("Player", "position", "team"), + "(.*?)\\n.*\\n.*?([A-Z]{1,3}),\\s*([A-Z]{2,3})") + + + # Data + # rename columns by combining column names with first row of data (numberFire has double row names) + names(scrape[[2]]) <- paste(names(scrape[[2]]), scrape[[2]][1, ]) + + if(pos %in% "QB") { + + # remove first row that contains second half of column names + # replace the "-" in confidence interval with "," + # separate the confidence interval and pass c/a into two columns each + # remove "#"'s from rank columns + table <- scrape[[2]] %>% + slice(-1L) %>% + mutate(`numberFire CI` = sub("(\\d|\\.)\\-", "\\1,", `numberFire CI`)) %>% + separate(col = `numberFire CI`, into = c("Lower", "Upper"), sep = ",") %>% + separate(col = `Passing C/A`, into = c("pass_comp", "pass_att"), sep = "/") %>% + mutate(across(starts_with("Ranks"), ~ gsub("#", "", .x, fixed = TRUE))) + + } else if(pos %in% c("LB", "DB")) { + + table <- scrape[[2]] %>% + slice(-1L) + + } else { + + table <- scrape[[2]] %>% + slice(-1L) %>% + mutate(`numberFire CI` = gsub("(\\d|\\.)\\-", "\\1,", `numberFire CI`, perl = TRUE)) %>% + separate(col = `numberFire CI`, into = c("Lower", "Upper"), sep = ",") %>% + mutate(across(starts_with("Ranks"), ~gsub("#", "", .x, fixed = TRUE))) + } + + # combine numberFire ID's with player names and data + pos_df <- players %>% + dplyr::bind_cols(table) %>% + dplyr::mutate(id = get_mfl_id(numfire_id, player_name = Player, pos = position, team = team), + src_id = numfire_id, + data_src = "NumberFire") %>% + dplyr::select(id, src_id, everything()) + + # New column names + # subset by the columns in pos_df + # replicated names between DST and IDP positions + if (pos %in% c("DB", "LB", "DL")) { + names(pos_df) <- rename_vec(names(pos_df), numberfire_idp_columns) + } else { + names(pos_df) <- rename_vec(names(pos_df), numberfire_columns) + } + + + # Changing types before merging + pos_df[] = lapply(pos_df, function(x) gsub("N/A|\\$", "", x)) + + id_idx <- !names(pos_df) %in% "id" + pos_df[id_idx] <- type.convert(pos_df[id_idx], as.is = TRUE) + + if("site_pts" %in% names(pos_df)) { + pos_df[pos_df$site_pts > 0, ] + } else { + pos_df + } + + }) + + # Fixing idp scrapes (all come in with 'idp') + if(any(pos %in% c("LB", "DB", "DL"))) { + idp_idx <- match("LB", site_pos) + df_idp <- l_pos[[idp_idx]] + l_pos[[idp_idx]] <- NULL + l_idp <- split(df_idp, df_idp$pos) + l_idp <- l_idp[intersect(pos, names(l_idp))] + + names(l_pos) <- setdiff(pos, c("LB", "DB", "DL")) + l_pos <- c(l_pos, l_idp) + + } else { + # list elements named by position + names(l_pos) = pos + } + + attr(l_pos, "season") = season + attr(l_pos, "week") = week + + cache_object(l_pos, "numberfire_scrape.rds") + l_pos + +} + +# Walterfootball ---- +scrape_walterfootball <- function(pos = c("QB", "RB", "WR", "TE", "K"), + season = NULL, week = NULL, draft = TRUE, weekly = FALSE) { + + if(is.null(season)) { + season = get_scrape_year() + } + if(is.null(week)) { + week = get_scrape_week() + } + + curr_cache = list_ffanalytics_cache(quiet = TRUE) + is_cached = "WalterFootball Scrape" %in% curr_cache$object + + if(is_cached) { + l_pos = get_cached_object("walterfootball_scrape.rds") + + pos_match = all(toupper(pos) %in% toupper(sort(names(l_pos)))) + + if(isTRUE(pos_match)) { + scrape_message = paste0( + "\n", + "Using the WalterFootball scrape that was cached ", + curr_cache$hr_min_since_cache[curr_cache$object == "WalterFootball Scrape"], + " ago:" + ) + message(scrape_message) + return(l_pos[pos]) + } else { + clear_ffanalytics_cache("WalterFootball Scrape") + } + } + + # Currently unnamed argument for imputing REG TD columns, defaults to TRUE + url <- paste0("http://walterfootball.com/fantasy", season, "rankingsexcel.xlsx") + + xlsx_file <- tempfile("wf", fileext = ".xlsx") + xl_download <- download.file(url = url, destfile = xlsx_file, mode = "wb", quiet = TRUE) + + + l_pos <- lapply_safe(pos, function(pos){ + + cat(paste0("Scraping ", pos, " projections from"), url, sep = "\n ") + + position <- case_when(pos %in% "QB" ~ "QBs", + pos %in% "RB" ~ "RBs", + pos %in% "WR" ~ "WRs", + pos %in% "TE" ~ "TEs", + pos %in% "K" ~ "Ks") + + # Data + data <- if (pos %in% c("QB", "WR")) { + # Supress "New names:..." message + suppressMessages( + readxl::read_xlsx(xlsx_file, sheet = position) %>% + mutate(`First Name` = replace(`First Name`, `First Name` == "Marcua", "Marcus")) %>% + tidyr::unite(col = Player, `First Name`, `Last Name`, sep = " ", remove = FALSE) %>% + select_if(~ any(!is.na(.x))) %>% + select(matches("^Pass|^Rush|^Catch|^Rec|^Reg TD$|^Int|^FG|^XP|name$|^player|^Team$|^Pos|^Bye")) %>% + rename(last_name = `Last Name`, first_name = `First Name`, position = Pos) + ) + } else { + # Supress "New names:..." message + # "BYE" spelled differently for RB, TE, and K + suppressMessages( + read_xlsx(xlsx_file, sheet = position) %>% + unite(col = Player, `First Name`, `Last Name`, sep = " ", remove = FALSE) %>% + select_if(~ any(!is.na(.x))) %>% + select(matches("^Pass|^Rush|^Catch|^Rec|^Reg TD$|^Int|^FG|^XP|name$|^player|^Team$|^Pos|^Bye")) %>% + rename(Bye = BYE, last_name = `Last Name`, first_name = `First Name`, position = Pos) + ) + } + + # Combine data w/ player ID's + pos_df <- data %>% + mutate(id = get_mfl_id(id_col = "fantasypro_id", player_name = Player, pos = position), + data_src = "WalterFootball") %>% + select(id, everything(), -last_name, -first_name) + + # New column names + names(pos_df) = rename_vec(names(pos_df), walterfootball_columns) + df_names = names(pos_df) + + + if("reg_tds" %in% df_names) { + if(all(c("rush_yds", "rec_yds") %in% df_names)) { + total_yds = pos_df$rush_yds + pos_df$rec_yds + pos_df$rush_tds = ifelse(total_yds == 0, 0, + (pos_df$rush_yds / total_yds) * pos_df$reg_tds) + pos_df$rec_tds = ifelse(total_yds == 0, 0, + (pos_df$rec_yds / total_yds) * pos_df$reg_tds) + pos_df$reg_tds = NULL + } else if(any(c("rush_yds", "rec_yds") %in% df_names)) { + col_name = grep("(rush|rec)_yds", df_names, value = TRUE) + names(pos_df)[df_names == "reg_tds"] = sub("(rush|rec)_yds", "\\1_tds", col_name) + } + } + + pos_df + }) + + # list elements named by position + names(l_pos) = pos + attr(l_pos, "season") = season + attr(l_pos, "week") = week + + cache_object(l_pos, "walterfootball_scrape.rds") + l_pos + +} + +# FleaFlicker ---- +scrape_fleaflicker <- function(pos = c("QB", "RB", "WR", "TE", "K", "DST", "DL", "LB", "DB"), + season = NULL, week = NULL, draft = FALSE, weekly = TRUE) { + + if(is.null(season)) { + season = get_scrape_year() + } + if(is.null(week)) { + week = get_scrape_week() + } + + + curr_cache = list_ffanalytics_cache(quiet = TRUE) + is_cached = "FleaFlicker Scrape" %in% curr_cache$object + + if(is_cached) { + l_pos = get_cached_object("fleaflicker_scrape.rds") + pos_match = all(toupper(pos) %in% toupper(sort(names(l_pos)))) + if(isTRUE(pos_match)) { + scrape_message = paste0("\n", "Using the FleaFlicker scrape that was cached ", + curr_cache$hr_min_since_cache[curr_cache$object == "FleaFlicker Scrape"], + " ago:") + message(scrape_message) + return(l_pos[pos]) + } else { + clear_ffanalytics_cache("FleaFlicker Scrape") + } + } + # IDP positions + if("DL" %in% pos) { + pos <- c(pos, "DE", "DT") + pos <- pos[!pos %in% "DL"] + } + if ("DB" %in% pos) { + pos <- c(pos, "CB", "S") + pos <- pos[! pos %in% "DB"] + } + + + base_link <- paste0("https://www.fleaflicker.com/nfl/leaders") + site_session <- session(base_link) + + + l_pos <- lapply_safe(pos, function(pos){ + + position <- case_when(pos %in% "QB" ~ 4, + pos %in% "RB" ~ 1, + pos %in% "WR" ~ 2, + pos %in% "TE" ~ 8, + pos %in% "K" ~ 16, + pos %in% "DST" ~ 256, + pos %in% "DE" ~ 2048, + # 16384, + pos %in% "DT" ~ 64, + # 4096, + pos %in% "LB" ~ 128, + pos %in% "CB" ~ 512, + pos %in% "S" ~ 1024) + + + # Setting up hitting each page + offset = 0L + out_dfs = list() + + scrape_link <- paste0("https://www.fleaflicker.com/nfl/leaders?week=", week, "&statType=7&sortMode=7&position=", + position, "&tableOffset=", offset) + + cat(paste0("Scraping ", pos, " projections from"), scrape_link, sep = "\n ") + + + # The number of pages to scrape by position + pos_pages <- case_when(pos %in% c("K", "DST") ~ 2L, + pos %in% c("QB") ~ 2L, + pos %in% c("DT") ~ 4L, + pos %in% c("TE") ~ 5L, + pos %in% c("DE", "LB", "S") ~ 6L, + pos %in% c("RB") ~ 6L, + pos %in% c("CB") ~ 6L, + pos %in% c("WR") ~ 6L) + + + # Going through pages of fleaflicker.com until a player has projected fantasy points of 0 or less + # while(i == 0L || min(temp_df$site_pts > 1)) { + for (i in seq_len(pos_pages)) { + + page_link = paste0("https://www.fleaflicker.com/nfl/leaders?week=", week, "&statType=7&sortMode=7&position=", + position, "&tableOffset=", offset) + + + if(i != 1L) { + Sys.sleep(2L) + } + + # 20 rows of player data by position + html_page <- site_session %>% + session_jump_to(page_link) %>% + read_html() + + # FleaFlicker player ID's + fleaflicker_id <- html_page %>% + html_elements(css = "a.player-text") %>% + html_attr("href") %>% + sub(".*\\-(\\d+)$", "\\1", .) + + # scrape contains list of player names and a list of data + scrape <- html_page %>% + html_elements(css = '#body-center-main table') %>% + html_table() %>% + base::`[[`(1L) + + bottom_row_check = rapply(scrape, function(x) !grepl("Previous.*Next", x), how = "replace") + scrape = scrape[as.logical(rowMeans(bottom_row_check)), ] + + + # Column names + col_names <- paste(names(scrape), scrape[1, ]) + col_names <- gsub("Week\\s+\\d+|Projected", "", col_names) + col_names <- trimws(gsub("\\s+", " ", col_names)) + + if(pos == "K") { + col_names[c(10, 11, 13, 14)] = c("fg_att", "fg_pct", "xp_att", "xp_pct") + } + + + col_names = rename_vec(col_names, fleaflicker_columns) + col_names[is.na(col_names)] = paste0("...", seq_len(sum(is.na(col_names)))) + names(scrape) <- col_names + + # Filtering out empty columns + scrape = type.convert(scrape[2:(nrow(scrape)), ], + as.is = TRUE, na.strings = c("—", "NA", "")) + scrape = Filter(function(x) any(!is.na(x)), scrape) + + + # Creating and cleaning table + ## Suppress "New names:" message from .name_repair = "unique" + suppressMessages( + if (pos %in% "DST") { + temp_df <- scrape %>% + tidyr::extract(player, c("player", "team", "bye"), + "(.*)\\s+D/ST\\s+([A-Z]{2,3}).*?(\\d+).*") %>% + mutate(pos = "DST", + data_src = "FleaFlicker", + id = get_mfl_id(fleaflicker_id, pos = pos, player_name = team), + src_id = fleaflicker_id) %>% + select(player, pos, team, bye, everything()) + } else { + temp_df <- scrape %>% + as_tibble(.name_repair = "unique") %>% + # Remove "Q" at beginning of Player Name if followed by another uppercase letter + mutate(player = gsub("^Q(?=[A-Z])", "", player, perl = TRUE)) %>% + extract(player, into = c("first_name", "last_name", "pos_temp", "team", "bye"), + regex = "(.*?)\\s+(.*?)\\s+(.*?)\\s+(.*?)\\s+.*(\\d+)\\)$", convert = TRUE) %>% + tidyr::unite("player", first_name:last_name, sep = " ", remove = FALSE) %>% + mutate(data_src = "FleaFlicker") %>% + # rename for now so while loop works + mutate(src_id = fleaflicker_id, + id = get_mfl_id( + id_col = fleaflicker_id, + player_name = player, + first = first_name, + last = last_name, + pos = pos, + team = team + ), + pos_temp = pos) %>% + rename(pos = pos_temp) %>% + select(-first_name, -last_name) + } + ) + + # Adding it to a list of DF's from the pages + out_dfs[[i]] = temp_df + + if(min(temp_df$site_pts) <= 1 || nrow(temp_df) < 20) { + break + } + + # Add 1 to i for page number counter + # Add 20 to offset for next page's URL + offset = offset + 20L + + } + + + # combine df's from each page + out = bind_rows(out_dfs) + + # Converting types of columns + idx = names(out) %in% c("id", "src_id") + out[!idx] = type.convert(out[!idx], as.is = TRUE) + + out + + + }) + + + + # list elements named by position + names(l_pos) = pos + attr(l_pos, "season") = season + attr(l_pos, "week") = week + + ## Combine defensive dataframes + # combine DE and DT into DL + if (exists("DE", where = l_pos) && exists("DT", where = l_pos)) { + l_pos$DL <- bind_rows(l_pos$DE, l_pos$DT) %>% + mutate(pos = "DL") %>% + distinct(src_id, .keep_all = TRUE) + + l_pos$DE <- NULL + l_pos$DT <- NULL + } + + # combine CB and S into DB + if (exists("CB", where = l_pos) && exists("S", where = l_pos)) { + l_pos$DB <- bind_rows(l_pos$CB, l_pos$S) %>% + mutate(pos = "DB") %>% + distinct(src_id, .keep_all = TRUE) + + l_pos$CB <- NULL + l_pos$S <- NULL + } + + cache_object(l_pos, "fleaflicker_scrape.rds") + + + l_pos + +} + +# FFToday ---- +scrape_fftoday <- function(pos = c("QB", "RB", "WR", "TE", "K", "DST", "DL", "LB", "DB"), + season = NULL, week = NULL, draft = TRUE, weekly = TRUE) { + + message("\nThe FFToday scrape uses a 2 second delay between pages") + + # Error on this scrape fixed by this: + # i.e., https://github.com/jeroen/curl/issues/156 + # httr::set_config(httr::config(http_version = 2)) + new_http_v = structure( + list(method = NULL, url = NULL, headers = NULL, fields = NULL, + options = list(http_version = 2), auth_token = NULL, output = NULL), + class = "request") + old_httr_config = getOption("httr_config") + if(!is.null(old_httr_config)) { + configs = c(old_httr_config, new_http_v) + } else { + options(httr_config = new_http_v) + } + on.exit({ + options(httr_config = old_httr_config) + }) + + + if(is.null(season)) { + season = get_scrape_year() + } + if(is.null(week)) { + week = get_scrape_week() + } + + + base_link <- paste0("https://www.fftoday.com/rankings/index.html") + site_session <- rvest::session(base_link) + + if(week > 18) { + week = week + 2L + } + if(week > 0) { + pos = setdiff(pos, c("DST", "DL", "LB", "DB")) + } + + + l_pos <- lapply_safe(pos, function(pos){ + + position = dplyr::case_when( + pos == "QB" ~ 10, + pos == "RB" ~ 20, + pos == "WR" ~ 30, + pos == "TE" ~ 40, + pos == "DL" ~ 50, + pos == "LB" ~ 60, + pos == "DB" ~ 70, + pos == "K" ~ 80, + pos == "DST" ~ 99 + ) + + + # Setting up hitting each page + i = 1L + cur_page = 0L + out_dfs = list() + + if(week == 0) { + scrape_link = paste0("https://www.fftoday.com/rankings/playerproj.php?PosID=", position, + "&LeagueID=1") + } else { + scrape_link = paste0("https://www.fftoday.com/rankings/playerwkproj.php?Season=", season, + "&GameWeek=", week, "&PosID=", position, "&LeagueID=1") + } + + cat(paste0("Scraping ", pos, " projections from"), scrape_link, sep = "\n ") + + + # The number of pages to scrape by position + pos_pages <- dplyr::case_when( + pos %in% c("QB", "TE", "K", "DST") ~ 1L, + pos %in% c("RB") ~ 2L, + pos %in% c("WR", "DL", "DB", "LB") ~ 3L + ) + + # Going through n pages (depending on position) pages + while (i <= pos_pages) { + + Sys.sleep(2L) + + if(week == 0) { + page_link = paste0("https://www.fftoday.com/rankings/playerproj.php?Season=", + season, "&PosID=", position, "&LeagueID=1", + "&order_by=FFPts&sort_order=DESC&cur_page=", cur_page) + } else { + page_link = paste0("https://www.fftoday.com/rankings/playerwkproj.php?Season=", season, + "&GameWeek=", week, "&PosID=", position, "&LeagueID=1", + "&order_by=FFPts&sort_order=DESC&cur_page=", cur_page) + } + + + html_page <- site_session %>% + session_jump_to(page_link) %>% + read_html() + + # FFToday player ID's + if(pos == "DST") { + fftoday_id = html_page %>% + html_elements("a[href *='stats/players']") %>% + html_attr("href") %>% + sub(".*?=(\\d{4}).*", "\\1", .) %>% + grep("\\d{4}", ., value = TRUE) + } else { + fftoday_id = html_page %>% + html_elements("a[href *='stats/players/']") %>% + html_attr("href") %>% + dirname() %>% + basename() + } + + # scrape contains list of player names and a list of data + scrape <- html_page %>% + html_elements(css = "table table table") %>% + html_table() %>% + base::`[[`(1) %>% + dplyr::mutate(dplyr::across(dplyr::everything(), + ~ gsub(",", "", .x, fixed = TRUE))) + + # Column names + scrape[2, ] = as.list(sub("^(.*?)\\n.*", "\\1", scrape[2, ])) + col_names <- trimws(paste(scrape[1, ], scrape[2, ])) + col_names = rename_vec(col_names, fftoday_columns) + + if(pos %in% c("DL", "DB", "LB")) { + col_names = gsub("(dst|pass)_", "idp_", col_names) + } + + scrape[] = rapply(scrape, function(x) gsub("%", "", x, fixed = TRUE), how = "replace") + + + # Dataframe + temp_df = type.convert(scrape[-c(1:2), ], as.is = TRUE) + names(temp_df) = col_names + + + # Create / fix additional columns + temp_df$pos = pos + temp_df$data_src = "FFToday" + temp_df$src_id = fftoday_id + temp_df$chg = NULL + + if(week > 0) { + temp_df$opp = gsub("@", "", temp_df$opp, fixed = TRUE) + } + if(pos == "DST") { + temp_df$id = get_mfl_id(fftoday_id, pos = temp_df$pos) + } else { + temp_df$id = get_mfl_id(fftoday_id, player_name = temp_df$player, + team = temp_df$team, pos = temp_df$pos) + } + if("bye" %in% col_names) { + temp_df$bye = as.integer(gsub("-", "", temp_df$bye, fixed = TRUE)) + } + + # Adding it to a list of DF's from the pages + out_dfs[[i]] = temp_df + + + # Add 1 to i for page number counter + i = i + 1L + cur_page = cur_page + 1L + + } + + # combine df's from each page + dplyr::bind_rows(out_dfs[sapply(out_dfs, nrow) > 0]) # temp fix for zero row dfs + + + }) + + # list elements named by position + names(l_pos) = pos + attr(l_pos, "season") = season + attr(l_pos, "week") = week + l_pos + +} + +# Fantasypros ---- +scrape_fantasypros = function(pos = c("QB", "RB", "WR", "TE", "K", "DST"), + season = NULL, week = NULL, draft = TRUE, weekly = TRUE) { + message("\nThe FantasyPros scrape uses a 2 second delay between pages") + + if(is.null(season)) { + season = get_scrape_year() + } + if(is.null(week)) { + week = get_scrape_week() + } + + + + if(week > 0) { + scrape_week = paste0(".php?week=", week) + } else { + scrape_week = ".php?week=draft" + } + + base_link = paste0("https://www.fantasypros.com/nfl/projections") + site_session = rvest::session(base_link) + + l_pos = lapply_safe(pos, function(pos) { + scrape_link = paste0("https://www.fantasypros.com/nfl/projections/", + tolower(pos), scrape_week) + + Sys.sleep(2L) # temporary, until I get an argument for honoring the crawl delay + cat(paste0("Scraping ", pos, " projections from"), scrape_link, sep = "\n ") + + html_page = site_session %>% + rvest::session_jump_to(scrape_link) %>% + rvest::read_html() + + + # Getting column names + if(pos %in% c("K", "DST")) { + col_names = html_page %>% + rvest::html_element("table > thead") %>% + rvest::html_text2() %>% + strsplit("\\t") %>% + base::`[[`(1) + + col_names = rename_vec(col_names, fantasypros_columns) + + } else { + col_names = html_page %>% + rvest::html_element("table > thead") %>% + rvest::html_table() + + col_names = trimws(paste(col_names[1, ], col_names[2, ])) + col_names = rename_vec(col_names, fantasypros_columns) + } + #data > tbody > tr.mpb-player-19275.js-tr-game-select + # Get PID + fantasypro_num_id = html_page %>% + rvest::html_elements("table > tbody > tr") %>% + rvest::html_attr("class") %>% + sub(".*?(\\d{4,6}).*", "\\1", .) + fantasypro_num_id = fantasypro_num_id[!is.na(fantasypro_num_id)] + + # Creating and cleaning table + out_df = html_page %>% + rvest::html_element("table > tbody") %>% + rvest::html_table() %>% + mutate(across(everything(), ~gsub(",", "", .x, fixed = TRUE))) + + names(out_df) = col_names + + # Adding a few columns + if(pos == "DST") { + out_df$src_id = fantasypro_num_id + out_df$data_src = "FantasyPros" + out_df$pos = pos + out_df$id = get_mfl_id(fantasypro_num_id) + } else { + out_df = out_df %>% + extract(player, c("player", "team"), "(.*)\\s+([A-Z]{2,3})") %>% + mutate(src_id = fantasypro_num_id, + data_src = "FantasyPros", + pos = pos, + id = get_mfl_id(fantasypro_num_id, player_name = player, team = team, pos = pos)) + } + + # Misc cleanup before done + idx = names(out_df) %in% c("id", "src_id") + out_df[!idx] = type.convert(out_df[!idx], as.is = TRUE) + out_df[out_df$site_pts > 0,] + }) + names(l_pos) = pos + attr(l_pos, "season") = season + attr(l_pos, "week") = week + + cache_object(l_pos, "walterfootball_scrape.rds") + l_pos +} + +# RTSports ---- +scrape_rtsports = function(pos = c("QB", "RB", "WR", "TE", "K", "DST"), + season = NULL, week = 0, draft = TRUE, weekly = FALSE) { + + message("\nThe RTSports scrape uses a 5 second delay between pages") + + if(is.null(season)) { + season = get_scrape_year() + } + if(is.null(week)) { + week = get_scrape_week() + } + if(week > 0) { + stop("RTS Sports projections are only available for week 0") + } + + base_url = "https://www.freedraftguide.com/football/draft-guide-rankings-provider.php" + + l_pos = lapply_safe(pos, function(x) { + if(x != pos[1]) { + Sys.sleep(5) + } + req = httr2::request(base_url) %>% + httr2::req_url_query(POS = rts_pos_idx[x]) + + cat(paste0("Scraping ", x, " projections from"), req$url, sep = "\n ") + rts_json = httr2::req_perform(req) %>% + httr2::resp_body_json() + + p_info = rrapply::rrapply( + rts_json, + function(x, .xname, .xpos) { + .xname %in% c("player_id", "stats_id", "name", "nfl_team") & length(.xpos) == 3 + }, + how = "melt") %>% + tidyr::pivot_wider(names_from = L3, values_from = value) %>% + dplyr::select(player_id, stats_id, name, nfl_team) + + p_data = rrapply::rrapply( + rts_json, + function(x, .xparents) "stats" %in% .xparents, + how = "melt" + ) %>% + tidyr::pivot_wider(names_from = L4, values_from = value) %>% + dplyr::select(-c(L1:L3)) %>% + Filter(f = function(x) any(x[1] != x, na.rm = TRUE)) + + if(x %in% c("RB", "WR", "TE") && "pass_yds" %in% names(p_data)) { + if(!"pass_atts" %in% names(p_data)) { + p_data[["pass_atts"]] = 0L + } + } + + out_df = dplyr::bind_cols(p_info, p_data) + + names(out_df) <- rename_vec(names(out_df), rts_columns) + if(x != "DST") { + out_df = out_df[out_df$site_pts > 0, ] + } + + out_df = type.convert(out_df, as.is = TRUE) + out_df$pos = x + out_df$id = get_mfl_id(out_df$stats_id, + player_name = out_df$player, + team = out_df$team, + pos = out_df$pos) + out_df$src_id = as.character(out_df$src_id) + out_df$stats_id = NULL + out_df$data_src = "RTSports" + dplyr::select(out_df, id, src_id, pos, data_src, dplyr::everything()) + }) + + # list elements named by position + names(l_pos) = pos + attr(l_pos, "season") = season + attr(l_pos, "week") = week + l_pos +} + +# ESPN ---- +scrape_espn = function(pos = c("QB", "RB", "WR", "TE", "K", "DST", "DL", "LB", "DB"), season = NULL, week = NULL, + draft = TRUE, weekly = TRUE, espn_league_id = NULL) { + + message("\nThe ESPN scrape uses a 2 second delay between pages") + + if(is.null(season)) { + season = get_scrape_year() + } + if(is.null(week)) { + week = get_scrape_week() + } + if(any(pos %in% c("DL", "LB", "DB")) && is.null(espn_league_id)){ + message("Must provide a valid espn_league_id to get DL, LB, and DB") + pos = setdiff(pos, c("DL", "LB", "DB")) + } + + slot_nums = c("QB" = 0, "RB" = 2, "WR" = 4, "TE" = 6, + "K" = 17, "DST" = 16, + "DT" = 8, "DE" = 9, "LB" = 10, "DL" = 11, "CB" = 12, "DB" = 14 + ) + position = pos + + l_pos = lapply_safe(position, function(pos){ + + if(pos != position[1]) { + Sys.sleep(2) + } + + pos_idx = slot_nums[pos] + limit = dplyr::case_when( + pos == "QB" ~ 42, + pos == "RB" ~ 100, + pos == "WR" ~ 150, + pos == "TE" ~ 60, + pos == "K" ~ 35, + pos == "DST" ~ 32, + pos == "DL" ~ 90, + pos == "DB" ~ 60, + pos == "LB" ~ 60 + ) + + if(pos %in% c("DL", "DB", "LB")) { + base_url = paste0( + "https://lm-api-reads.fantasy.espn.com/apis/v3/games/ffl/seasons/", season, + "/segments/0/leagues/", espn_league_id, "?scoringPeriodId=", week, "&view=kona_player_info" + ) + #1595759 + pos_cols = espn_columns[!grepl("^dst_", espn_columns)] + + } else { + base_url = paste0( + "https://lm-api-reads.fantasy.espn.com/apis/v3/games/ffl/seasons/", season, + "/segments/0/leaguedefaults/3?scoringPeriodId=0&view=kona_player_info" + ) + pos_cols = espn_columns[!grepl("^idp_", espn_columns)] + } + + cat(paste0("Scraping ", pos, " projections from"), + "https://fantasy.espn.com/football/players/projections", sep = "\n ") + + if(week == 0) { + filter_split_id = 0 + } else { + filter_split_id = 1 + } + + fantasy_filter = paste0( + '{"players":{', + '"filterSlotIds":{"value":[', pos_idx, ']},', + '"filterStatsForSourceIds":{"value":[1]},', + '"filterStatsForSplitTypeIds":{"value":[', filter_split_id, ']},', + '"sortAppliedStatTotal":{"sortAsc":false,"sortPriority":3,"value":"11', season, week, '"},', + '"sortDraftRanks":{"sortPriority":2,"sortAsc":true,"value":"PPR"},', + '"sortPercOwned":{"sortAsc":false,"sortPriority":4},', + '"limit":', limit, ',', + '"offset":0,', + '"filterRanksForScoringPeriodIds":{"value":[2]},', + '"filterRanksForRankTypes":{"value":["PPR"]},', + '"filterRanksForSlotIds":{"value":[0,2,4,6,17,16,15]},', + '"filterStatsForTopScoringPeriodIds":{"value":2,', + '"additionalValue":["00', season, '","10', season, '","11', season, week, '","02', season, '"]}}}' + ) + + espn_json = httr2::request(base_url) %>% + httr2::req_method("GET") %>% + httr2::req_headers( + Accept = "application/json", + `Accept-Encoding` = "gzip, deflate, br", + Connection = "keep-alive", + Host = "lm-api-reads.fantasy.espn.com", + `X-Fantasy-Source` = "kona", + `X-Fantasy-Filter` = fantasy_filter, + ) %>% + httr2::req_user_agent("ffanalytics R package (https://github.com/FantasyFootballAnalytics/ffanalytics)") %>% + httr2::req_perform() %>% + httr2::resp_body_json() %>% + base::`[[`("players") + + l_players = vector("list", length(espn_json)) + + for(i in seq_along(espn_json)) { + + # Checking for empty stats (bye weeks) + if(length(espn_json[[i]]$player$stats) == 0L) { + next + } + + # Player stats (only those on) + l_players[[i]] = espn_json[[i]]$player$stats[[1]]$stats + l_players[[i]] = l_players[[i]][names(l_players[[i]]) %in% names(pos_cols)] + names(l_players[[i]]) = pos_cols[names(l_players[[i]])] + l_players[[i]][] = lapply(l_players[[i]], round) + + # Misc player info + l_players[[i]]$espn_id = espn_json[[i]]$id + l_players[[i]]$player_name = espn_json[[i]]$player$fullName + l_players[[i]]$team = espn_team_nums[as.character(espn_json[[i]]$player$proTeamId)] + l_players[[i]]$position = pos + } + + out_df = dplyr::bind_rows(l_players) + out_df$data_src = "ESPN" + + if(pos == "DST") { # ESPN ID's coming in as negative for 2023 wk 0 DST + out_df$id = get_mfl_id( + team = out_df$team, + pos = out_df$position + ) + } else { + out_df$id = get_mfl_id( + out_df$espn_id, + player_name = out_df$player_name, + pos = out_df$position, + team = out_df$team + ) + } + + out_df = out_df %>% + dplyr::select(id, src_id = espn_id, pos = position, + player = player_name, team, dplyr::everything()) + + idx = names(out_df) %in% c("id", "src_id") + out_df[idx] = lapply(out_df[idx], as.character) + out_df[!idx] = type.convert(out_df[!idx], as.is = TRUE) + out_df + }) + + names(l_pos) = position + + attr(l_pos, "season") = season + attr(l_pos, "week") = week + l_pos + +} + +# Fantasy football nerd ---- +scrape_fantasyfootballnerd = function(pos = NULL, season = NULL, week = NULL, + draft = TRUE, weekly = TRUE, ffnerd_api_key = NULL) { + message( + "\nThe FantasyFootballNerd scrape is not implemeted yet--we are working on it" + ) + +} + +scrape_fantasyfootballnerd_beta = function(pos = NULL, season = NULL, week = NULL, + draft = TRUE, weekly = TRUE, ffnerd_api_key = NULL) { + + draft_url = "https://api.fantasynerds.com/v1/nfl/draft-projections?apikey=TEST" + pos_url = "https://api.fantasynerds.com/v1/nfl/ros?apikey=TEST" + weekly_url = "https://api.fantasynerds.com/v1/nfl/weekly-projections?apikey=TEST" + +} + + +# FantasyData ---- +scrape_fantasydata = function(pos = NULL, season = NULL, week = NULL, + draft = TRUE, weekly = TRUE, fantasydata_api_key = NULL) { + message( + "\nThe FantasyData scrape is behind a paywall and is not supported at this time" + ) +} + +# FanDuel ---- +scrape_fanduel <- function(pos = c("QB", "RB", "WR", "TE", "K", "DST"), + season = NULL, week = NULL, draft = TRUE, weekly = TRUE) { + if(is.null(season)) { season = get_scrape_year() } - if(is.null(week)) { - week = get_scrape_week() - } - if(any(pos %in% c("DL", "LB", "DB")) && is.null(espn_league_id)){ - message("Must provide a valid espn_league_id to get DL, LB, and DB") - pos = setdiff(pos, c("DL", "LB", "DB")) - } - - slot_nums = c("QB" = 0, "RB" = 2, "WR" = 4, "TE" = 6, - "K" = 17, "DST" = 16, - "DT" = 8, "DE" = 9, "LB" = 10, "DL" = 11, "CB" = 12, "DB" = 14 - ) - position = pos - - l_pos = lapply_safe(position, function(pos){ - - if(pos != position[1]) { - Sys.sleep(2) - } - - pos_idx = slot_nums[pos] - limit = dplyr::case_when( - pos == "QB" ~ 42, - pos == "RB" ~ 100, - pos == "WR" ~ 150, - pos == "TE" ~ 60, - pos == "K" ~ 35, - pos == "DST" ~ 32, - pos == "DL" ~ 90, - pos == "DB" ~ 60, - pos == "LB" ~ 60 - ) - - if(pos %in% c("DL", "DB", "LB")) { - base_url = paste0( - "https://lm-api-reads.fantasy.espn.com/apis/v3/games/ffl/seasons/", season, - "/segments/0/leagues/", espn_league_id, "?scoringPeriodId=", week, "&view=kona_player_info" - ) - #1595759 - pos_cols = espn_columns[!grepl("^dst_", espn_columns)] - - } else { - base_url = paste0( - "https://lm-api-reads.fantasy.espn.com/apis/v3/games/ffl/seasons/", season, - "/segments/0/leaguedefaults/3?scoringPeriodId=0&view=kona_player_info" - ) - pos_cols = espn_columns[!grepl("^idp_", espn_columns)] + + if(is.null(week)) { + week = get_scrape_week() + } + + if(week > 0) { + proj_type = "WEEKLY" + } else { + proj_type = "REMAINING" + } + + if(is.null(pos)) { + pos = c("QB", "RB", "WR", "TE", "K", "DST") + } else { + pos + } + + message(paste0("\nScraping FanDuel projections for ", paste(pos, collapse = ", "), "...")) + + query <- ' + query GetProjections($input: ProjectionsInput!) { + getProjections(input: $input) { + ... on NflSkill { + player { + numberFireId + name + position + } + team { + numberFireId + name + abbreviation + } + gameInfo { + homeTeam { + numberFireId + name + abbreviation + } + awayTeam { + numberFireId + name + abbreviation + } + gameTime + } + salary + value + completionsAttempts + passingYards + passingTouchdowns + interceptionsThrown + rushingAttempts + rushingYards + rushingTouchdowns + receptions + targets + receivingYards + receivingTouchdowns + fantasy + positionRank + overallRank + opponentDefensiveRank + } + ... on NflKicker { + player { + numberFireId + name + position + } + team { + numberFireId + name + + abbreviation + } + gameInfo { + homeTeam { + numberFireId + name + abbreviation + } + awayTeam { + numberFireId + name + abbreviation + } + gameTime + } + salary + value + extraPointsAttempted + extraPointsMade + fieldGoalsAttempted + fieldGoalsMade + fieldGoalsMade0To19 + fieldGoalsMade20To29 + fieldGoalsMade30To39 + fieldGoalsMade40To49 + fieldGoalsMade50Plus + fantasy + positionRank + opponentDefensiveRank + } + ... on NflDefenseSt { + player { + numberFireId + name + position + } + team { + numberFireId + name + abbreviation + } + gameInfo { + homeTeam { + numberFireId + name + abbreviation + } + awayTeam { + numberFireId + name + abbreviation + } + gameTime + } + salary + value + pointsAllowed + yardsAllowed + sacks + interceptions + fumblesRecovered + touchdowns + fantasy + positionRank + opponentOffensiveRank + } + ... on NflDefensePlayer { + player { + numberFireId + name + position + } + team { + numberFireId + name + abbreviation + } + gameInfo { + homeTeam { + numberFireId + name + abbreviation + } + awayTeam { + numberFireId + name + abbreviation + } + gameTime + } + tackles + sacks + interceptions + touchdowns + passesDefended + fumblesRecovered + opponentOffensiveRank + } + } + } + ' + + data_payload <- list( + query = query, + variables = list( + input = list( + type = proj_type, + position = "NFL_SKILL", + sport = "NFL" + ) + ), + operationName = "GetProjections" + ) + + req <- httr2::request("https://fdresearch-api.fanduel.com/graphql") %>% + httr2::req_headers( + Accept = "*/*", + "Content-Type" = "application/json", + "Sec-Fetch-Site" = "same-site", + Origin = "https://www.fanduel.com", + "Sec-Fetch-Dest" = "empty", + "Accept-Language" = "en-US,en;q=0.9", + "Sec-Fetch-Mode" = "cors", + "Accept-Encoding" = "gzip, deflate" + ) %>% + httr2::req_user_agent( + "ffanalytics R package (https://github.com/FantasyFootballAnalytics/ffanalytics)" + ) + + position_groups <- list( + NFL_SKILL = c("QB","RB","WR","TE"), + NFL_KICKER = c("K"), + NFL_D_ST = c("DST") + ) + + graphql_positions <- names(position_groups)[ + vapply(position_groups, function(x) any(pos %in% x), logical(1)) + ] + + all_dfs <- map(graphql_positions, function(graph_pos) { + data_payload$variables$input$position <- graph_pos + + resp <- req %>% + httr2::req_body_json(data_payload) %>% + httr2::req_perform() + + result <- httr2::resp_body_json( + resp, + simplifyDataFrame = TRUE, + flatten = TRUE + ) + + projections <- result$data$getProjections + + # FanDuel returns an empty list when projections are not yet available + # (for example, during the offseason). Skip that position group instead of + # attempting to mutate a zero-column tibble, where `pos` would otherwise + # resolve to the function argument and produce a misleading size error. + if(is.null(projections) || length(projections) == 0) { + return(NULL) } - cat(paste0("Scraping ", pos, " projections from"), - "https://fantasy.espn.com/football/players/projections", sep = "\n ") - - if(week == 0) { - filter_split_id = 0 - } else { - filter_split_id = 1 - } - - fantasy_filter = paste0( - '{"players":{', - '"filterSlotIds":{"value":[', pos_idx, ']},', - '"filterStatsForSourceIds":{"value":[1]},', - '"filterStatsForSplitTypeIds":{"value":[', filter_split_id, ']},', - '"sortAppliedStatTotal":{"sortAsc":false,"sortPriority":3,"value":"11', season, week, '"},', - '"sortDraftRanks":{"sortPriority":2,"sortAsc":true,"value":"PPR"},', - '"sortPercOwned":{"sortAsc":false,"sortPriority":4},', - '"limit":', limit, ',', - '"offset":0,', - '"filterRanksForScoringPeriodIds":{"value":[2]},', - '"filterRanksForRankTypes":{"value":["PPR"]},', - '"filterRanksForSlotIds":{"value":[0,2,4,6,17,16,15]},', - '"filterStatsForTopScoringPeriodIds":{"value":2,', - '"additionalValue":["00', season, '","10', season, '","11', season, week, '","02', season, '"]}}}' - ) - - espn_json = httr2::request(base_url) %>% - httr2::req_method("GET") %>% - httr2::req_headers( - Accept = "application/json", - `Accept-Encoding` = "gzip, deflate, br", - Connection = "keep-alive", - Host = "lm-api-reads.fantasy.espn.com", - `X-Fantasy-Source` = "kona", - `X-Fantasy-Filter` = fantasy_filter, - ) %>% - httr2::req_user_agent("ffanalytics R package (https://github.com/FantasyFootballAnalytics/ffanalytics)") %>% - httr2::req_perform() %>% - httr2::resp_body_json() %>% - base::`[[`("players") - - l_players = vector("list", length(espn_json)) - - for(i in seq_along(espn_json)) { - - # Checking for empty stats (bye weeks) - if(length(espn_json[[i]]$player$stats) == 0L) { - next - } - - # Player stats (only those on) - l_players[[i]] = espn_json[[i]]$player$stats[[1]]$stats - l_players[[i]] = l_players[[i]][names(l_players[[i]]) %in% names(pos_cols)] - names(l_players[[i]]) = pos_cols[names(l_players[[i]])] - l_players[[i]][] = lapply(l_players[[i]], round) - - # Misc player info - l_players[[i]]$espn_id = espn_json[[i]]$id - l_players[[i]]$player_name = espn_json[[i]]$player$fullName - l_players[[i]]$team = espn_team_nums[as.character(espn_json[[i]]$player$proTeamId)] - l_players[[i]]$position = pos - } - - out_df = dplyr::bind_rows(l_players) - out_df$data_src = "ESPN" - - if(pos == "DST") { # ESPN ID's coming in as negative for 2023 wk 0 DST - out_df$id = get_mfl_id( - team = out_df$team, - pos = out_df$position - ) - } else { - out_df$id = get_mfl_id( - out_df$espn_id, - player_name = out_df$player_name, - pos = out_df$position, - team = out_df$team - ) - } - - out_df = out_df %>% - dplyr::select(id, src_id = espn_id, pos = position, - player = player_name, team, dplyr::everything()) - - idx = names(out_df) %in% c("id", "src_id") - out_df[idx] = lapply(out_df[idx], as.character) - out_df[!idx] = type.convert(out_df[!idx], as.is = TRUE) - out_df - }) - - names(l_pos) = position - - attr(l_pos, "season") = season - attr(l_pos, "week") = week - l_pos - -} - -# Fantasy football nerd ---- -scrape_fantasyfootballnerd = function(pos = NULL, season = NULL, week = NULL, - draft = TRUE, weekly = TRUE, ffnerd_api_key = NULL) { - message( - "\nThe FantasyFootballNerd scrape is not implemeted yet--we are working on it" - ) - -} - -scrape_fantasyfootballnerd_beta = function(pos = NULL, season = NULL, week = NULL, - draft = TRUE, weekly = TRUE, ffnerd_api_key = NULL) { - - draft_url = "https://api.fantasynerds.com/v1/nfl/draft-projections?apikey=TEST" - pos_url = "https://api.fantasynerds.com/v1/nfl/ros?apikey=TEST" - weekly_url = "https://api.fantasynerds.com/v1/nfl/weekly-projections?apikey=TEST" - -} - - -# FantasyData ---- -scrape_fantasydata = function(pos = NULL, season = NULL, week = NULL, - draft = TRUE, weekly = TRUE, fantasydata_api_key = NULL) { - message( - "\nThe FantasyData scrape is behind a paywall and is not supported at this time" - ) -} - -# FanDuel ---- -scrape_fanduel <- function(pos = c("QB", "RB", "WR", "TE", "K", "DST"), - season = NULL, week = NULL, draft = TRUE, weekly = TRUE) { - - if(is.null(week)) { - season = get_scrape_year() + df <- dplyr::as_tibble(projections) + + names(df) <- gsub("\\.", "_", names(df)) + names(df) <- rename_vec(names(df), fanduel_columns) + + df <- df %>% + type.convert(as.is = TRUE) %>% + dplyr::mutate( + data_src = "FanDuel", + proj_type = proj_type, + pos = ifelse(pos == "D", "DST", pos), + id = get_mfl_id(df$src_id, + player_name = df$player, + team = df$team, + pos = df$pos), + src_id = as.character(src_id) + ) + + if ("completionsAttempts" %in% names(df)) { + df <- df %>% + tidyr::separate( + completionsAttempts, + into = c("pass_comp", "pass_att"), + sep = "/", + convert = TRUE + ) + } + + df %>% dplyr::filter(pos %in% position_groups[[graph_pos]]) + }) + + all_dfs <- purrr::compact(all_dfs) + + if(length(all_dfs) == 0) { + message("FanDuel returned no projections. Please check back later.") + l_pos <- list() + attr(l_pos, "season") <- season + attr(l_pos, "week") <- week + return(l_pos) } - if(is.null(week)) { - week = get_scrape_week() - } - - if(week > 0) { - proj_type = "WEEKLY" - } else { - proj_type = "REMAINING" - } - - if(is.null(pos)) { - pos = c("QB", "RB", "WR", "TE", "K", "DST") - } else { - pos - } - - message(paste0("\nScraping FanDuel projections for ", paste(pos, collapse = ", "), "...")) - - query <- ' - query GetProjections($input: ProjectionsInput!) { - getProjections(input: $input) { - ... on NflSkill { - player { - numberFireId - name - position - } - team { - numberFireId - name - abbreviation - } - gameInfo { - homeTeam { - numberFireId - name - abbreviation - } - awayTeam { - numberFireId - name - abbreviation - } - gameTime - } - salary - value - completionsAttempts - passingYards - passingTouchdowns - interceptionsThrown - rushingAttempts - rushingYards - rushingTouchdowns - receptions - targets - receivingYards - receivingTouchdowns - fantasy - positionRank - overallRank - opponentDefensiveRank - } - ... on NflKicker { - player { - numberFireId - name - position - } - team { - numberFireId - name - - abbreviation - } - gameInfo { - homeTeam { - numberFireId - name - abbreviation - } - awayTeam { - numberFireId - name - abbreviation - } - gameTime - } - salary - value - extraPointsAttempted - extraPointsMade - fieldGoalsAttempted - fieldGoalsMade - fieldGoalsMade0To19 - fieldGoalsMade20To29 - fieldGoalsMade30To39 - fieldGoalsMade40To49 - fieldGoalsMade50Plus - fantasy - positionRank - opponentDefensiveRank - } - ... on NflDefenseSt { - player { - numberFireId - name - position - } - team { - numberFireId - name - abbreviation - } - gameInfo { - homeTeam { - numberFireId - name - abbreviation - } - awayTeam { - numberFireId - name - abbreviation - } - gameTime - } - salary - value - pointsAllowed - yardsAllowed - sacks - interceptions - fumblesRecovered - touchdowns - fantasy - positionRank - opponentOffensiveRank - } - ... on NflDefensePlayer { - player { - numberFireId - name - position - } - team { - numberFireId - name - abbreviation - } - gameInfo { - homeTeam { - numberFireId - name - abbreviation - } - awayTeam { - numberFireId - name - abbreviation - } - gameTime - } - tackles - sacks - interceptions - touchdowns - passesDefended - fumblesRecovered - opponentOffensiveRank - } - } - } - ' - - data_payload <- list( - query = query, - variables = list( - input = list( - type = proj_type, - position = "NFL_SKILL", - sport = "NFL" - ) - ), - operationName = "GetProjections" - ) - - req <- httr2::request("https://fdresearch-api.fanduel.com/graphql") %>% - httr2::req_headers( - Accept = "*/*", - "Content-Type" = "application/json", - "Sec-Fetch-Site" = "same-site", - Origin = "https://www.fanduel.com", - "Sec-Fetch-Dest" = "empty", - "Accept-Language" = "en-US,en;q=0.9", - "Sec-Fetch-Mode" = "cors", - "Accept-Encoding" = "gzip, deflate" - ) %>% - httr2::req_user_agent( - "ffanalytics R package (https://github.com/FantasyFootballAnalytics/ffanalytics)" - ) - - position_groups <- list( - NFL_SKILL = c("QB","RB","WR","TE"), - NFL_KICKER = c("K"), - NFL_D_ST = c("DST") - ) - - graphql_positions <- names(position_groups)[ - vapply(position_groups, function(x) any(pos %in% x), logical(1)) - ] - - all_dfs <- map(graphql_positions, function(graph_pos) { - data_payload$variables$input$position <- graph_pos - - resp <- req %>% - httr2::req_body_json(data_payload) %>% - httr2::req_perform() - - result <- httr2::resp_body_json( - resp, - simplifyDataFrame = TRUE, - flatten = TRUE - ) - - df <- dplyr::as_tibble(result$data$getProjections) - - names(df) <- gsub("\\.", "_", names(df)) - names(df) <- rename_vec(names(df), fanduel_columns) - - df <- df %>% - type.convert(as.is = TRUE) %>% - dplyr::mutate( - data_src = "FanDuel", - proj_type = proj_type, - pos = ifelse(pos == "D", "DST", pos), - id = get_mfl_id(df$src_id, - player_name = df$player, - team = df$team, - pos = df$pos), - src_id = as.character(src_id) - ) - - if ("completionsAttempts" %in% names(df)) { - df <- df %>% - tidyr::separate( - completionsAttempts, - into = c("pass_comp", "pass_att"), - sep = "/", - convert = TRUE - ) - } - - df %>% dplyr::filter(pos %in% position_groups[[graph_pos]]) - }) - out_df <- all_dfs %>% - dplyr::bind_rows() %>% - dplyr::select(id, src_id, player, pos, team, everything()) - l_pos <- split(out_df, out_df$pos) - l_pos <- l_pos[pos[pos %in% names(l_pos)]] - l_pos <- purrr::map(l_pos, function(df) { - df %>% - dplyr::select(-salary, -value) %>% - dplyr::select(where(~ !all(is.na(.)))) - }) - - attr(l_pos, "season") <- season - attr(l_pos, "week") <- week - - l_pos -} - -# Depreceated ---- -scrape_yahoo = function(pos = NULL, season = NULL, week = NULL, - draft = TRUE, weekly = TRUE) { - message( - "\nThe Yahoo scrape is no longer supported because they now use FantasyPros projections" - ) -} - - - - - - - - - - - - - - - - + dplyr::bind_rows() %>% + dplyr::select(id, src_id, player, pos, team, everything()) + l_pos <- split(out_df, out_df$pos) + l_pos <- l_pos[pos[pos %in% names(l_pos)]] + l_pos <- purrr::map(l_pos, function(df) { + df %>% + dplyr::select(-salary, -value) %>% + dplyr::select(where(~ !all(is.na(.)))) + }) + + attr(l_pos, "season") <- season + attr(l_pos, "week") <- week + + l_pos +} + +# Depreceated ---- +scrape_yahoo = function(pos = NULL, season = NULL, week = NULL, + draft = TRUE, weekly = TRUE) { + message( + "\nThe Yahoo scrape is no longer supported because they now use FantasyPros projections" + ) +} + + + + + + + + + + + + + + + +