# R/implied_odds.R In implied: Convert Between Bookmaker Odds and Probabilities

#### Documented in implied_odds

```# The functions xx_func_o(coef, probs) transforms proper probabilities (that sum to 1)
# into improper probabilities as a function of the input coeffient.
# The corresponding functions xx_o_solvefor(coef, probs, margin) are used
# with uniroot to find the coefficient that makes the transformed probabilities
# sum to the desired margin.

# Transform the probabilities using the Shin's method,
# for a given value of the odds ratio cc.
shin_func_o <- function(zz, probs, grossmargin=NULL){

# Eq. 5 in Shin 1993.
yy <- sqrt((zz*probs) + ((1-zz)*probs^2))
res <- yy * sum(yy)

if (!is.null(grossmargin)){
# Eq. 14 in in Fingleton & Waldron 1999
res <- res / (1 - grossmargin)
}

return(res)
}

# the condition that the sum of the probabilites must sum to 1.
# Used with uniroot.
shin_o_solvefor <- function(zz, probs, margin, grossmargin=NULL){
tmp <- shin_func_o(zz, probs, grossmargin)
sum(tmp) - (1 + margin)
}

# Transform the probabilities using the odds ratio method,
# for a given value of the odds ratio cc.
or_func_o <- function(cc, probs){
or_probs <- cc * probs
or_probs / (1 - probs + or_probs)
}

# The condition that the sum of the transformed probabilites
# must sum to 1 + margin.
or_o_solvefor <- function(cc, probs, margin){
tmp <- or_func_o(cc, probs)
sum(tmp) - (1 + margin)
}

# Transform the probabilities using the power method.
pwr_func_o <- function(nn, probs){
probs^(nn)
}

# The condition that the sum of the transformed probabilites
# must sum to 1 + margin.
pwr_o_solvefor <- function(nn, probs, margin){
tmp <- pwr_func_o(nn, probs)
sum(tmp) - (1 + margin)
}

#' Implied odds with added margin from probabilities.
#'
#' This functions converts probabilities to odds in decimal format, while adding overround.
#' The function does the inverse of what the function \code{\link{implied_probabilities}} does.
#'
#' @param probabilities A matrix or numeric of probabilities, where each column is an outcome.
#' @param method A string giving the method to use. Valid methods are 'basic', 'shin', 'bb', 'wpo', 'or', 'power' or 'additive'.
#' @param margin numeric. How large margin (aka overround) should be added to the probabilities.
#' @param grossmargin Numeric. Must be 0 or greater. See the details.
#' @param normalize Logical. If TRUE (default), scale the input probabilites to sum to 1.
#'
#' @return A named list. The first component is named 'odds' and contain a matrix of
#' implied odds. The second depends on the method used to compute the probabilities.
#'
#' @export
implied_odds <- function(probabilities, method = 'basic', margin = 0,
grossmargin = NULL, normalize=TRUE){

stopifnot(length(method) == 1,
length(margin) == 1,
tolower(method) %in% c('basic', 'shin', 'bb', 'wpo', 'or', 'power', 'additive'),
all(probabilities >= 0, na.rm=TRUE))

if (!is.matrix(probabilities)){

if ('data.frame' %in% class(probabilities)){
probabilities <- as.matrix(probabilities)
} else {
probabilities <- matrix(probabilities, nrow=1,
dimnames = list(NULL, names(probabilities)))
}
}

# Make sure the probabilities sum to exactly 1.
if (normalize){
probabilities  <- probabilities / rowSums(probabilities)
}

# Prepare the list that will be returned.
out <- vector(mode='list', length=1)
names(out) <- c('odds')

# Some useful quantities
n_probs <- nrow(probabilities)
n_outcomes <- ncol(probabilities)

# Missing values
missing_idx <- apply(probabilities, MARGIN = 1,
FUN = function(x) any(is.na(x)))

# inverted_probs <- 1 / probabilities

if (method == 'basic'){

out\$odds <- 1 / (probabilities * (1 + margin))

} else if (method == 'shin'){

odds <- matrix(nrow=n_probs, ncol=n_outcomes)
zz <- numeric(n_probs)

for (ii in 1:n_probs){

# Skip rows with missing values.
if (missing_idx[ii] == TRUE){
next
}

if (margin != 0){
res <- stats::uniroot(f=shin_o_solvefor, interval =  c(0, 0.4),
probs=probabilities[ii,],
margin = margin, grossmargin = grossmargin)
zz[ii] <- res\$root
} else {
zz[ii] <- 0
}

odds[ii,] <- 1 / shin_func_o(zz=zz[ii], probs = probabilities[ii,], grossmargin = grossmargin)
}

out\$odds <- odds
out\$zvalues <- zz

} else if (method == 'bb'){

if (is.null(grossmargin)){
grossmargin <- 0
} else {
stopifnot(grossmargin >= 0,
length(grossmargin) == 1)
}

zz <- (((1-grossmargin)*(1 + margin)) - 1) / (n_outcomes-1)
out\$odds <- 1 / ((1+margin) * (((probabilities*(1-zz)) + zz) / ((n_outcomes-1)*zz + 1)))

out\$zvalues <- zz

} else if (method == 'wpo'){
# Margin Weights Proportional to the Odds.
# Method from the Wisdom of the Crowds pdf.
invprob <- 1 / probabilities
out\$specific_margins <- (margin * invprob) / n_outcomes
out\$odds <- invprob / (1 + out\$specific_margins)

} else if (method == 'or'){

odds <- matrix(nrow=n_probs, ncol=n_outcomes)
odds_ratios <- numeric(n_probs)

for (ii in 1:n_probs){

# Skip rows with missing values.
if (missing_idx[ii] == TRUE){
next
}

if (margin != 0){
res <- stats::uniroot(f=or_o_solvefor, interval = c(0.05, 5),
probs=probabilities[ii,], margin = margin)
odds_ratios[ii] <- res\$root
} else {
odds_ratios[ii] <- 1
}

odds[ii,] <- 1 / or_func_o(cc=odds_ratios[ii], probs = probabilities[ii,])
}

out\$odds <- odds
out\$odds_ratios <- odds_ratios

} else if (method == 'power'){

odds <- matrix(nrow=n_probs, ncol=n_outcomes)
exponents <- numeric(n_probs)

for (ii in 1:n_probs){

# Skip rows with missing values.
if (missing_idx[ii] == TRUE){
next
}

if (margin != 0){
res <- stats::uniroot(f=pwr_o_solvefor, interval = c(0.0001, 1.1),
probs=probabilities[ii,], margin = margin)
exponents[ii] <- res\$root
} else {
exponents[ii] <- 1
}

odds[ii,] <- 1 / pwr_func_o(nn=exponents[ii], probs = probabilities[ii,])
}

out\$odds <- odds
out\$exponents <- exponents

} else if (method == 'additive'){

odds <- matrix(nrow=n_probs, ncol=n_outcomes)

for (ii in 1:n_probs){

# Skip rows with missing values.
if (missing_idx[ii] == TRUE){
next
}

odds[ii,] <- 1 / (probabilities[ii,] + (margin / n_outcomes))
}

out\$odds <- odds

}

# Make sure the matrix of implied probabilities has column names.
if (!is.null(colnames(probabilities))){
colnames(out\$odds) <- colnames(probabilities)
}

return(out)

}
```

## Try the implied package in your browser

Any scripts or data that you put into this service are public.

implied documentation built on June 9, 2022, 1:07 a.m.