R/black_scholes_iv.R

In shill1729/OptionPricer: An option pricer for European and American vanilla stock options

#' Back out Black-Scholes implied volatility
#'
#' @param fee the market price
#' @param spot the spot price of the underlying
#' @param strike the strike price of the option
#' @param maturity the maturity in trading years of the option contract
#' @param rate the discounting rate
#' @param div the dividend yield rate
#' @param what what type of option to price: "put" or "call"
#' @param style optionality style: american or european
#' @param N time-resolution
#' @param M space-resolution
#' @param lb lb for interval to search for root in IV
#' @param ub ub for interval to search for root in IV
#' 
#' @description {Root-finding scheme to back out Black-Scholes implied volatility for a given market price.}
#' @return numeric
#' @export black_scholes_iv
black_scholes_iv <- function(fee, spot, strike, maturity, rate, div, what, style, N, M, lb = 0.001, ub = 10)
{
  # If one price is passed
  if(length(fee) == 1)
  {
    z <- stats::uniroot(f = price_wrapper, 
                        interval = c(lb, ub), 
                        fee = fee, 
                        spot = spot, 
                        strike = strike, 
                        maturity = maturity, 
                        rate = rate, 
                        div = div, 
                        what = what, 
                        style = style, 
                        N = N, M = M
    )
    return(z$root)  
  } else if(length(fee) > 1)
  {
    if(length(fee) != length(strike))
    {
      stop("'fee' and 'strike' must have same lengths")
    }
    n <- length(fee)
    iv <- matrix(0, n)
    for(i in 1:n)
    {
      z <- stats::uniroot(f = price_wrapper, 
                          interval = c(lb, ub), 
                          fee = fee[i], 
                          spot = spot, 
                          strike = strike[i], 
                          maturity = maturity, 
                          rate = rate, 
                          div = div, 
                          what = what, 
                          style = style, 
                          N = N, M = M
      )
      iv[i] <- z$root
    }
    return(iv)
  }
  
}

#' Wrapper to GBM pricer
#' 
#' @param volat the volatility 
#' @param fee the market price
#' @param spot the spot price of the underlying
#' @param strike the strike price of the option
#' @param maturity the maturity in trading years of the option contract
#' @param rate the discounting rate
#' @param div the dividend yield rate
#' @param what what type of option to price: "put" or "call"
#' @param style optionality style: american or european
#' @param N time-resolution
#' @param M space-resolution
#' 
#' @description {Wrapper to \code{pde_gbm} to pass to \code{black_scholes_iv}. Not exported.}
#' @return numeric
price_wrapper <- function(volat, fee, spot, strike, maturity, rate, div, what, style, N, M)
{
  pde_gbm(spot, strike, maturity, rate, div, volat, what, style, "price", N, M)-fee
}