R/FPL.R

In harveyl888/fplR: Functions To Process Fantasy Premiership Data

#' Get team, player and game data
#'
#' Retrieve fantasy football data from fantasy.premierleague.com site.
#'
#' @return a list containing phases, elements, game-settings, total-players, teams,
#' element_types and events
#'
#' @import jsonlite
#' @export
getFPLData <- function() {
  url <- 'https://fantasy.premierleague.com/drf/bootstrap-static'
  data <- fromJSON(url)
  return(data)
}

#' Get a league table
#'
#' Retrieve a fantasy football league table for a specific phase
#'
#' @param leagueID Numeric league identifier
#' @param phase Phase number.  If \code{NULL} then return the current league table
#'
#' @import jsonlite
#' @export
getLeagueTable <- function(leagueID = NULL, phase = NULL) {
  if (is.null(leagueID)) return()
  if (is.null(phase)) {
    url <- paste0('https://fantasy.premierleague.com/drf/leagues-classic-standings/', leagueID)
  } else {
    url <- paste0('https://fantasy.premierleague.com/drf/leagues-classic-standings/', leagueID, '?phase=', phase)
  }
  data <- fromJSON(url)
  return(data)
}


#' .teamID
#'
#' Return short Premier League team name from ID
#'
#' @param fpl Output from getFPLData
#' @param Team identifier (single number or vector of numbers)
#'
.teamID <- function(fpl, id) {
  return(sapply(id, function(x) fpl$teams[fpl$teams$id == x, 'short_name']))
}


#' .posID
#'
#' Return a playing position from ID
#'
#' @param Position identifier (single number or vector of numbers)
#'
.posID <- function(id) {
  positions <- c('GLK', 'DEF', 'MID', 'FWD')
  return(sapply(id, function(x) positions[x]))
}



#' Get all entries for a particular league
#'
#' Return a list of dataframes each containing an entry
#'
#' @param leagueID Numeric league identifier
#' @param wk Week number
#' @param fpl Output from getFPLData
#'
#' @import dplyr
#' @export
getLeagueEntries <- function(leagueID, wk = 1, fpl = NULL) {
  if (is.null(fpl)) fpl <- getFPLData()
  leagueTableData <- getLeagueTable(leagueID, NULL)
  df.leagueTable <- leagueTableData$standings$results
  entries <- df.leagueTable$entry
  l.team <- list()
  for (i in 1:length(entries)) {
    allData <- getTeam(entries[[i]], wk)
    l.team[[i]] <- allData$picks
    Sys.sleep(0.1)
  }
  l.team <- lapply(l.team, function(x) x %>%
                     left_join(fpl$elements %>% select(id, first_name, second_name, element_type, team), c('element' = 'id')) %>%
                     mutate(element_type = .posID(element_type)) %>%
                     mutate(team = .teamID(fpl, team))
  )
  return(l.team)
}


#' Identify players included in and missing from fantasy teams
#'
#' Identify players included in and missing from fantasy teams
#'
#' @param l.teams A series of teams as generated by getLeagueEntries
#' @param fpl Output from getFPLData
#'
#' @import dplyr
#' @export
playerCount <- function(l.teams, fpl = NULL) {
  if (is.null(fpl)) fpl <- getFPLData()
  df.players <- as.data.frame(table(sort(unlist(lapply(l.teams, function(x) x$element)))), stringsAsFactors = FALSE)
  names(df.players) <- c('element', 'count')
  df.players$element <- as.numeric(df.players$element)
  df.players <- rbind(df.players, data.frame(element = fpl$elements$id[!fpl$elements$id %in% df.players$element], count = 0))
  df.players <- df.players %>% left_join(fpl$elements %>% select(id, first_name, second_name, element_type, team, now_cost, total_points), c('element' = 'id')) %>%
    mutate(team = .teamID(fpl, team)) %>%
    mutate(now_cost = now_cost / 10) %>%
    arrange(element_type, team, now_cost) %>%
    mutate(element_type = .posID(element_type))
  return(df.players)
}


#' Get an entry info
#'
#' Return entry details and historical league information
#'
#' @param entry Numeric entry identifier
#'
#' @import jsonlite
#' @export
getEntry <- function(entry = NULL) {
  if (is.null(entry)) return()
  url <- paste0('https://fantasy.premierleague.com/drf/entry/', entry)
  data <- fromJSON(url)
  return(data)
}

#' Get team data
#'
#' Return team information from a specific week.
#'
#' @param entry Numeric entry identifier
#' @param wk Week number
#'
#' @import jsonlite
#' @export
getTeam <- function(entry = NULL, wk = 1) {
  if (is.null(entry)) return()
  url <- paste0('https://fantasy.premierleague.com/drf/entry/', entry, '/event/', wk, '/picks')
  data <- fromJSON(url)
  return(data)
}


#' Get event details and points
#'
#' Return point details of all players from a particular week
#'
#' @param wk Week number
#'
#' @import jsonlite
#' @export
getEvent <- function(wk = 1) {
  url <- paste0('https://fantasy.premierleague.com/drf/event/', wk, '/live')
  data <- fromJSON(url)
  return(data)
}


#' Player Point data frame
#'
#' Return a data frame of players and points up to a maximum week
#'
#' @param fpl Output from getFPLData
#' @param maxWeek maximum week number to run (current week if set to NULL)
#'
#' @import dplyr
#' @export
pointsFrame <- function(fpl = NULL, maxWeek = NULL) {
  if (is.null(fpl)) fpl <- getFPLData()
  currentWeek <- which(fpl$events$is_current)
  if (is.null(maxWeek)) maxWeek <- currentWeek
  if (maxWeek > currentWeek) maxWeek <- currentWeek
  l.data <- list()
  for (i in 1:maxWeek) {
    allData <- getEvent(i)
    l.data[[i]] <- allData$elements
    Sys.sleep(0.1)
  }
  l.points <- lapply(l.data, function(x) data.frame(id = names(x), p = sapply(x, function(y) y$stats$total_points), stringsAsFactors = FALSE))
  df <- Reduce(function(...) merge(..., by='id', all=T), l.points)
  df$id  <- as.integer(df$id)
  df <- df %>% left_join(fpl$elements %>% select(id, first_name, second_name), by = 'id') %>% arrange(id)
  df <- df[, c(1, ncol(df)-1, ncol(df), 2:(ncol(df)-2))]
  colnames(df)[4:ncol(df)] <- paste0('week ', seq(maxWeek))
  return(df)
}

# df <- team$picks
# df <- df %>%
#   left_join(fpl$elements %>%
#               select(id, first_name, second_name, element_type, team), c('element' = 'id'))