R/wagers.R

In shill1729/KellyCriterion: Log-optimal stock allocation

#' Kelly fraction for arbitrary binary (non-random) payoffs
#'
#' @param p the probability of winning
#' @param a the amount won on top of the wager
#' @param b the wager lost
#'
#' @description {The classical Kelly criterion formula for Bernoulli bets of arbitrary odds.}
#' @description {The formula is well known, i.e. on wikipedia.}
#' @return numeric
#' @export kelly_binary
kelly_binary <- function(p, a, b)
{
  p/b-(1-p)/a
}

#' Kelly fraction for moneyline bets
#'
#' @param p true probability of favorite winning
#' @param a winnings if favorite wins
#' @param b wager to throw down for favorite \eqn{-b}
#' @param u winnings if underdog wins \eqn{+u}
#' @param v wager to throw down for underdog
#'
#' @description {A Kelly-criterion for a bet on two wagers for favorite
#' vs underdog team to win.}
#' @return numeric
#' @export kelly_moneyline
kelly_moneyline <- function(p, a, b, u, v)
{
  region_check <- (v-1)*(u+b)/((1+u)*(a+v))
  if(region_check >= 1)
  {
    stop("Feasible region DNE")
  }
  x <- ((1+u)*(a+v)*p-(1-v)*(b+u)*(1-p))/((b+u)*(a+v))
  return(x)
}

#' Growth rate for Kelly fraction for arbitrary binary (non-random) payoffs
#'
#' @param a the amount won on top of the wager
#' @param b the wager lost
#' @param p the probability of winning
#'
#' @description {The growth rate or entropy of the Kelly strategy}
#' @description {The average log wealth at the optimal strategy.}
#' @return numeric
#' @export entropy_binary
entropy_binary <- function(a, b, p)
{
  p*log(p)+(1-p)*log(1-p)+log(a+b)+p*log(a/b)-log(a)
}

#' Entropy-growth for log-optimal moneyline bets
#'
#' @param p true probability of favorite winning
#' @param a winnings if favorite wins
#' @param b wager to throw down for favorite \eqn{-b}
#' @param u winnings if underdog wins \eqn{+u}
#' @param v wager to throw down for underdog
#'
#' @description {The entropy-growth for the log-optimal bet on two wagers for favorite
#' vs underdog team to win.}
#' @return numeric
#' @export entropy_moneyline
entropy_moneyline <- function(p, a, b, u, v)
{
  x <- kelly_moneyline(p, a, b, u, v)
  p*log(1+(a+v)*x-v)+(1-p)*log(1+u-(b+u)*x)
}