R/sample_path.R

In shill1729/FeynmanKacSolver: Feynman-Kac PDE solver for Ito diffusions and processes

#' Simulate Ito-Levy process by model name and parameters
#'
#' @param t terminal time
#' @param n number of nodes-1
#' @param continuous.model "gbm" or "lvm"
#' @param jump.model "kou", "norm", or "unif"
#' @param parameters parameter list depending on models, see details
#' @param IC list of initial conditions, model dependent, see details
#'
#' @description {Simulate stock prices under either the real or the risk-neutral measure for a combination of jump-diffusion models, including geometric Brownian motion, local volatility Gaussian mixtures,
#' for the continuous-diffusion part, and the double exponential Kou model, the Merton normal jump-diffusion model, and uniformly distributed jumps for the
#' discontinuous jump part. See details for specifics on \code{parameters}.}
#' @details {The \code{parameters} list may be empty if \code{continuous.model} is specified as any of "bm", "pbm", "sbm" without jump-dynamics. If
#' jump dynamics are present then one must specifiy \code{lambda} as a function of \code{(x,t)} describing the mean rate of arrivals of jumps.
#' For \code{continuous.model == "gbm"} \code{parameters} should additionally contain
#' \itemize{
#' \item \code{mu} the annual mean return of the stock in the geometric Brownian motion model for stock prices
#' \item \code{volat} the annual volatility of the stock in the geometric Brownian motion model for stock prices}
#' for \code{continuous.model = "lvm"}, \code{parameters} should additionally contain
#' \itemize{
#' \item \code{probs} the vector of probabilities for each mixture component
#' \item \code{mus} the vector of annual mean-returns for each mixture component
#' \item \code{sigmas} the vector of annual volatilitys for each mixture component}
#' for \code{continuous.model == "vasicek"} (or equally "cir") \code{parameters} should additionally contain
#' \itemize{
#' \item \code{theta} the speed of mean-reversion to the long-term mean level
#' \item \code{mu} the long-term mean level of the short-rate
#' \item \code{volat} the annual volatility of the short-rate}
#' for \code{jump.model = "kou"}, \code{parameters} should additionally contain
#' \itemize{
#' \item \code{p} the probability of positive jump
#' \item \code{alpha} the inverse of the mean size of positive jumps
#' \item \code{beta} the inverse of the mean size of negative jumps}
#' for \code{jump.model = "dkou"}, \code{parameters} should additionally contain
#' \itemize{
#' \item \code{p} the probability of positive jump
#' \item \code{alpha} the inverse of the mean size of positive jumps
#' \item \code{beta} the inverse of the mean size of negative jumps
#' \item \code{ku} the displacement of upward jumps from the origin
#' \item \code{kd} the displacement of downward jumps from the origin}
#' for \code{jump.model = "runif"} \code{parameters} should additionally contain
#' \itemize{
#' \item \code{min} the smallest possible jump size
#' \item \code{max} the largest possible jump size}
#' and finally for \code{jump.model = "norm"} \code{parameters} should additionally contain
#' \itemize{
#' \item \code{mean} the mean jump-size
#' \item \code{sd} the volatility of the jump-size}
#' }
#' @return data.frame
#' @export sample_path
sample_path <- function(t, n = 5000, continuous.model, jump.model = NULL, parameters = NULL, IC = NULL)
{
  if(!is.null(jump.model))
  {
    if(!"lambda" %in% names(parameters))
    {
      stop("Need to pass mean-rate function 'lambda' in list 'parameters' when 'jump.model' is specified")
    }
    # Missing input error handling for jump-parameters
    if(jump.model == "kou")
    {
      if(!all(c("p", "alpha", "beta") %in% names(parameters)))
      {
        stop("'parameters' must contain 'p', 'alpha', and 'beta' for 'kou' jump-model")
      }
    } else if(jump.model == "unif")
    {
      if(!all(c("min", "max") %in% names(parameters)))
      {
        stop("'parameters' must contain 'min' and 'max' for 'unif' jump-model")
      }
    } else if(jump.model == "norm")
    {
      if(!all(c("mean", "sd") %in% names(parameters)))
      {
        stop("'parameters' must contain 'mean' and 'sd' for 'norm' jump-model")
      }
    } else if(jump.model == "dkou")
    {
      if(!all(c("p", "alpha", "beta") %in% names(parameters)))
      {
        stop("'parameters' must contain 'p', 'alpha', 'beta', 'ku', and 'kd' for 'dkou' jump-model")
      }
    }
    # Assign jump parameters
    switch (jump.model,
            kou = param <- list(p = parameters$p, alpha = parameters$alpha, beta = parameters$beta),
            unif = param <- list(min = parameters$min, max = parameters$max),
            norm = param <- list(mean = parameters$mean, sd = parameters$sd),
            dkou = param <- list(p = parameters$p, alpha = parameters$alpha, beta = parameters$beta, ku = parameters$ku, kd = parameters$kd)
    )
    # Jump-size component definitions
    jumps <- list(distr = jump.model,
                  param = param
    )
  } else{
    jumps <- NULL
  }
  sample_path_function <- paste("sample_path_", continuous.model, sep ="")
  do.call(what = sample_path_function, args = list(t = t, IC = IC, parameters = parameters, jumps = jumps, n = n))
}