R/get_projection.R

In p0bs/premPredictor: Calculations for a Football Prediction Competition

#' @title Calcuating the Probability of Player Success One Week Out
#'
#' @description This function projects the competition's final standings a week beforehand, using the player preditions, the latest EPL table and the odds data for the final week of matches in the Premier League.
#' @param url_odds A character string for the URL on Dropbox of the csv file that stores the odds data.
#' @param url_predictions A character string for the URL on Dropbox of the csv file that stores the players' predictions.
#' @param project_players A boolean to determine whether to project player (TRUE) or team (FALSE) outcomes.
#' @param runs Number of iterations to use.
#' @param seed Seed used for random trials.
#' @param ... Other arguments, such as for saved EPL data.
#' @keywords import
#' @export
#' @examples
#' \dontrun{
#' get_projection(url_odds = "https://www.abcdef.com/abcdefg123.csv", url_predictions = "https://www.abcdef.com/abcdefg1234.csv")
#' }

get_projection <- function(url_odds, url_predictions, project_players = TRUE, runs = 10000, seed = 26, ...){

  iterations <- runs
  set.seed(seed = seed)
  gameOddsBuilder <- premPredictor::get_odds_data(url_value = url_odds)
  dataInput <- premPredictor::get_player_data(url_value = url_predictions)
  clubOrder <- premPredictor::get_latest_EPL_table(...) %>%
    dplyr::mutate(fullPts = (1000*Pts) + GD)

  clubsABC <- clubOrder %>%
    dplyr::select(Team, fullPts) %>%
    dplyr::arrange(Team)

  clubStandings <- match(dataInput$Club, clubOrder$Team, 0)

  predictions <- dataInput[,-1]
  nPlayers <- ncol(predictions)

  ssq <- function(x){sum((x-clubStandings)^2)}
  score <- tibble::as_tibble(apply(predictions,2,ssq))
  names <- tibble::as_tibble(colnames(predictions))
  names1 <- tibble::as_tibble(stringr::str_replace_all(t(names), "_", " "))


  vectorRandom <- purrr::as_vector(
    ceiling(
      runif(
        10*iterations,
        min = 0,
        max = 7)
    )
  )

  netGameGoals <- matrix(data = vectorRandom, ncol = 10)
  colnames(netGameGoals) <- paste0("n", 1:10)

  unitVectorRandom <- as.vector(runif(10*iterations, min = 0, max = 1))
  randomGameValues <- matrix(data = unitVectorRandom, ncol = 10)
  colnames(randomGameValues) <- paste0("r", 1:10)

  simulatedCalcs <- tibble::tibble(
    iteration = seq.int(iterations)) %>%
    cbind(randomGameValues, netGameGoals)

  pointsAdjuster <- function(team) {

    teamName <- dplyr::enquo(team)

    matchNo <- teamData$matchNo[teamData$team == lazyeval::uq(teamName)]
    isHomeTeam <- teamData$isHomeTeam[teamData$team == lazyeval::uq(teamName)]
    existingPoints <- clubsABC$fullPts[clubsABC == lazyeval::uq(teamName)]
    winBreakpoint <- teamData$winSlice[teamData$team == lazyeval::uq(teamName)]
    drawBreakpoint <- teamData$drawSlice[teamData$team == lazyeval::uq(teamName)]
    workings <- tibble::tibble(
      firstColumn = simulatedCalcs[, (matchNo + 1)],
      secondColumn = simulatedCalcs[, (matchNo + 11)])

    existingPoints + if (isHomeTeam == TRUE) {
      workings %>%
        dplyr::rowwise() %>%
        dplyr::mutate(
          newPoints = ifelse(
            firstColumn < winBreakpoint,
            3000 + secondColumn,
            ifelse(
              firstColumn < drawBreakpoint,
              1000,
              -secondColumn)
          )
        ) %>%
        dplyr::pull(newPoints)

    } else {

      workings %>%
        dplyr::rowwise() %>%
        dplyr::mutate(
          newPoints = ifelse(
            firstColumn < winBreakpoint,
            -secondColumn,
            ifelse(
              firstColumn < drawBreakpoint,
              1000,
              3000 + secondColumn)
          )
        ) %>%
        dplyr::pull(newPoints)
    }
  }

  homeTeamData <- gameOddsBuilder %>%
    tibble::rownames_to_column(var = "matchNo") %>%
    dplyr::rename(
      team = homeTeam,
      otherTeam = awayTeam) %>%
    dplyr::select(team, otherTeam, game, matchNo, homeValue:drawSlice) %>%
    dplyr::mutate(
      isHomeTeam = TRUE,
      matchNo = as.integer(matchNo))

  awayTeamData <- gameOddsBuilder %>%
    tibble::rownames_to_column(var = "matchNo") %>%
    dplyr::rename(
      team = awayTeam,
      otherTeam = homeTeam) %>%
    dplyr::select(team, otherTeam, game, matchNo, homeValue:drawSlice) %>%
    dplyr::mutate(
      isHomeTeam = FALSE,
      matchNo = as.integer(matchNo))

  teamData <- dplyr::bind_rows(homeTeamData, awayTeamData) %>%
    dplyr::arrange(matchNo, desc(isHomeTeam))

  adjustedPoints <- clubsABC$Team %>%
    purrr::map(pointsAdjuster) %>%
    as.data.frame()

  colnames(adjustedPoints) <- clubsABC$Team

  simClubOrderString <- as.integer(apply(-adjustedPoints, 1, rank, ties.method="average"))
  tsimClubOrder <- matrix(simClubOrderString, nrow = 20)

  simClubOrder <- as.data.frame(t(tsimClubOrder))
  colnames(simClubOrder) <- clubsABC$Team

  if(project_players == FALSE){

    return(simClubOrder)

  } else {

    simPlayerScores <- matrix(rep(0L, nPlayers*iterations), nrow = iterations)
    tPredictions <- t(predictions)

    for (i in 1:nPlayers){

      mPredictions <- matrix(
        rep(tPredictions[i,], iterations),
        nrow = iterations,
        byrow = TRUE)

      workingMisses <- (simClubOrder - mPredictions)^2

      bonusPossibility <- simClubOrder == 1

      bonusNumber <- apply(
        X = bonusPossibility & (mPredictions == 1),
        MARGIN = 1,
        FUN = max
      )

      bonusScore <- -50 * t(bonusNumber)

      simPlayerScores[,i] <- rowSums(workingMisses) + bonusScore
    }

    colnames(simPlayerScores) <- t(names1)

    simPlayerRanks <- data.frame(
      t(
        apply(simPlayerScores, 1, rank, ties.method='min')
      )
    )

    return(simPlayerRanks)

    }

  }