ForwardOption.hs

module QuantLib.Example.ForwardOption
  (
    Result(..)
  , run
  ) where

import Data.Time.Calendar

import QuantLib.Instrument
import QuantLib.InterestRate
import QuantLib.Instrument.Option
import QuantLib.Math
import QuantLib.PricingEngine
import QuantLib.Process
import QuantLib.Quote
import QuantLib.Context
import QuantLib.Time.Calendar
import QuantLib.Time.Date
import QuantLib.Time.Schedule
import QuantLib.TermStructure.Volatility
import QuantLib.TermStructure.Yield

-- | Forward-starting (\"cliquet-style\") vanilla options, reproducing
-- QuantLib's own @forwardoption.cpp@ @testValues@ golden case (Haug,
-- \"Option pricing formulas\", p.37\/VBA code): moneyness 1.1, spot 60,
-- dividend yield 4%, risk-free rate 8%, reset in 0.25y, maturity in 1y,
-- 30% vol; expected NPV 4.4064 (call) \/ 8.2971 (put) under
-- 'forwardEuropeanEngine' (the @AnalyticEuropeanEngine@ instantiation of
-- @ForwardVanillaEngine\<Engine\>@). The other 5 forward-starting engines
-- added alongside it are exercised as self-consistency checks against this
-- reference: the finite-differences and Monte Carlo European forward
-- engines should reproduce the same (European-exercise) price; the two
-- American approximation engines, priced on an otherwise identical
-- American-exercise instrument, should be at least as valuable as the
-- European price (the right to exercise early is never a disadvantage);
-- and the Heston forward engine, with its process parameters chosen so
-- Heston degenerates to (near-)deterministic Black-Scholes volatility,
-- should reproduce the same price as the BS analytic engine.
data Result = Result
  { europeanCallR :: Double
  , europeanPutR :: Double
  , fdEuropeanR :: Double
  , mcEuropeanR :: Double
  , hestonEuropeanR :: Double
  , bawAmericanR :: Double
  , bjsAmericanR :: Double
  }

run :: IO Result
run = do
  setEvaluationDate $ Just evalDate
  dc <- dayCounter (Actual360 False)
  spotQ <- simpleQuote spot
  qQ <- simpleQuote divYield
  rQ <- simpleQuote riskFreeRate
  qTS <- flatForward (ReferenceDate evalDate) qQ dc Continuous Annual
  rTS <- flatForward (ReferenceDate evalDate) rQ dc Continuous Annual
  volQ <- simpleQuote vol
  volTS <- calendar TARGET >>= \cal -> blackConstantVol (CalendarReferenceDate evalDate) cal volQ dc
  bsmProc <- blackScholesMertonProcess spotQ qTS rTS volTS EulerDiscretization False

  let payoff t = PlainVanilla $ PlainVanillaPayoff t 0.0
      europeanExercise = European $ EuropeanExercise maturity
      americanExercise = American Nothing maturity False

  callOpt <- forwardVanillaOption moneyness resetDate (payoff Call) europeanExercise
  putOpt <- forwardVanillaOption moneyness resetDate (payoff Put) europeanExercise

  europeanEng <- forwardEuropeanEngine bsmProc
  QuantLib.Instrument.setPricingEngine callOpt europeanEng
  europeanCall <- npv callOpt
  QuantLib.Instrument.setPricingEngine putOpt europeanEng
  europeanPut <- npv putOpt

  fdEng <- forwardFdBlackScholesVanillaEngine bsmProc
  QuantLib.Instrument.setPricingEngine callOpt fdEng
  fdEuropean <- npv callOpt

  mcEng <- mcForwardEuropeanBsEngine LowDiscrepancy Statistics bsmProc (Just 1) Nothing False False (Just 32768) Nothing Nothing 0
  QuantLib.Instrument.setPricingEngine callOpt mcEng
  mcEuropean <- npv callOpt

  hestonProc <- hestonProcess rTS (Just qTS) spotQ (vol*vol) 1.0 (vol*vol) 0.3 0.0 QuadraticExponentialMartingale
  hestonEng <- analyticHestonForwardEuropeanEngine hestonProc 144
  QuantLib.Instrument.setPricingEngine callOpt hestonEng
  hestonEuropean <- npv callOpt

  americanOpt <- forwardVanillaOption moneyness resetDate (payoff Call) americanExercise
  bawEng <- forwardBaroneAdesiWhaleyEngine bsmProc
  QuantLib.Instrument.setPricingEngine americanOpt bawEng
  bawAmerican <- npv americanOpt

  bjsEng <- forwardBjerksundStenslandEngine bsmProc
  QuantLib.Instrument.setPricingEngine americanOpt bjsEng
  bjsAmerican <- npv americanOpt

  return Result
    { europeanCallR = europeanCall
    , europeanPutR = europeanPut
    , fdEuropeanR = fdEuropean
    , mcEuropeanR = mcEuropean
    , hestonEuropeanR = hestonEuropean
    , bawAmericanR = bawAmerican
    , bjsAmericanR = bjsAmerican
    }
  where
    evalDate = 1 `january` 2020
    moneyness = 1.1
    spot = 60
    divYield = 0.04
    riskFreeRate = 0.08
    vol = 0.30
    -- matches upstream's `timeEvalDates(t, 360) = lround(t * 360)`
    timeEvalDates t = round (t * 360.0)
    resetDate = addDays (timeEvalDates (0.25 :: Double)) evalDate
    maturity = addDays (timeEvalDates (1.0 :: Double)) evalDate

-- vim: set ft=haskell ff=unix ts=8 sts=2 sw=2 et: