R/calibrate_kou.R

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

#' Calibrate the parameters of the Kou jump-diffusion model to market price
#'
#' @param initial_guess initial guess of parameters, see details
#' @param market market data, see details
#' @param spot the underlying spot price
#' @param maturity the option contract's maturity
#' @param rate the risk-neutral rate
#' @param div the dividend yield rate
#' @param ku the upward jump displacement
#' @param kd the downward jump displacement
#' @param what what option to price
#' @param style style of optionality: american or european
#' @param N time resolution
#' @param M space resolution
#' @param generate whether to immediately generate a set of model prices
#' @param bounds lower and upper bounds for parameters
#' 
#' @description {Calibrate the parameters of the Kou jump-diffusion model to market prices.}
#' @details {
#' This is just a simple wrapper to R's base \code{optim} function for minimizing/maximizing functions of several
#' parameters. We choose to fix the parameters: \code{rate}, \code{div}, \code{ku}, and \code{kd} and fit the model
#' based on the remaining parameters. Calibrations tend to fail for deep OTM and moderately ITM options and no input
#' handling is done in this function to prevent this, so it is up to the user to pass good data to this calibration routine.
#' The objective function to minimize is merely the mean-square error between the market prices and the model prices.
#' This is available explicitly as \code{meansq_price_error_kou}.
#' 
#' The input \code{initial_guess} should be a vector of 5 dimensions containing (not necessarily named)
#' \itemize{
#' \item \code{volat} the annual volatility level
#' \item \code{lambda} the mean rate of jumps per year
#' \item \code{prob} the probability of upward jumps
#' \item \code{alpha} the mean upward jump size
#' \item \code{beta} the mean downward jump size
#' }
#' 
#' The input \code{bounds} should be a list containing, which may be set to NULL for default bounds 
#' \itemize{
#' \item \code{lower} the lower bounds of the parameters to calibrate
#' \item \code{upper} the upper bounds of the parameters to calibrate}
#' 
#' The input \code{market} should be a data.frame containing
#' \itemize{
#' \item \code{strike} the strike price
#' \item \code{fee} the market price}
#' }
#' @return Either a list from \code{optim} or a list containing
#' \itemize{
#' \item \code{market} a list containing \code{strike}, \code{fee} and \code{model}
#' \item \code{fit} the object returned from \code{optim}}
#' @export calibrate_kou
calibrate_kou <- function(initial_guess, market, spot, maturity, rate, div, ku, kd, what, style, N, M, generate = FALSE, bounds = NULL)
{
  if(is.null(bounds))
  {
    lower <- c(0.01, 0, 0.01, ku+0.01, abs(kd)+0.01)
    upper <- c(10, 90, 1, 1, 0.5)
  } else{
    lower <- bounds$lower
    upper <- bounds$upper  
  }
  
  #==============================================================================================================
  # 2. Calibration function
  #==============================================================================================================
  print("Calibrating model to market")
  price_fit <- stats::optim(par = initial_guess,
                     fn = meansq_price_error_kou,
                     K = market$strike,
                     fees = market$fee,
                     spot = spot,
                     maturity = maturity,
                     rate = rate,
                     div = div,
                     ku = ku,
                     kd = kd,
                     what = what,
                     style = style,
                     N = N,
                     M = M,
                     method = "L-BFGS-B",
                     lower = lower,
                     upper = upper,
                     control = list(trace = 5)
  )
  if(generate)
  {
    #==============================================================================================================
    # 3. Generate model prices with calibrated parameter set
    #==============================================================================================================
    print("Generating model output with calibrated parameters")
    result <- lapply(market$strike, function(x) pide_kou(spot, x, maturity, c(rate, div, price_fit$par, ku, kd), what, style, "price", N, M, L = M/2+1))
    market$model <- round(unlist(result), 5)
    #==============================================================================================================
    # 4. Plot and compare market prices to model prices
    #==============================================================================================================
    graphics::par(mfrow = c(1, 1))
    graphics::plot(market$strike, market$fee, main = "Market vs Model prices")
    graphics::lines(market$strike, market$model, col = "blue", lty = "dashed")
    return(list(market = market, fit = price_fit))
  } else{
    # Return result from optim
    return(price_fit)
  }
}