R/EUcall.R

In gaspardcc/jumpyMerton:

#' Pricing an european call - Merton & Black-Scholes
#' 
#' @author elh

EUcall <- setClass(
  "EUcall",
  
  slots = c(
    price = "numeric",
    ic = "numeric",
    logStrike = "numeric",
    maturity = "numeric"
  ),
  
  prototype = list(
    logStrike = 0.1,
    maturity = 1,
    N = 2^8
  ),
  
  validity=function(object)
  {
    return(TRUE)
  }
)

setGeneric(
  name = "price",
  def = function(this, model)
  {
    standardGeneric("price")
  }
)

setMethod(
  f = "price",
  signature = c("EUcall", "BlackScholes"),
  definition = function(this, model)
  {
    dplus  <- d1(model, this@logStrike, this@maturity)
    dminus <- d2(model, this@logStrike, this@maturity)
  
    this@price = bs@spot * pnorm(dplus) + exp(this@logStrike - model@drift*this@maturity) * pnorm(dminus)
    return(this)
  }
)

setMethod(
  f = "price",
  signature = c("EUcall", "Merton"),
  definition = function(this, model)
  {
    # stop("not yet implemented")
    N=2^8
    L=1000
    # Find optimal volatility for the BlackScholes
    
    
    # In the meantime, suggested values are used
    if(!exists("bs"))
    {
      bs <<- BlackScholes()
      bs@volatility <- 0.2
      bs@drift <- 0
      bs@spot <-model@spot
    }
    
    v <- seq(from = -L/2, to = L/2, by = L/(N-1))
    weight <- rep(c(1/3, 4/3, 2/3), N/3)
    
    zeta_ <- vector("numeric", N)
    for(m in 1:N)
      zeta_[m] <- zeta(this, bs, model, v[m])
    
    coef <- weight * exp(-complex(real=0, imaginary=1)*this@logStrike*v)
    Z <- L*(zeta_ %*% coef)/(2*pi*(N-1))
    
    this@price <- Re(Z[1]) + price(this, bs)@price
    return(this)
  }
)