R/utils.R

In niallbenj/footballstats: Classify and predict football results

#' @title Sensitive Keys
#'
#' @description A function that loads all sensitive information into a
#'  global namespace for use throughout the code.
#'
#' @param printToSlack A boolean on whether results should be returned
#'  to slack or not.
#' @param printToScreen A boolean on whether results should be printed
#'  to screen or sink file or not.
#' @param testing A boolean to indicate whether tests are being run,
#'  so that preloaded data sets are used and API endpoints are generally
#'  avoided to test functionality rather than the endpoints.
#' @param storePred A boolean to indicate whether to store predicted
#'  results in the prediction hash in redis.
#'
#' @return Returns a list of KEYS used by most functionality of \code{footballstats}.
#'
#' @export


sensitive_keys <- function(printToSlack, printToScreen, testing, storePred) {  # nocov start
  cat(paste0(Sys.time(), ' | Loading global environment variables... \n'))
  fsHost <- Sys.getenv("FS_HOST")
  fsApikey <- Sys.getenv("FS_APIKEY")
  fsSlack <- Sys.getenv("FS_SLACK")
  prof <- footballstats::possible_env()

  if (c(fsHost, fsApikey, fsSlack) %>% nchar %>% `<`(1) %>% any) {
    stop(
      paste0(
        'Halting - please set environment variables for `FS_HOST`, `FS_APIKEY`, and `FS_SLACK`.',
        '\n Possible locations include :: \n ',
        paste(' -->', prof, collapse = '\n '),
        '\n\n Current values are : \n',
        paste0('FS_HOST = ', fsHost, '\n'),
        paste0('FS_APIKEY = ', fsApikey, '\n'),
        paste0('FS_SLACK = ', fsSlack, '\n')
      )
    )
  } else {
    return(
      list(
        FS_HOST = fsHost,
        FS_APIKEY = fsApikey,
        FS_SLACK = fsSlack,
        SLACK_PRNT = printToSlack,
        TEST = testing,
        LOGGING = printToScreen,
        LOG_PRED = storePred,
        RED = redux::hiredis(db = 1),
        PIPE = redux::redis,
        XG_BOUND = 6,
        DAYS = 3,
        PARAM_GPOINTS = 10,
        PARAM_GBOUNDARY = 0.2,
        PARAM_DECAY = 5000,
        PARAM_TOTALPER = 0.5
      )
    )
  }
}  # nocov end

#' @title Possible Environment
#'
#' @description A function that searches typical R global
#'  environment locations, to try and read the values
#'  defining the API and other sensitive data.
#'
#' @return A character string of R global environment location paths.
#'
#' @export


possible_env <- function() {  # nocov start
  return(
    Filter(
      f = function(f) nchar(f) > 0,
      x = c(
        Sys.getenv("R_PROFILE"),
        file.path(Sys.getenv("R_HOME"), "etc", "Rprofile.site"),
        Sys.getenv("R_PROFILE_USER"),
        file.path(getwd(), ".Rprofile")
      )
    )
  )
} # nocov end

#' @title API Date Formatter
#'
#' @description A function that takes a date as generated by R
#'  and produces a date format used by the API.
#'
#' @param standardDateFormat A \code{Sys.Date()} value.
#'
#' @return An API style date which is of the form dd.mm.yyyy
#'
#' @export


format_dates <- function(standardDateFormat) {

  dmy <- c('%d', '%m', '%y') %>%
    sapply(function(x) standardDateFormat %>% format(x)) %>%
    as.character

  return(paste0(dmy[1], '.', dmy[2], '.20', dmy[3]))
}

#' @title Start Season
#'
#' @description A function that tries to guess what the season value
#'  is based on the month of the year, assuming that matches are
#'  complete by month 7, so if the month is 8 and the year is 2020,
#'  then the season is 2020/2021. However if the month is 1 and the year
#'  is 2021 then the season is still 2020/2021.
#'
#' @return A character string of the form yyyy.
#'
#' @export


start_season <- function() {
  frm <- function(f) Sys.Date() %>% format(f) %>% as.integer
  currentSeason <- frm("%Y")
  return(if (frm("%m") >= 7) currentSeason else currentSeason - 1)
}

#' @title Check Request Limit
#'
#' @description A function that stores the number of requests made to the
#'  API within a given time period. If the limit is reached then the code
#'  will stall until requests are free to query the API again successfully.
#'  The API is constrained to 1000 request per hour (default), or
#'  x calls per t time. So this function is checked each time before an
#'  endpoint is hit and waits a given time if no requests are remaining.
#'
#' @details Redis Keys used;
#'   \itemize{
#'     \item{\strong{[KEY]} :: \code{requestLimit}}
#'   }
#'
#' @param requestsAllowed An integer value that defines the number of requests
#'  that can be made in a given time period (Default = 1000).
#' @param timePeriod An integer value in seconds that defines the time period
#'  where `requestsAllowed` API calls are allowed (Default = 60 * 60).
#'
#' @return Nothing. Redis is updated with the correct requestLimit values.
#'
#' @export


request_limit <- function(KEYS, requestsAllowed = 1000, timePeriod = 60 * 60) {

  # Increment by 1, and also create the key
  requestCount <- "requestLimit" %>%
    KEYS$RED$INCR()

  if (requestCount == 1) {
    "requestLimit" %>%
      KEYS$RED$EXPIRE(timePeriod - 1)
  } else {
    if (requestCount > requestsAllowed - 100) {
      cat(paste0(' { requests low. Sleeping for ', timePeriod, ' seconds. } '))
      "requestLimit" %>%
        KEYS$RED$SET(value = 0)
      Sys.sleep(timePeriod)
    }
  }
}

#' @title Redis Connection
#'
#' @description A function that checks to see if the
#'  redis connection exists, if not then a new connection is
#'  set up on the supplied db input value (Default = 1).
#'
#' @param db An integer value that defines which DB should
#'  be accessed in redis.
#'
#' @return Nothing. A redis connection is established which
#'  is accessible through the \code{rredis::} set of commands.
#'
#' @export


redis_con <- function(db = 1) { # nocov start
  tryCatch({
    rredis::redisCmd('PING')
  }, error = function(e) {
    rredis::redisConnect(
      host = 'localhost',
      port = 6379,
      nodelay = FALSE
    )
    blnk <- utils::capture.output(rredis::redisSelect(db))
    cat(paste0(Sys.time(), ' | Redis Connection established. \n'))
  })
} # nocov end

#' @title Allowed Competitions
#'
#' @description A lot of the competitions from the API
#'  are not accessible, or only provide minimal data. To avoid
#'  issues when running the code, so complete data sets are used,
#'  this provides a list of complete competitions.
#'
#' @return A character vector of competition IDs defined by the API.
#'
#' @export


allowed_comps <- function() { # nocov start
  return(
    c('1204', '1205', '1221', '1229', '1269', '1352', '1425', '1399', '1457')
  )
} # nocov end


#' @title Teams in league
#'
#' @description To normalise some of the data we need to know how
#'  many teams are present within each league.
#'
#' @return A list of matching competition ids and team numbers
#'
#' @export


teams_in_league <- function(compID) { # nocov start
  allLeagues <- list(
    id = c('1204', '1205', '1221', '1229', '1269', '1352', '1425', '1399', '1457'),
    teams = c(20, 24, 20, 18, 20, 18, 18, 20, 20)
  )
  return(allLeagues$teams[allLeagues$id %>% `==`(compID) %>% which])
} # nocov end

#' @title Create Sink
#'
#' @description A function that creates a log file that
#'  gets written to when the \code{footballstats} code
#'  is running, either gathering data or predicting results.
#'
#' @param fName A character string that defines the type of
#'  log file to create - it will be appended by the date it
#'  is being run, i.e. this should only be called from the
#'  deployed functions.
#'
#' @return Nothing. A log file to write to is set up.
#'
#' @export


create_sink <- function(fName) { # nocov start
  fName %<>%
    paste0('_', Sys.Date() %>% format('%d-%m-%y'), '.log')

  # Create the file
  logFile <- file(
    description = paste0('/root/logs/', fName),
    open = "wt"
  )

  # Create the sink
  logFile %>% sink()
} # nocov end

#' @title Create Log Directory
#'
#' @description A function that checks for the global enviornment
#'  variable \code{FS_DEPLOYLOC}, if it exists then it creates a
#'  log directory structure at \code{FS_DEPLOYLOC/logs/}.
#'
#' @return Nothing, a log directory is created.
#'
#' @export


create_log_dir <- function() { # nocov start
  # Check the log path global R environment variable
  cat(' ## Reading log path from global variable ... ')
  logPath <- Sys.getenv('FS_DEPLOYLOC')
  if (logPath %>% `==`('')) {
    cat('error. \n')
    stop(
      'Cannot find `FS_DEPLOYLOC`, \n check : \n\n',
      paste(footballstats::possible_env(), collapse = '\n ')
    )
  }
  cat('complete. \n')

  # Create the log path if it doesn't exist already
  logPath <- paste0(logPath, 'logs/')
  if (!dir.exists(logPath)) {
    cat(paste0(' ## Creating log path @ ', logPath, ' \n'))
    dir.create(
      path = logPath,
      recursive = TRUE,
      showWarnings = FALSE
    )
  } else {
    cat(paste0(' ## Log path exists already @ ', logPath, ' \n'))
  }
} # nocov end