hasquant-0.7.0.0: test/hspec/QuantLib/Spec/TermStructure.hs
{-# LANGUAGE ScopedTypeVariables, OverloadedLists #-}
module QuantLib.Spec.TermStructure (spec) where
import Control.Monad(replicateM, forM_)
import Test.Hspec hiding(before, after)
import Test.Hspec.QuickCheck(prop)
import Test.QuickCheck.Monadic as Q(monadicIO, run)
import Test.QuickCheck((==>))
import Data.Time.Calendar
import Data.Maybe(catMaybes)
import Data.List.NonEmpty(NonEmpty, fromList)
import qualified Data.Vector.Storable as V
import QuantLib.Time.Date
import qualified QuantLib.Context as Context
import QuantLib.Time.Calendar as Calendar
import QuantLib.Time.Schedule hiding(dates)
import qualified QuantLib.InterestRate as IR
import qualified QuantLib.Quote as Quote
import QuantLib.TermStructure.Yield
import QuantLib.TermStructure hiding(maxDate)
import QuantLib.Math
import QuantLib.Index(addFixing)
import QuantLib.Index.InterestRate(iborIndex, IborConstructor(..), overnightIborIndex, OvernightIborIndexType(Sofr), liborSwapIndex, LiborSwapIndexType(EurLiborSwapIsdaFixA))
import QuantLib.Model(hullWhite, extendedCoxIngersollRoss, discountBond, asAffineModel, hestonModel, params)
import QuantLib.Currency(currency, Ccy(..))
import QuantLib.Instrument(npv, setPricingEngine, SettlementType(Physical), SettlementMethod(PhysicalOTC), PositionType(Long), additionalResults, AdditionalResultVal(..))
import QuantLib.Instrument.Swap(vanillaSwap, swap, makeVanillaSwap, SwapType(Payer), swaption)
import qualified QuantLib.Instrument.Swap as Swap
import qualified QuantLib.Instrument.Bond as Bond
import QuantLib.Instrument.CapFloor(cap)
import QuantLib.CashFlow(iborLeg, RateAveragingType(..))
import QuantLib.Instrument.Option(vanillaOption, EuropeanExercise(..), PlainVanillaPayoff(..), Exercise(European, American), StrikedPayoff(PlainVanilla), OptionType(Call, Put))
import qualified QuantLib.Instrument.Forward as Fwd
import QuantLib.Process(blackScholesMertonProcess, ProcessDiscretization(EulerDiscretization), hestonProcess, HestonProcessDiscretization(..))
import qualified QuantLib.TermStructure.Volatility as Vol
import QuantLib.PricingEngine(discountingSwapEngine, analyticEuropeanEngine, blackSwaptionEngineFromVolatilityStructure, blackCapFloorEngineFromVolatilityStructure, bachelierSwaptionEngineFromVolatilityStructure, bachelierCapFloorEngineFromVolatilityStructure, bjerksundStenslandApproximationEngine, analyticHestonEngine, IntegrationControl(..), fdHestonVanillaEngine)
import QuantLib.Spec.Helpers(areClose, closePrec)
spec :: Spec
spec = do
describe "Quote value" $ do
prop "quote value" $
\val ->
val > 0
==> monadicIO $ do run $ (Quote.simpleQuote val >>= \q -> Quote.value q) `shouldReturn` val
describe "yield term structure" $ do
let setup :: IO (Calendar, Word, YieldTermStructure)
setup = do
let settlementDays = 2
depositData = [
( 1, Months, 4.581),
( 2, Months, 4.573 ),
( 3, Months, 4.557 ),
( 6, Months, 4.496 ),
( 9, Months, 4.490 )]
swapData = [
( 1, Years, 4.54 ),
( 5, Years, 4.99 ),
(10, Years, 5.47 ),
(20, Years, 5.89 ),
(30, Years, 5.96 )]
cal <- calendar TARGET
d <- today
today' <- adjust cal d Following
Context.setEvaluationDate (Just today')
settlement <- advance cal today' (fromIntegral settlementDays, Days) Following False
actual360dc <- dayCounter (Actual360 False)
deposits <- mapM
(\(n, u, r) -> do
q <- Quote.simpleQuote (r/100)
depositRateHelper q (n, u) settlementDays cal ModifiedFollowing True actual360dc)
depositData
ccy <- currency EUR
thirty360dc <- dayCounter Thirty360BondBasis
index <- iborIndex (Ibor "dummy" (6, Months) settlementDays ccy cal ModifiedFollowing False actual360dc) Nothing
swaps <- mapM
(\(n, u, r) -> do
q <- Quote.simpleQuote (r/100)
swapRateHelperFromConventions q (n, u) cal Annual Unadjusted thirty360dc index Nothing (0, Days) Nothing
Nothing LastRelevantDate Nothing False Nothing Nothing Nothing >>= asRateHelper)
swapData
ts <- piecewiseYieldCurve (ReferenceDate settlement) (fromList (deposits ++ swaps)) actual360dc [] (Iterative Discount LogLinear defaultIterativeBootstrapOpts) False
return (cal, settlementDays, ts)
it "referenceChange" $ Context.keepingSettingsGc $ do
let ds = [10, 30, 60, 120, 360, 720]
(_calendar, settlementDays, _ts) <- setup
flatRate <- Quote.simpleQuote 0.03
cal <- calendar Null
actual360dc <- dayCounter (Actual360 False)
ts <- flatForward (SettlementDays settlementDays cal) flatRate actual360dc IR.Continuous Annual
td <- Context.evaluationDate
expected <- mapM (\d -> discount ts (DatePoint (addDays d td)) False) ds
Context.setEvaluationDate (Just $ addDays 30 td)
calculated <- mapM (\d -> discount ts (DatePoint (addDays (30+d) td)) False) ds
mapM_ (\(x1, x2) -> x1 `shouldSatisfy` areClose x2) (zip expected calculated)
it "controls extrapolation through the common term-structure interface" $ do
flatRate <- Quote.simpleQuote 0.03
dc <- dayCounter (Actual360 False)
ts <- flatForward (ReferenceDate (fromGregorian 2025 1 2)) flatRate dc IR.Continuous Annual
allowsExtrapolation ts `shouldReturn` False
setExtrapolation ts True
allowsExtrapolation ts `shouldReturn` True
setExtrapolation ts False
allowsExtrapolation ts `shouldReturn` False
it "converts a date to a time using the term structure's day counter" $ do
let refDate = fromGregorian 2025 1 2
queryDate = addGregorianYearsClip 1 refDate
flatRate <- Quote.simpleQuote 0.03
dc <- dayCounter Actual365FixedStandard
ts <- flatForward (ReferenceDate refDate) flatRate dc IR.Continuous Annual
expected <- yearFraction dc refDate queryDate Nothing Nothing
timeFromReference ts queryDate `shouldReturn` expected
it "dispatches yield rates across date and time coordinates" $ do
let refDate = fromGregorian 2025 1 2
endDate = addGregorianYearsClip 1 refDate
expected = 0.03
tolerance = 1.0e-6 * expected
flatRate <- Quote.simpleQuote expected
dc <- dayCounter Actual365FixedStandard
ts <- flatForward (ReferenceDate refDate) flatRate dc IR.Continuous Annual
zeroAtDate <- IR.rate <$> zeroRate ts (RateAtDate endDate dc) IR.Continuous NoFrequency False
zeroAtTime <- IR.rate <$> zeroRate ts (RateAtTime 1.0) IR.Continuous NoFrequency False
forwardBetweenDates <- IR.rate <$> forwardRate ts refDate endDate dc IR.Continuous NoFrequency False
forwardBetweenTimes <- IR.rate <$> forwardRateBetweenTimes ts 0.0 1.0 IR.Continuous NoFrequency False
let results :: [Double]
results = [zeroAtDate, zeroAtTime, forwardBetweenDates, forwardBetweenTimes]
mapM_ (`shouldSatisfy` closePrec expected tolerance) results
-- The day counter is the caller's, not the curve's: the same compound factor over the same
-- interval reports a different rate under Actual360.
act360 <- dayCounter (Actual360 False)
forwardAct360 <- IR.rate <$> forwardRate ts refDate endDate act360 IR.Continuous NoFrequency False
forwardAct360 `shouldSatisfy` closePrec (expected * 360 / 365) tolerance
it "implied" $
Context.keepingSettingsGc $ do
(cal, settlementDays, ts) <- setup
td <- Context.evaluationDate
let newToday = addGregorianYearsClip 3 td
newSettlement <- advance cal newToday (fromIntegral settlementDays, Days) Following False
let testDate = addGregorianYearsClip 5 newSettlement
implied <- impliedTermStructure ts newSettlement
baseDiscount <- discount ts (DatePoint newSettlement) False
dsc <- discount ts (DatePoint testDate) False
impliedDiscount <- discount implied (DatePoint testDate) False
(dsc - baseDiscount * impliedDiscount) `shouldSatisfy` (<= 1.0e-10)
it "fwd spreaded" $
Context.keepingSettingsGc $ do
(_calendar, _settlementDays, ts) <- setup
me <- Quote.simpleQuote 0.01
val <- Quote.value me
spreaded <- forwardSpreadedTermStructure ts me
refDate <- asTermStructure ts >>= referenceDate
let testDate = addGregorianYearsClip 5 refDate
actual360dc <- dayCounter (Actual360 False)
forward <- IR.rate <$> forwardRate ts testDate testDate actual360dc IR.Continuous NoFrequency False
spreadedForward <- IR.rate <$> forwardRate spreaded testDate testDate actual360dc IR.Continuous NoFrequency False
(forward - (spreadedForward - val)) `shouldSatisfy` (<= 1.0e-10)
it "z-spreaded" $
Context.keepingSettingsGc $ do
(_calendar, _settlementDays, ts) <- setup
q <- Quote.simpleQuote 0.01
val <- Quote.value q
actual360dc <- dayCounter (Actual360 False)
spreaded <- zeroSpreadedTermStructure ts q IR.Continuous NoFrequency
refDate <- asTermStructure ts >>= referenceDate
let testDate = addGregorianYearsClip 5 refDate
zero <- IR.rate <$> zeroRate ts (RateAtDate testDate actual360dc) IR.Continuous NoFrequency False
spreadedZero <- IR.rate <$> zeroRate spreaded (RateAtDate testDate actual360dc) IR.Continuous NoFrequency False
(zero - (spreadedZero - val)) `shouldSatisfy` (<= 1.0e-10)
it "composite zero yield" $
Context.keepingSettingsGc $ do
let refDate = 11 `december` 2012
queryDate = addGregorianYearsClip 5 refDate
Context.setEvaluationDate (Just refDate)
dc <- dayCounter Actual365FixedStandard
q1 <- Quote.simpleQuote 0.03
q2 <- Quote.simpleQuote 0.01
c1 <- flatForward (ReferenceDate refDate) q1 dc IR.Continuous NoFrequency
c2 <- flatForward (ReferenceDate refDate) q2 dc IR.Continuous NoFrequency
withCompositeZeroYieldStructure (-) c1 c2 IR.Continuous NoFrequency $ \composite -> do
initial <- IR.rate <$> zeroRate composite (RateAtDate queryDate dc) IR.Continuous NoFrequency False
_ <- Quote.setValue q1 0.04
updated <- IR.rate <$> zeroRate composite (RateAtDate queryDate dc) IR.Continuous NoFrequency False
initial `shouldSatisfy` closePrec 0.02 (1.0e-6 * 0.02)
updated `shouldSatisfy` closePrec 0.03 (1.0e-6 * 0.03)
-- Same spread value at two nodes bracketing the query date: with 'Linear' interpolation
-- of the (piecewise-bootstrapped) spread, the spread at any date between them equals that
-- common value, so this reduces to the same check as 'zeroSpreadedTermStructure' above.
it "piecewise z-spreaded" $
Context.keepingSettingsGc $ do
(_calendar, _settlementDays, ts) <- setup
q <- Quote.simpleQuote 0.01
val <- Quote.value q
refDate <- asTermStructure ts >>= referenceDate
let d1 = addGregorianYearsClip 10 refDate
spreaded <- piecewiseZeroSpreadedTermStructure ts (fromList [(refDate, q), (d1, q)]) IR.Continuous NoFrequency Linear
actual360dc <- dayCounter (Actual360 False)
let testDate = addGregorianYearsClip 5 refDate
zero <- IR.rate <$> zeroRate ts (RateAtDate testDate actual360dc) IR.Continuous NoFrequency False
spreadedZero <- IR.rate <$> zeroRate spreaded (RateAtDate testDate actual360dc) IR.Continuous NoFrequency False
(zero - (spreadedZero - val)) `shouldSatisfy` (<= 1.0e-10)
-- spot-check a second interpolation builds and queries without crashing
spreadedCubic <- piecewiseZeroSpreadedTermStructure ts (fromList [(refDate, q), (d1, q)]) IR.Continuous NoFrequency (Cubic Kruger)
cubicZero <- IR.rate <$> zeroRate spreadedCubic (RateAtDate testDate actual360dc) IR.Continuous NoFrequency False
cubicZero `shouldSatisfy` (not . isNaN)
-- Mirrors upstream's ultimateforwardtermstructure.cpp testZeroRateAtFirstSmoothingPoint:
-- below the first smoothing point (fsp) the UFR curve must exactly reproduce the base
-- curve's own zero rate, since extrapolation only kicks in past fsp.
it "ultimate forward: zero rate at the first smoothing point matches the base curve" $
Context.keepingSettingsGc $ do
(_calendar, _settlementDays, ts) <- setup
llfr <- Quote.simpleQuote 0.0125
ufr <- Quote.simpleQuote 0.02
actual360dc <- dayCounter (Actual360 False)
refDate <- asTermStructure ts >>= referenceDate
let fsp = (10, Years)
cutOffDate = addGregorianYearsClip 10 refDate
ufrTs <- ultimateForwardTermStructure ts llfr ufr fsp 0.1 Nothing IR.Compounded Annual
base <- IR.rate <$> zeroRate ts (RateAtDate cutOffDate actual360dc) IR.Continuous NoFrequency True
extrap <- IR.rate <$> zeroRate ufrTs (RateAtDate cutOffDate actual360dc) IR.Continuous NoFrequency True
extrap `shouldSatisfy` closePrec base 1.0e-8
-- Mirrors upstream's testExtrapolatedForward: far enough past fsp, the UFR extrapolation
-- formula's beta term decays to ~0, so the continuously-compounded zero rate converges to
-- the UFR quote itself -- a property only the extrapolation branch can produce.
it "ultimate forward: zero rate far past the first smoothing point converges to the UFR" $
Context.keepingSettingsGc $ do
(_calendar, _settlementDays, ts) <- setup
llfr <- Quote.simpleQuote 0.0125
let ufrVal = 0.02
ufr <- Quote.simpleQuote ufrVal
actual360dc <- dayCounter (Actual360 False)
refDate <- asTermStructure ts >>= referenceDate
let fsp = (10, Years)
farDate = addGregorianYearsClip 150 refDate
ufrTs <- ultimateForwardTermStructure ts llfr ufr fsp 0.1 Nothing IR.Compounded Annual
farZero <- IR.rate <$> zeroRate ufrTs (RateAtDate farDate actual360dc) IR.Continuous NoFrequency True
farZero `shouldSatisfy` closePrec ufrVal 3.0e-3
-- Multiplicative discount spread: at the input node dates the spread curve's own discount
-- factor is by construction the given df, so the combined curve's discount there must equal
-- baseCurve.discount(date) * df exactly (to interpolation/numerical precision).
it "interpolated spread discount curve applies a multiplicative spread over the base curve" $
Context.keepingSettingsGc $ do
(_calendar, _settlementDays, ts) <- setup
refDate <- asTermStructure ts >>= referenceDate
let d1 = addGregorianYearsClip 1 refDate
d2 = addGregorianYearsClip 2 refDate
spreadDf1 = 0.95
spreaded <- interpolatedSpreadDiscountCurve ts [(refDate, 1.0), (d1, spreadDf1), (d2, 0.90)] Linear
baseD1 <- discount ts (DatePoint d1) False
spreadedD1 <- discount spreaded (DatePoint d1) False
spreadedD1 `shouldSatisfy` closePrec (baseD1 * spreadDf1) 1.0e-8
-- The three rate helpers below build their instrument internally rather than taking
-- one, so these accessors are the only way to reach it. Checking the instrument's own
-- maturity against the tenor the helper was given is what catches an accessor wired to
-- the wrong helper: the returned object would still be a valid swap/bond, just not this
-- helper's.
describe "rate helper underlying instruments" $
it "each accessor returns the instrument built from the helper's own tenor" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar Null
actual360dc <- dayCounter (Actual360 False)
thirty360dc <- dayCounter Thirty360BondBasis
q <- Quote.simpleQuote 0.03
ois <- overnightIborIndex Sofr Nothing
oisSwap <- oisRateHelper 2 (1, Years) (0, Days) q ois Nothing >>= helperInstrument
(Swap.asSwap oisSwap >>= Swap.maturityDate) `shouldReturn` Just (4 `january` 2025)
ccy <- currency EUR
ibor <- iborIndex (Ibor "dummy" (6, Months) 2 ccy cal ModifiedFollowing False actual360dc) Nothing
vanilla <- swapRateHelperFromConventions q (5, Years) cal Annual Unadjusted thirty360dc ibor Nothing (0, Days) Nothing
Nothing LastRelevantDate Nothing False Nothing Nothing Nothing >>= helperInstrument
(Swap.asSwap vanilla >>= Swap.maturityDate) `shouldReturn` Just (4 `january` 2029)
bondMaturity <- advance cal (2 `january` 2024) (5, Years) Unadjusted False
sch <- schedule (Just (2 `january` 2024)) bondMaturity (1, Years) cal Unadjusted Unadjusted
Backward False Nothing Nothing
price <- Quote.simpleQuote 100.0
bond <- fixedRateBondHelper price 3 100.0 sch [0.04] thirty360dc Following 100.0 Nothing
>>= helperInstrument
Bond.maturityDate bond `shouldReturn` Just bondMaturity
-- Drop Haskell's OptimizationMethod reference and collect before querying the curve. The
-- fitting method and its clone must retain shared ownership for the curve's full lifetime.
describe "fitted bond discount curve fitting methods" $
it "keeps a caller-supplied OptimizationMethod alive past Haskell's own GC" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar Null
thirty360dc <- dayCounter Thirty360BondBasis
helpers <- mapM
(\(tenor, coupon) -> do
maturity <- advance cal (2 `january` 2024) tenor Unadjusted False
sch <- schedule (Just (2 `january` 2024)) maturity (1, Years) cal Unadjusted Unadjusted
Backward False Nothing Nothing
price <- Quote.simpleQuote 100.0
fixedRateBondHelper price 3 100.0 sch [coupon] thirty360dc Following 100.0 Nothing)
[((2, Years), 0.03), ((5, Years), 0.035), ((10, Years), 0.04)]
let build reference = do
let optMethod = Simplex 0.1
fittedBondDiscountCurve reference (fromList helpers) thirty360dc
(ExponentialSplines True [] [] 0.0 1.0e6 9 Nothing Nothing (Just optMethod))
1.0e-10 10000 [] 1.0 False
fixedReference <- advance cal (2 `january` 2024) (3, Days) Following False
movingCurve <- build (SettlementDays 3 cal)
fixedCurve <- build (ReferenceDate fixedReference)
movingDiscount <- discount movingCurve (DatePoint (5 `january` 2029)) False
fixedDiscount <- discount fixedCurve (DatePoint (5 `january` 2029)) False
movingDiscount `shouldSatisfy` (\x -> x > 0 && x < 1)
fixedDiscount `shouldSatisfy` closePrec movingDiscount 1.0e-6
-- No upstream test-suite fixture exists for FxSwapRateHelper (unlike the other rate
-- helpers ported elsewhere in this file), so this is a self-consistency check instead of
-- a cached-value comparison: bootstrapping a curve from a single FxSwapRateHelper pillar
-- must solve for a curve under which the helper's own impliedQuote() reproduces the
-- fwdPoint quote it was built from -- that is the definition of a successful bootstrap
-- (RateHelper::quoteError() = quote_->value() - impliedQuote(), driven to ~0 by the
-- solver), not something specific to FX swaps.
describe "fx swap rate helper" $
it "bootstrapped curve reprices the helper's own forward points" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar TARGET
tradingCal <- calendar Null
actual360dc <- dayCounter (Actual360 False)
let fixingDays = 2 :: Word
settlement <- advance cal (2 `january` 2024) (2, Days) Following False
collRate <- Quote.simpleQuote 0.03
collateralCurve <- flatForward (SettlementDays fixingDays cal) collRate actual360dc IR.Continuous Annual
spotFx <- Quote.simpleQuote 1.10
fwdPoint <- Quote.simpleQuote 0.0025
rh <- fxSwapRateHelper fwdPoint spotFx (1, Years) fixingDays cal ModifiedFollowing False
True collateralCurve tradingCal
ts <- piecewiseYieldCurve (ReferenceDate settlement) [rh] actual360dc [] (Iterative Discount LogLinear defaultIterativeBootstrapOpts) False
-- PiecewiseYieldCurve is a lazy QuantLib object: bootstrapping (and the
-- setTermStructure call on each helper) only runs on first calculation, not on
-- construction, so the curve must be queried before impliedQuote is meaningful.
_ <- discount ts (DatePoint settlement) False
implied <- impliedQuote rh
fwdVal <- Quote.value fwdPoint
implied `shouldSatisfy` closePrec fwdVal 1.0e-8
-- Adapted from upstream's multipleresetsswap.cpp testRateHelper (a flat-rate quote at 1Y/2Y/3Y
-- bootstraps a curve under which each helper's fair rate matches the input). hasquant doesn't
-- bind MultipleResetsSwap itself (the helper needs no accessor for it -- see the "don't mirror
-- 1:1" rule), so this checks the same property the fx-swap-rate-helper test above does:
-- impliedQuote() reproduces the quote each helper was built from once the curve is solved.
describe "multiple resets swap rate helper" $
it "bootstrapped curve reprices each helper's own fixed rate" $
Context.keepingSettingsGc $ do
let today' = 15 `january` 2024
Context.setEvaluationDate (Just today')
cal <- calendar TARGET
actual360dc <- dayCounter (Actual360 False)
ccy <- currency EUR
euribor3m <- iborIndex (Ibor "euribor3m" (3, Months) 2 ccy cal ModifiedFollowing False actual360dc) Nothing
addFixing euribor3m (11 `january` 2024) 0.05 False
let inputRate = 0.05
q <- Quote.simpleQuote inputRate
helpers <- mapM
(\tenor -> multipleResetsSwapRateHelper 0 tenor q euribor3m 2 Nothing AveragingCompound 0.0 NoFrequency actual360dc ModifiedFollowing)
[(1, Years), (2, Years), (3, Years)]
ts <- piecewiseYieldCurve (ReferenceDate today') (fromList helpers) actual360dc [] (Iterative Discount LogLinear defaultIterativeBootstrapOpts) False
_ <- discount ts (DatePoint today') False
implieds <- mapM impliedQuote helpers
mapM_ (`shouldSatisfy` closePrec inputRate 1.0e-6) implieds
-- No upstream test-suite fixture exists for OvernightIndexFutureRateHelper/SofrFutureRateHelper
-- either (checked ~/Src/QuantLib/test-suite for overnightindexfuture/sofrfuture-named files,
-- found none). A single-pillar impliedQuote() self-consistency check alone (as used for the fx
-- swap rate helper above) is near-tautological here: RateHelper::quoteError() is driven to ~0
-- by the bootstrap solver regardless of whether valueDate/maturityDate/averagingMethod/pillar
-- are wired correctly, or whether the futures-price convention (100 - compounded rate) was
-- used consistently -- a transposed date or enum still converges. So each check below is kept,
-- but paired with a discriminating check that can actually fail on a wiring mistake.
describe "overnight index future rate helper" $ do
it "bootstrapped curve reprices the helper's own futures price" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar TARGET
actual360dc <- dayCounter (Actual360 False)
ois <- overnightIborIndex Sofr Nothing
let valueDate = 2 `january` 2024
maturityDate <- advance cal valueDate (3, Months) ModifiedFollowing False
price <- Quote.simpleQuote 95.0
rh <- overnightIndexFutureRateHelper price valueDate maturityDate ois Nothing AveragingCompound LastRelevantDate Nothing
ts <- piecewiseYieldCurve (ReferenceDate valueDate) [rh] actual360dc [] (Iterative Discount LogLinear defaultIterativeBootstrapOpts) False
_ <- discount ts (DatePoint valueDate) False
implied <- impliedQuote rh
priceVal <- Quote.value price
implied `shouldSatisfy` closePrec priceVal 1.0e-6
it "convexityAdjustment echoes the quote it was built with, and defaults to 0" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar TARGET
ois <- overnightIborIndex Sofr Nothing
let valueDate = 2 `january` 2024
maturityDate <- advance cal valueDate (3, Months) ModifiedFollowing False
price <- Quote.simpleQuote 95.0
adjQuote <- Quote.simpleQuote 0.0012
adjQuoteG <- Quote.asQuote adjQuote
rhAdj <- overnightIndexFutureRateHelper price valueDate maturityDate ois (Just adjQuoteG) AveragingCompound LastRelevantDate Nothing
adj <- overnightIndexFutureRateHelperConvexityAdjustment rhAdj
adj `shouldSatisfy` closePrec 0.0012 1.0e-12
rhNone <- overnightIndexFutureRateHelper price valueDate maturityDate ois Nothing AveragingCompound LastRelevantDate Nothing
none <- overnightIndexFutureRateHelperConvexityAdjustment rhNone
none `shouldBe` 0.0
describe "futures rate helper" $
it "convexityAdjustment echoes the quote it was built with, and defaults to 0" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar TARGET
actual360dc <- dayCounter (Actual360 False)
immDate' <- nextImmDate (2 `january` 2024) True
price <- Quote.simpleQuote 95.0
adjQuote <- Quote.simpleQuote 0.0007
adjQuoteG <- Quote.asQuote adjQuote
fhAdj <- futuresRateHelper price (FuturesMonths immDate' 3 cal ModifiedFollowing True actual360dc) (Just adjQuoteG) IMM
adj <- futuresRateHelperConvexityAdjustment fhAdj
adj `shouldSatisfy` closePrec 0.0007 1.0e-12
fhNone <- futuresRateHelper price (FuturesMonths immDate' 3 cal ModifiedFollowing True actual360dc) Nothing IMM
none <- futuresRateHelperConvexityAdjustment fhNone
none `shouldBe` 0.0
describe "futures rate helper terms" $ do
it "FuturesFromIndex agrees with the equivalent explicit FuturesMonths" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar TARGET
ccy <- currency EUR
actual360dc <- dayCounter (Actual360 False)
immDate' <- nextImmDate (2 `january` 2024) True
euribor3m <- iborIndex (Ibor "euribor3m" (3, Months) 2 ccy cal ModifiedFollowing False actual360dc) Nothing
price <- Quote.simpleQuote 95.0
let priced terms = do
rh <- futuresRateHelper price terms Nothing IMM >>= asRateHelper
ts <- piecewiseYieldCurve (ReferenceDate (2 `january` 2024)) ([rh] :: NonEmpty RateHelper) actual360dc []
(Iterative Discount LogLinear defaultIterativeBootstrapOpts) False
discount ts (DatePoint (2 `january` 2025)) True
fromIndex <- priced (FuturesFromIndex immDate' euribor3m)
explicit <- priced (FuturesMonths immDate' 3 cal ModifiedFollowing False actual360dc)
fromIndex `shouldSatisfy` closePrec explicit 1.0e-12
it "FuturesBetweenDates spans the same period as the equivalent FuturesMonths" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar TARGET
actual360dc <- dayCounter (Actual360 False)
immDate' <- nextImmDate (2 `january` 2024) True
endDate <- advance cal immDate' (3, Months) ModifiedFollowing False
price <- Quote.simpleQuote 95.0
let priced terms = do
rh <- futuresRateHelper price terms Nothing IMM >>= asRateHelper
ts <- piecewiseYieldCurve (ReferenceDate (2 `january` 2024)) ([rh] :: NonEmpty RateHelper) actual360dc []
(Iterative Discount LogLinear defaultIterativeBootstrapOpts) False
discount ts (DatePoint (2 `january` 2025)) True
between <- priced (FuturesBetweenDates immDate' endDate actual360dc)
explicit <- priced (FuturesMonths immDate' 3 cal ModifiedFollowing False actual360dc)
between `shouldSatisfy` closePrec explicit 1.0e-12
-- FuturesType reaches the index-form shim: upstream validates the start date's shape
-- against it, so an IMM date is rejected as an ASX date. Before the shim was widened
-- this branch hardcoded IMM and could not fail here.
it "FuturesFromIndex honours the futures type" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar TARGET
ccy <- currency EUR
actual360dc <- dayCounter (Actual360 False)
immDate' <- nextImmDate (2 `january` 2024) True
euribor3m <- iborIndex (Ibor "euribor3m" (3, Months) 2 ccy cal ModifiedFollowing False actual360dc) Nothing
price <- Quote.simpleQuote 95.0
_ <- futuresRateHelper price (FuturesFromIndex immDate' euribor3m) Nothing Custom
futuresRateHelper price (FuturesFromIndex immDate' euribor3m) Nothing ASX
`shouldThrow` anyException
describe "FRA rate helper terms" $ do
it "FraPeriod agrees with the equivalent FraMonths" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar TARGET
actual360dc <- dayCounter (Actual360 False)
q <- Quote.simpleQuote 0.03
let priced terms = do
rh <- fraRateHelper q terms LastRelevantDate Nothing True
ts <- piecewiseYieldCurve (ReferenceDate (2 `january` 2024)) ([rh] :: NonEmpty RateHelper) actual360dc []
(Iterative Discount LogLinear defaultIterativeBootstrapOpts) False
discount ts (DatePoint (2 `july` 2024)) True
months <- priced (FraMonths 3 6 2 cal ModifiedFollowing False actual360dc)
period <- priced (FraPeriod (3, Months) 3 2 cal ModifiedFollowing False actual360dc)
months `shouldSatisfy` closePrec period 1.0e-12
-- The index-form ctors derive the FRA's end date from the index's own tenor and
-- fixing calendar, so this agreement holds only because euribor3m is built with the
-- same conventions as the explicit terms below -- a failure here is a convention
-- mismatch, not necessarily a dispatch bug.
it "the FromIndex variants agree with the equivalent explicit terms" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar TARGET
ccy <- currency EUR
actual360dc <- dayCounter (Actual360 False)
euribor3m <- iborIndex (Ibor "euribor3m" (3, Months) 2 ccy cal ModifiedFollowing False actual360dc) Nothing
q <- Quote.simpleQuote 0.03
let priced terms = do
rh <- fraRateHelper q terms LastRelevantDate Nothing True
ts <- piecewiseYieldCurve (ReferenceDate (2 `january` 2024)) ([rh] :: NonEmpty RateHelper) actual360dc []
(Iterative Discount LogLinear defaultIterativeBootstrapOpts) False
discount ts (DatePoint (2 `july` 2024)) True
explicit <- priced (FraMonths 3 6 2 cal ModifiedFollowing False actual360dc)
monthsIdx <- priced (FraMonthsFromIndex 3 euribor3m)
periodIdx <- priced (FraPeriodFromIndex (3, Months) euribor3m)
monthsIdx `shouldSatisfy` closePrec explicit 1.0e-12
periodIdx `shouldSatisfy` closePrec explicit 1.0e-12
describe "sofr future rate helper" $ do
it "bootstrapped curve reprices the helper's own futures price" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
actual360dc <- dayCounter (Actual360 False)
let settlement = 2 `january` 2024
price <- Quote.simpleQuote 95.0
rh <- sofrFutureRateHelper price QuantLib.Time.Date.March 2024 Quarterly Nothing LastRelevantDate Nothing
ts <- piecewiseYieldCurve (ReferenceDate settlement) [rh] actual360dc [] (Iterative Discount LogLinear defaultIterativeBootstrapOpts) False
_ <- discount ts (DatePoint settlement) False
implied <- impliedQuote rh
priceVal <- Quote.value price
implied `shouldSatisfy` closePrec priceVal 1.0e-6
-- SofrFutureRateHelper derives its own valueDate/maturityDate (third Wednesday of the
-- reference month to the third Wednesday one Month/Quarter later) and constructs a Sofr
-- index internally, then delegates into the same OvernightIndexFutureRateHelper base
-- constructor bound above. Building the base helper directly with those same dates and
-- comparing the resulting discount factors pins both the date derivation and the
-- base-class delegation: a wrong Month/Frequency/averaging wiring makes the two curves
-- disagree even though each one's own impliedQuote() self-check (above) still passes.
it "agrees with an explicitly-dated overnight index future rate helper" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
actual360dc <- dayCounter (Actual360 False)
ois <- overnightIborIndex Sofr Nothing
let settlement = 2 `january` 2024
valueDate <- nthWeekday 3 QuantLib.Time.Date.Wednesday QuantLib.Time.Date.March 2024
maturityDate <- nthWeekday 3 QuantLib.Time.Date.Wednesday QuantLib.Time.Date.June 2024
price <- Quote.simpleQuote 95.0
sofrRh <- sofrFutureRateHelper price QuantLib.Time.Date.March 2024 Quarterly Nothing LastRelevantDate Nothing
sofrTs <- piecewiseYieldCurve (ReferenceDate settlement) [sofrRh] actual360dc [] (Iterative Discount LogLinear defaultIterativeBootstrapOpts) False
sofrDf <- discount sofrTs (DatePoint maturityDate) False
explicitRh <- overnightIndexFutureRateHelper price valueDate maturityDate ois Nothing AveragingCompound LastRelevantDate Nothing
explicitTs <- piecewiseYieldCurve (ReferenceDate settlement) [explicitRh] actual360dc [] (Iterative Discount LogLinear defaultIterativeBootstrapOpts) False
explicitDf <- discount explicitTs (DatePoint maturityDate) False
sofrDf `shouldSatisfy` closePrec explicitDf 1.0e-8
-- Relinking is the one thing a plain curve cannot do: reassign a whole curve under
-- objects that are already built, and have everything downstream reprice. Every check
-- here is a before/after comparison rather than a value assertion, because the failure
-- mode is specific -- a handle whose Link got detached still returns the *correct*
-- value for the curve it was detached holding, so it is memory-safe, passes any pinned
-- expected value, and never crashes. The entire symptom is an NPV that stops moving.
describe "relinkable handles" $ do
let flat r = do
q <- Quote.simpleQuote r
dc <- dayCounter Actual365FixedStandard
flatForward (ReferenceDate (11 `december` 2012)) q dc IR.Continuous Annual
-- one swap and one engine, built once and never rebuilt; the relinks below all
-- act on the already-constructed objects
setupSwap = do
cal <- Calendar.calendar TARGET
settle <- advance cal (11 `december` 2012) (2, Days) Following False
fixedDC <- dayCounter Thirty360European
floatDC <- dayCounter (Actual360 False)
c <- flat 0.02
discountH <- relinkableYieldTermStructure (Just c)
forecastH <- relinkableYieldTermStructure (Just c)
idx <- iborIndex Euribor6M (Just forecastH)
fixedSch <- schedule (Just settle) (11 `december` 2017) (1, Years) cal
Unadjusted Unadjusted Forward False Nothing Nothing
floatSch <- schedule (Just settle) (11 `december` 2017) (6, Months) cal
ModifiedFollowing ModifiedFollowing Forward False Nothing Nothing
sw <- vanillaSwap Payer 1000000 fixedSch 0.02 fixedDC floatSch idx 0 floatDC
Nothing Nothing
eng <- discountingSwapEngine discountH Nothing Nothing Nothing
setPricingEngine sw eng
pure (sw, discountH, forecastH)
it "a relinkable handle is accepted wherever a curve is" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
-- no sibling function, no wrapper: it upcasts like any hierarchy member
(sw, _, _) <- setupSwap
v <- npv sw
v `shouldSatisfy` (not . isNaN)
it "relinking the discount curve reprices without rebuilding" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
(sw, discountH, _) <- setupSwap
npvBefore <- npv sw
flat 0.05 >>= linkTo discountH
npvAfter <- npv sw
abs (npvAfter - npvBefore) `shouldSatisfy` (> 1.0)
it "relinking back restores the original value exactly" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
(sw, discountH, _) <- setupSwap
npvBefore <- npv sw
flat 0.05 >>= linkTo discountH
flat 0.02 >>= linkTo discountH
-- exact, not approximate: relinking to an identical curve must reproduce the
-- same arithmetic, and anything else means we are not reaching the same object
npv sw `shouldReturn` npvBefore
it "relinking the forecast curve reprices without rebuilding" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
-- the case with no workaround today: an IborIndex is cloned into every floating
-- coupon at construction, so without a handle this needs the swap rebuilt
(sw, _, forecastH) <- setupSwap
npvBefore <- npv sw
flat 0.05 >>= linkTo forecastH
npvAfter <- npv sw
abs (npvAfter - npvBefore) `shouldSatisfy` (> 1.0)
-- A relinkable quote propagates the same way a relinkable curve does: the curve built
-- on top of it (fixed, not itself relinkable) still moves when the quote underneath is
-- relinked, because Quote.relinkableQuote/linkTo share one Link exactly like the curve
-- case above.
it "relinking a quote reprices the curve built on it, without rebuilding" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
q02 <- Quote.simpleQuote 0.02
qh <- Quote.relinkableQuote (Just q02)
dc <- dayCounter Actual365FixedStandard
c <- flatForward (ReferenceDate (11 `december` 2012)) qh dc IR.Continuous Annual
npvBefore <- discount c (TimePoint 5.0) False
Quote.simpleQuote 0.05 >>= Quote.linkTo qh
npvAfter <- discount c (TimePoint 5.0) False
abs (npvAfter - npvBefore) `shouldSatisfy` (> 0.01)
it "relinking a quote back restores the original value exactly" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
q02 <- Quote.simpleQuote 0.02
qh <- Quote.relinkableQuote (Just q02)
dc <- dayCounter Actual365FixedStandard
c <- flatForward (ReferenceDate (11 `december` 2012)) qh dc IR.Continuous Annual
npvBefore <- discount c (TimePoint 5.0) False
Quote.simpleQuote 0.05 >>= Quote.linkTo qh
Quote.simpleQuote 0.02 >>= Quote.linkTo qh
-- exact, not approximate: same reasoning as the curve-relink-back check above
discount c (TimePoint 5.0) False `shouldReturn` npvBefore
-- A relinkable Black vol surface propagates the same way: an option engine built on it
-- keeps tracking whatever surface the handle currently points at, so relinking reprices
-- without rebuilding the engine.
let mkOption = do
underQ <- Quote.simpleQuote 100
riskFreeQ <- Quote.simpleQuote 0.03
dc <- dayCounter Actual365FixedStandard
ts <- flatForward (ReferenceDate (11 `december` 2012)) riskFreeQ dc IR.Continuous Annual
divQ <- Quote.simpleQuote 0.0
divTS <- flatForward (ReferenceDate (11 `december` 2012)) divQ dc IR.Continuous Annual
volQ <- Quote.simpleQuote 0.20
cal <- Calendar.calendar TARGET
vol0 <- Vol.blackConstantVol (Vol.CalendarReferenceDate (11 `december` 2012)) cal volQ dc
volH <- Vol.relinkableBlackVolTermStructure (Just vol0)
proc <- blackScholesMertonProcess underQ divTS ts volH EulerDiscretization False
opt <- vanillaOption (PlainVanilla (PlainVanillaPayoff Call 100))
(European (EuropeanExercise (11 `december` 2013)))
analyticEuropeanEngine proc Nothing >>= setPricingEngine opt
pure (opt, volH)
it "relinking a Black vol surface reprices the option, without rebuilding the engine" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
(opt, volH) <- mkOption
npvBefore <- npv opt
cal <- Calendar.calendar TARGET
dc <- dayCounter Actual365FixedStandard
q <- Quote.simpleQuote 0.40
vol1 <- Vol.blackConstantVol (Vol.CalendarReferenceDate (11 `december` 2012)) cal q dc
Vol.linkBlackVolTo volH vol1
npvAfter <- npv opt
abs (npvAfter - npvBefore) `shouldSatisfy` (> 0.5)
-- A relinkable swaption vol surface propagates the same way: an engine built on it
-- keeps tracking whatever surface the handle currently points at, so relinking reprices
-- the swaption without rebuilding the engine. Mirrors the Black vol case above.
let mkSwaption = do
(sw, discountH, _) <- setupSwap
cal <- Calendar.calendar TARGET
dc <- dayCounter Actual365FixedStandard
volQ <- Quote.simpleQuote 0.20
vol0 <- Vol.constantSwaptionVolatility (Vol.CalendarReferenceDate (11 `december` 2012)) cal ModifiedFollowing volQ dc IR.ShiftedLognormal 0
volH <- Vol.relinkableSwaptionVolatilityStructure (Just vol0)
eng <- blackSwaptionEngineFromVolatilityStructure discountH volH
-- the Black swaption engine requires a spot-starting swaption: the exercise date
-- must fall on or before the swap's start date (13 december 2012)
swpn <- swaption sw (European (EuropeanExercise (12 `december` 2012))) Physical PhysicalOTC
setPricingEngine swpn eng
pure (swpn, volH)
it "relinking a swaption vol surface reprices the swaption, without rebuilding the engine" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
(swpn, volH) <- mkSwaption
npvBefore <- npv swpn
cal <- Calendar.calendar TARGET
dc <- dayCounter Actual365FixedStandard
q <- Quote.simpleQuote 0.60
vol1 <- Vol.constantSwaptionVolatility (Vol.CalendarReferenceDate (11 `december` 2012)) cal ModifiedFollowing q dc IR.ShiftedLognormal 0
Vol.linkSwaptionVolTo volH vol1
npvAfter <- npv swpn
abs (npvAfter - npvBefore) `shouldSatisfy` (> 0.5)
-- A relinkable optionlet vol surface propagates the same way: an engine built on it
-- keeps tracking whatever surface the handle currently points at, so relinking reprices
-- the cap without rebuilding the engine. Mirrors the swaption vol case above.
let mkCap = do
(_, discountH, forecastH) <- setupSwap
cal <- Calendar.calendar TARGET
settle <- advance cal (11 `december` 2012) (2, Days) Following False
floatDC <- dayCounter (Actual360 False)
floatSch <- schedule (Just settle) (11 `december` 2017) (6, Months) cal
ModifiedFollowing ModifiedFollowing Forward False Nothing Nothing
idx <- iborIndex Euribor6M (Just forecastH)
leg <- iborLeg floatSch idx [1000000] floatDC ModifiedFollowing [2] [1.0] [0.0] [] [] False False
capfl <- cap leg [0.03]
dc <- dayCounter Actual365FixedStandard
volQ <- Quote.simpleQuote 0.20
vol0 <- Vol.constantOptionletVolatility (Vol.CalendarReferenceDate (11 `december` 2012)) cal ModifiedFollowing volQ dc IR.ShiftedLognormal 0
volH <- Vol.relinkableOptionletVolatilityStructure (Just vol0)
eng <- blackCapFloorEngineFromVolatilityStructure discountH volH
setPricingEngine capfl eng
pure (capfl, volH)
it "relinking an optionlet vol surface reprices the cap, without rebuilding the engine" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
(capfl, volH) <- mkCap
npvBefore <- npv capfl
cal <- Calendar.calendar TARGET
dc <- dayCounter Actual365FixedStandard
q <- Quote.simpleQuote 0.60
vol1 <- Vol.constantOptionletVolatility (Vol.CalendarReferenceDate (11 `december` 2012)) cal ModifiedFollowing q dc IR.ShiftedLognormal 0
Vol.linkOptionletVolTo volH vol1
npvAfter <- npv capfl
abs (npvAfter - npvBefore) `shouldSatisfy` (> 0.5)
-- OptionletStripper1 strips a quoted CapFloorTermVolSurface into caplet/floorlet vols,
-- immediately wrapped behind StrippedOptionletAdapter (an OptionletVolatilityStructure).
-- Self-consistency check (upstream: optionletstripper.cpp's testFlatTermVolatilityStripping1,
-- ported to a single tenor/strike rather than its full 10x10 grid): a *flat* term vol
-- surface strips to the same flat caplet vol, so pricing a cap at a strike/tenor that sits
-- exactly on the surface's own grid nodes through the stripped vol must reprice the same
-- cap priced directly off a constant-vol surface at that flat vol.
it "stripping a flat cap vol surface reprices a cap struck on its own grid" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
(_, discountH, forecastH) <- setupSwap
cal <- Calendar.calendar TARGET
settle <- advance cal (11 `december` 2012) (2, Days) Following False
floatDC <- dayCounter (Actual360 False)
floatSch <- schedule (Just settle) (11 `december` 2017) (6, Months) cal
ModifiedFollowing ModifiedFollowing Forward False Nothing Nothing
idx <- iborIndex Euribor6M (Just forecastH)
leg <- iborLeg floatSch idx [1000000] floatDC ModifiedFollowing [2] [1.0] [0.0] [] [] False False
capfl <- cap leg [0.05]
dc <- dayCounter Actual365FixedStandard
flatVolQ <- Quote.simpleQuote 0.18
let volMatrix = either error id $ objectMatrix 10 3 (replicate 30 flatVolQ)
capVolSurface <- Vol.capFloorTermVolSurface (Vol.CalendarSettlementDays 0) cal Following
[(n, Years) | n <- [1 .. 10]] [0.02, 0.05, 0.08] volMatrix dc
strippedVol <- Vol.optionletStripper capVolSurface idx Nothing 1.0e-6 100
(Just discountH) IR.ShiftedLognormal 0 False Nothing
strippedEng <- blackCapFloorEngineFromVolatilityStructure discountH strippedVol
setPricingEngine capfl strippedEng
priceStripped <- npv capfl
constVolQ <- Quote.simpleQuote 0.18
constVol <- Vol.constantOptionletVolatility (Vol.CalendarReferenceDate (11 `december` 2012)) cal Following constVolQ dc
IR.ShiftedLognormal 0
constEng <- blackCapFloorEngineFromVolatilityStructure discountH constVol
setPricingEngine capfl constEng
priceConst <- npv capfl
priceConst `shouldSatisfy` (> 1)
abs (priceStripped - priceConst) / abs priceConst `shouldSatisfy` (< 1.0e-5)
-- CapFloorTermVolatilityStructure::volatility isn't declared on the generic
-- VolatilityTermStructure, so this exercises the new family root directly across all three
-- concrete subclasses (ConstantCapFloorTermVolatility, CapFloorTermVolCurve,
-- CapFloorTermVolSurface), plus the calendar/day-counter-derived optionDates/optionTimes
-- getters on the two LazyObject leaves.
it "queries a flat cap/floor vol surface, curve and constant structure at their own grid" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
cal <- Calendar.calendar TARGET
dc <- dayCounter Actual365FixedStandard
let tenors = [(n, Years) | n <- [1 .. 10]]
flatVolQ <- Quote.simpleQuote 0.18
let volMatrix = either error id $ objectMatrix 10 3 (replicate 30 flatVolQ)
capVolSurface <- Vol.capFloorTermVolSurface (Vol.CalendarSettlementDays 0) cal Following tenors [0.02, 0.05, 0.08] volMatrix dc
volFromSurface <- Vol.capFloorVolatility capVolSurface (Vol.OptionTenor (5, Years)) 0.05 False
volFromSurface `shouldBe` 0.18
surfaceDates <- Vol.capFloorTermVolSurfaceOptionDates capVolSurface
surfaceTimes <- Vol.capFloorTermVolSurfaceOptionTimes capVolSurface
length surfaceDates `shouldBe` 10
length surfaceTimes `shouldBe` 10
Vol.capFloorVolatility capVolSurface (Vol.OptionDate (surfaceDates !! 4)) 0.05 False
`shouldReturn` volFromSurface
Vol.capFloorVolatility capVolSurface (Vol.OptionTime (surfaceTimes !! 4)) 0.05 False
`shouldReturn` volFromSurface
curveVolQ <- mapM (const (Quote.simpleQuote 0.18)) tenors
capVolCurve <- Vol.capFloorTermVolCurve (Vol.CalendarSettlementDays 0) cal Following (fromList $ zipWith (\(n, u) q -> (n, u, q)) tenors curveVolQ) dc
volFromCurve <- Vol.capFloorVolatility capVolCurve (Vol.OptionTenor (5, Years)) 0.05 False
volFromCurve `shouldBe` 0.18
curveDates <- Vol.capFloorTermVolCurveOptionDates capVolCurve
curveTimes <- Vol.capFloorTermVolCurveOptionTimes capVolCurve
length curveDates `shouldBe` 10
length curveTimes `shouldBe` 10
constVolQ <- Quote.simpleQuote 0.18
constVol <- Vol.constantCapFloorTermVolatility (Vol.CalendarSettlementDays 0) cal Following constVolQ dc
volFromConst <- Vol.capFloorVolatility constVol (Vol.OptionTenor (5, Years)) 0.05 False
volFromConst `shouldBe` 0.18
-- CallableBondVolatilityStructure's query methods, checked against a constant
-- callable-bond volatility structure: the flat volatility must come back unchanged
-- across the Time/Date/Period overloads, blackVariance must equal vol^2 * optionTime,
-- and the constant leaf's own maxBondTenor/minStrike/maxStrike (100 years,
-- QL_MIN_REAL/QL_MAX_REAL per callablebondconstantvol.hpp) come through unmarshalled.
it "queries a constant callable-bond volatility structure across all overloads" $
Context.keepingSettingsGc $ do
let evalDate = 11 `december` 2012
Context.setEvaluationDate (Just evalDate)
cal <- Calendar.calendar TARGET
dc <- dayCounter Actual365FixedStandard
cbVolQ <- Quote.simpleQuote 0.12
-- the fixed-reference-date constructor defaults to an empty Calendar, which
-- 'volatility' needs (via optionDateFromTenor); use the
-- floating-reference-date overload with an explicit calendar instead, exactly as
-- the cap/floor test above does for 'constantCapFloorTermVolatility'.
cbVol <- Vol.callableBondConstantVolatility (Vol.SettlementDays 0 cal) cbVolQ dc
let optionDate = addDays (365 * 3) evalDate
optionTime = 3.0 :: Double
bondLength = 5.0 :: Double
optionTenor = (3, Years) :: (Word, TimeUnit)
bondTenor = (5, Years) :: (Word, TimeUnit)
volTime <- Vol.callableBondVolatility cbVol (Vol.CallableBondTimeLength optionTime bondLength) 0.05 False
volTime `shouldBe` 0.12
volDate <- Vol.callableBondVolatility cbVol (Vol.CallableBondDateTenor optionDate bondTenor) 0.05 False
volDate `shouldBe` 0.12
volPeriod <- Vol.callableBondVolatility cbVol (Vol.CallableBondTenorTenor optionTenor bondTenor) 0.05 False
volPeriod `shouldBe` 0.12
varTime <- Vol.callableBondBlackVariance cbVol (Vol.CallableBondTimeLength optionTime bondLength) 0.05 False
varTime `shouldSatisfy` closePrec (0.12 * 0.12 * 3.0) 1.0e-10
varDate <- Vol.callableBondBlackVariance cbVol (Vol.CallableBondDateTenor optionDate bondTenor) 0.05 False
varDate `shouldSatisfy` closePrec varTime 1.0e-6
varPeriod <- Vol.callableBondBlackVariance cbVol (Vol.CallableBondTenorTenor optionTenor bondTenor) 0.05 False
varPeriod `shouldSatisfy` closePrec varTime 1.0e-6
_smileByDate <- Vol.callableBondSmileSection cbVol (Vol.CallableBondSmileDateTenor optionDate bondTenor)
_smileByPeriod <- Vol.callableBondSmileSection cbVol (Vol.CallableBondSmileTenorTenor optionTenor bondTenor)
maxTenor <- Vol.maxBondTenor cbVol
maxTenor `shouldBe` (100, Years)
minK <- Vol.minStrike cbVol
minK `shouldSatisfy` (< -1.0e100)
maxK <- Vol.maxStrike cbVol
maxK `shouldSatisfy` (> 1.0e100)
-- OptionletStripper2 reconciles OptionletStripper1's forward-forward stripping against an
-- ATM CapFloorTermVolCurve (upstream: optionletstripper.cpp's testFlatTermVolatilityStripping2).
-- With flat term-vol inputs on both the surface and the ATM curve, stripping via either path
-- must produce the same caplet vols, so pricing the same cap through each stripped
-- structure's engine gives matching NPVs -- a real self-consistency check, not a hand-derived
-- golden value.
it "OptionletStripper2 reprices a cap the same as OptionletStripper1 on flat term vol inputs" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
(_, discountH, forecastH) <- setupSwap
cal <- Calendar.calendar TARGET
settle <- advance cal (11 `december` 2012) (2, Days) Following False
floatDC <- dayCounter (Actual360 False)
floatSch <- schedule (Just settle) (11 `december` 2017) (6, Months) cal
ModifiedFollowing ModifiedFollowing Forward False Nothing Nothing
idx <- iborIndex Euribor6M (Just forecastH)
leg <- iborLeg floatSch idx [1000000] floatDC ModifiedFollowing [2] [1.0] [0.0] [] [] False False
capfl <- cap leg [0.05]
dc <- dayCounter Actual365FixedStandard
let tenors = [(n, Years) | n <- [1 .. 10]]
flatVolQ <- Quote.simpleQuote 0.18
let volMatrix = either error id $ objectMatrix 10 3 (replicate 30 flatVolQ)
capVolSurface <- Vol.capFloorTermVolSurface (Vol.CalendarSettlementDays 0) cal Following tenors [0.02, 0.05, 0.08] volMatrix dc
curveVolQs <- mapM (const (Quote.simpleQuote 0.18)) tenors
capVolCurve <- Vol.capFloorTermVolCurve (Vol.CalendarSettlementDays 0) cal Following (fromList $ zipWith (\(n, u) q -> (n, u, q)) tenors curveVolQs) dc
stripper1 <- Vol.optionletStripper capVolSurface idx Nothing 1.0e-6 100
(Just discountH) IR.ShiftedLognormal 0 False Nothing
stripper2 <- Vol.optionletStripperWithAtm capVolSurface idx Nothing 1.0e-6 100
(Just discountH) IR.ShiftedLognormal 0 False Nothing capVolCurve
vol2 <- Vol.asOptionletVolatilityStructure stripper2
eng1 <- blackCapFloorEngineFromVolatilityStructure discountH stripper1
setPricingEngine capfl eng1
price1 <- npv capfl
eng2 <- blackCapFloorEngineFromVolatilityStructure discountH vol2
setPricingEngine capfl eng2
price2 <- npv capfl
price1 `shouldSatisfy` (> 1)
abs (price1 - price2) / abs price1 `shouldSatisfy` (< 1.0e-5)
atmStrikes <- Vol.atmCapFloorStrikes stripper2
atmPrices <- Vol.atmCapFloorPrices stripper2
spreadsVol <- Vol.spreadsVol stripper2
length atmStrikes `shouldBe` 10
length atmPrices `shouldBe` 10
length spreadsVol `shouldBe` 10
-- AbcdAtmVolCurve fits an ABCD functional form to quoted ATM vols. No cached upstream
-- fixture matches hasquant's binding shape (see the plan's Tests section), so this is a
-- construction-plus-getters smoke test: with flat input quotes the fit should stay close to
-- flat and converge with a small rms error.
it "constructs an AbcdAtmVolCurve and queries its fit diagnostics" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
cal <- Calendar.calendar TARGET
dc <- dayCounter Actual365FixedStandard
let tenors = [(n, Years) | n <- [1 .. 10]]
qs <- mapM (const (Quote.simpleQuote 0.18)) tenors
curve <- Vol.abcdAtmVolCurve 0 cal (fromList $ zip3 tenors qs (replicate 10 True)) Following dc
rmsErr <- Vol.abcdRmsError curve
rmsErr `shouldSatisfy` (< 0.05)
maxErr <- Vol.abcdMaxError curve
maxErr `shouldSatisfy` (< 0.05)
_ <- Vol.abcdA curve
_ <- Vol.abcdB curve
_ <- Vol.abcdC curve
_ <- Vol.abcdD curve
_ <- Vol.abcdEndCriteria curve
ks <- Vol.abcdKs curve
length ks `shouldBe` 10
returnedTenors <- Vol.abcdAtmVolCurveOptionTenors curve
length returnedTenors `shouldBe` 10
optionDates <- Vol.abcdOptionDates curve
optionTimes <- Vol.abcdOptionTimes curve
let maturityCoordinates = [ Vol.OptionTenor (5, Years)
, Vol.OptionDate (optionDates !! 4)
, Vol.OptionTime (optionTimes !! 4)
]
atmVols <- mapM (\m -> Vol.atmVol curve m False) maturityCoordinates
atmVols `shouldSatisfy` all (\v -> v > 0.1 && v < 0.3)
case atmVols of
expectedVol : remainingVols ->
forM_ remainingVols $ \v -> v `shouldSatisfy` closePrec expectedVol 1.0e-8
[] -> expectationFailure "expected ATM volatility results"
atmVariances <- mapM (\m -> Vol.atmVariance curve m False) maturityCoordinates
case atmVariances of
expectedVariance : remainingVariances ->
forM_ remainingVariances $ \v -> v `shouldSatisfy` closePrec expectedVariance 1.0e-8
[] -> expectationFailure "expected ATM variance results"
-- SabrVolSurface's own sabrVolatilitySpreads(Date) linearly interpolates the raw quoted
-- vol-spread quotes across optionTenors -- at a date that lands exactly on a grid tenor,
-- that interpolation is the identity, so with flat spread quotes the surface must echo the
-- input value back exactly. Real self-consistency check, not a hand-derived value.
it "constructs a SabrVolSurface anchored to an AbcdAtmVolCurve and echoes its vol spreads at a grid tenor" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
cal <- Calendar.calendar TARGET
dc <- dayCounter Actual365FixedStandard
(_, _, forecastH) <- setupSwap
idx <- iborIndex Euribor6M (Just forecastH)
let tenors = [(n, Years) | n <- [1 .. 5]]
atmQs <- mapM (const (Quote.simpleQuote 0.18)) tenors
atmCurve <- Vol.abcdAtmVolCurve 0 cal (fromList $ zip3 tenors atmQs (replicate 5 True)) Following dc
let spreads = [-0.01, 0, 0.01]
spreadQs <- mapM (const (Quote.simpleQuote 0.02)) [1 .. (5 * 3 :: Int)]
let volSpreads = either error id $ objectMatrix 5 3 spreadQs
surf <- Vol.sabrVolSurface idx atmCurve (fromList tenors) (fromList spreads) volSpreads
vs <- Vol.sabrVolatilitySpreads surf (Vol.SabrVolatilitySpreadsTenor (tenors !! 2))
length vs `shouldBe` 3
vs `shouldSatisfy` all (\v -> abs (v - 0.02) < 1.0e-8)
_ <- Vol.sabrVolSurfaceIndex surf
d <- Vol.sabrVolSurfaceOptionDateFromTenor surf (3, Years)
d `shouldSatisfy` (> 11 `december` 2012)
vsAtDate <- Vol.sabrVolatilitySpreads surf (Vol.SabrVolatilitySpreadsDate d)
vsAtDate `shouldSatisfy` all (\v -> abs (v - 0.02) < 1.0e-8)
t <- yearFraction dc (11 `december` 2012) d Nothing Nothing
_ <- Vol.blackVolSurfaceSmileSection surf (Vol.OptionTenor (3, Years)) False
_ <- Vol.blackVolSurfaceSmileSection surf (Vol.OptionDate d) False
_ <- Vol.blackVolSurfaceSmileSection surf (Vol.OptionTime t) False
curveBack <- Vol.sabrVolSurfaceAtmCurve surf
v <- Vol.atmVol curveBack (Vol.OptionTenor (3, Years)) False
abs (v - 0.18) `shouldSatisfy` (< 1.0e-6)
-- Bachelier (normal-vol) engines use a different pricing formula from their Black
-- (lognormal-vol) siblings; this checks the new bindings are actually wired to that
-- formula rather than silently aliasing to Black, by repricing the same instrument
-- with both engines and confirming the results are finite and non-trivially different.
-- No cached NPV to match against: upstream's Bachelier tests check deltas via finite
-- differences, not NPVs (see swaption.cpp/capfloor.cpp).
it "Bachelier swaption engine prices differently from the Black engine on the same swaption" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
(sw, discountH, _) <- setupSwap
cal <- Calendar.calendar TARGET
dc <- dayCounter Actual365FixedStandard
swpn <- swaption sw (European (EuropeanExercise (12 `december` 2012))) Physical PhysicalOTC
normalVolQ <- Quote.simpleQuote 0.0075
normalVol <- Vol.constantSwaptionVolatility (Vol.CalendarReferenceDate (11 `december` 2012)) cal ModifiedFollowing normalVolQ dc IR.Normal 0
normalVolH <- Vol.relinkableSwaptionVolatilityStructure (Just normalVol)
bachelierEng <- bachelierSwaptionEngineFromVolatilityStructure discountH normalVolH
setPricingEngine swpn bachelierEng
npvBachelier <- npv swpn
npvBachelier `shouldSatisfy` (not . isNaN)
lognormalVolQ <- Quote.simpleQuote 0.20
lognormalVol <- Vol.constantSwaptionVolatility (Vol.CalendarReferenceDate (11 `december` 2012)) cal ModifiedFollowing lognormalVolQ dc IR.ShiftedLognormal 0
lognormalVolH <- Vol.relinkableSwaptionVolatilityStructure (Just lognormalVol)
blackEng <- blackSwaptionEngineFromVolatilityStructure discountH lognormalVolH
setPricingEngine swpn blackEng
npvBlack <- npv swpn
npvBlack `shouldSatisfy` (not . isNaN)
abs (npvBachelier - npvBlack) `shouldSatisfy` (> 0.5)
it "Bachelier cap/floor engine prices differently from the Black engine on the same cap" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
(_, discountH, forecastH) <- setupSwap
cal <- Calendar.calendar TARGET
settle <- advance cal (11 `december` 2012) (2, Days) Following False
floatDC <- dayCounter (Actual360 False)
floatSch <- schedule (Just settle) (11 `december` 2017) (6, Months) cal
ModifiedFollowing ModifiedFollowing Forward False Nothing Nothing
idx <- iborIndex Euribor6M (Just forecastH)
leg <- iborLeg floatSch idx [1000000] floatDC ModifiedFollowing [2] [1.0] [0.0] [] [] False False
capfl <- cap leg [0.03]
dc <- dayCounter Actual365FixedStandard
normalVolQ <- Quote.simpleQuote 0.0075
normalVol <- Vol.constantOptionletVolatility (Vol.CalendarReferenceDate (11 `december` 2012)) cal ModifiedFollowing normalVolQ dc IR.Normal 0
normalVolH <- Vol.relinkableOptionletVolatilityStructure (Just normalVol)
bachelierEng <- bachelierCapFloorEngineFromVolatilityStructure discountH normalVolH
setPricingEngine capfl bachelierEng
npvBachelier <- npv capfl
npvBachelier `shouldSatisfy` (not . isNaN)
lognormalVolQ <- Quote.simpleQuote 0.20
lognormalVol <- Vol.constantOptionletVolatility (Vol.CalendarReferenceDate (11 `december` 2012)) cal ModifiedFollowing lognormalVolQ dc IR.ShiftedLognormal 0
lognormalVolH <- Vol.relinkableOptionletVolatilityStructure (Just lognormalVol)
blackEng <- blackCapFloorEngineFromVolatilityStructure discountH lognormalVolH
setPricingEngine capfl blackEng
npvBlack <- npv capfl
npvBlack `shouldSatisfy` (not . isNaN)
abs (npvBachelier - npvBlack) `shouldSatisfy` (> 0.5)
-- A short-rate model built on a relinkable curve is an observer of it too: both
-- HullWhite and ExtendedCoxIngersollRoss register with their Handle<YieldTermStructure>
-- (QuantLib's CalibratedModel::update() recomputes the model's curve-fitting function on
-- notification), so relinking moves the model's own discountBond without rebuilding it --
-- same relink-propagation property as the curve/quote/vol-surface cases above, just
-- surfaced through the model instead of an instrument.
it "relinking the curve updates HullWhite's discount bond without rebuilding the model" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
c <- flat 0.02
th <- relinkableYieldTermStructure (Just c)
model <- hullWhite th 0.1 0.01
am <- asAffineModel model
before <- discountBond am 0.0 5.0 [0.02]
flat 0.05 >>= linkTo th
after <- discountBond am 0.0 5.0 [0.02]
abs (after - before) `shouldSatisfy` (> 0.01)
it "relinking the curve updates ExtendedCoxIngersollRoss's discount bond without rebuilding the model" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
c <- flat 0.02
th <- relinkableYieldTermStructure (Just c)
model <- extendedCoxIngersollRoss th 0.02 1.0 1e-4 0.02 True
am <- asAffineModel model
before <- discountBond am 0.0 5.0 [0.02]
flat 0.05 >>= linkTo th
after <- discountBond am 0.0 5.0 [0.02]
abs (after - before) `shouldSatisfy` (> 0.01)
-- The bidirectional dependency cycle RelinkableHandle actually exists for: two Euribor
-- forecast curves (3m/6m) whose rate helpers reference *each other's* not-yet-bootstrapped
-- handle, resolved by bootstrapping both curves together under one optimizer
-- (GlobalBootstrap) via MultiCurve. Ports upstream's
-- testMultiCurveTwoPiecewiseYieldCurves (piecewiseyieldcurve.cpp).
let curveToday = 23 `october` 2025
tolerance = 1.0e-6 :: Double
setupMultiCurve = do
Context.setEvaluationDate (Just curveToday)
cal <- Calendar.calendar TARGET
euriborDC <- dayCounter (Actual360 False)
thirty360 <- dayCounter Thirty360BondBasis
settleFix <- advance cal curveToday (2, Days) Following False
discQ <- Quote.simpleQuote 0.02
discountCurve <- flatForward (SettlementDays 0 cal) discQ euriborDC IR.Continuous Annual
-- the internal handles: empty until addBootstrappedCurve links them below
intcurve3m <- relinkableYieldTermStructure Nothing
intcurve6m <- relinkableYieldTermStructure Nothing
euribor3m <- iborIndex Euribor3M (Just intcurve3m)
euribor6m <- iborIndex Euribor6M (Just intcurve6m)
q <- Quote.simpleQuote 0.03
b <- Quote.simpleQuote 0.0020
helpers3mFra <- mapM (\i -> fraRateHelper q (FraMonths i (i + 3) 2 cal ModifiedFollowing True euriborDC) LastRelevantDate Nothing False) [1 .. 9]
helpers3mBasis <- mapM (\i -> iborIborBasisSwapRateHelper b (i, Years) 2 cal ModifiedFollowing True euribor3m euribor6m discountCurve True) [2 .. 10]
helpers6mBasis <- mapM (\i -> iborIborBasisSwapRateHelper b (i * 6, Months) 2 cal ModifiedFollowing True euribor3m euribor6m discountCurve False) [1 .. 3]
helpers6mSwap <- mapM (\i -> swapRateHelperFromConventions q (i, Years) cal Annual Following thirty360 euribor6m Nothing (0, Days) (Just discountCurve)
Nothing LastRelevantDate Nothing False Nothing Nothing Nothing) [2 .. 10]
>>= mapM asRateHelper -- swapRateHelperFromConventions returns the concrete SwapRateHelper; upcast to the generic RateHelper the other helpers already are, so the list below is homogeneous
-- helpers3m/helpers6m each reference the *other* curve's not-yet-bootstrapped
-- internal handle (via euribor3m/euribor6m) -- this is exactly the cycle a plain
-- piecewiseYieldCurve (SettlementDays with IterativeBootstrap) can't resolve.
ptr3m <- piecewiseYieldCurve (SettlementDays 0 cal) (fromList (helpers3mFra ++ helpers3mBasis)) euriborDC []
(GlobalDiscountLogLinear 1.0e-10 []) False
ptr6m <- piecewiseYieldCurve (SettlementDays 0 cal) (fromList (helpers6mBasis ++ helpers6mSwap)) euriborDC []
(GlobalDiscountLogLinear 1.0e-10 []) False
mc <- multiCurve 1.0e-10
curve3m <- addBootstrappedCurve mc intcurve3m ptr3m
curve6m <- addBootstrappedCurve mc intcurve6m ptr6m
pure (cal, settleFix, euriborDC, thirty360, euribor3m, euribor6m, q, b, discountCurve, curve3m, curve6m)
it "FRA-implied forward rates match the input quote once the 3m/6m curves are bootstrapped together" $
Context.keepingSettingsGc $ do
(cal, settleFix, _, _, euribor3m, _, q, _, _, curve3m, _) <- setupMultiCurve
qVal <- Quote.value q
mapM_ (\i -> do
-- FraRateHelper::initializeDates computes maturityDate_ as a single advance by
-- (periodToStart + tenor) from the spot date, not two sequential advances --
-- those disagree by a business day here and there (endOfMonth interacts
-- differently with a combined-period vs. chained advance), which is enough to
-- move the FRA off the pillar the helper actually calibrated.
start <- advance cal settleFix (i, Months) ModifiedFollowing True
maturity <- advance cal settleFix (i + 3, Months) ModifiedFollowing True
fra <- Fwd.forwardRateAgreement euribor3m start maturity Long qVal 1.0 (Just curve3m)
rate <- IR.rate <$> Fwd.forwardRate fra
rate `shouldSatisfy` closePrec qVal tolerance
) ([1 .. 9] :: [Int])
it "3m/6m ibor-ibor basis swaps built from the bootstrapped curves reprice to zero" $
Context.keepingSettingsGc $ do
(cal, settleFix, euriborDC, _, euribor3m, euribor6m, _, b, discountCurve, _, _) <- setupMultiCurve
bVal <- Quote.value b
eng <- discountingSwapEngine discountCurve Nothing Nothing Nothing
let checkBasisSwap tenor = do
maturity <- advance cal settleFix tenor ModifiedFollowing True
baseSchedule <- schedule (Just settleFix) maturity (3, Months) cal ModifiedFollowing ModifiedFollowing Forward True Nothing Nothing
otherSchedule <- schedule (Just settleFix) maturity (6, Months) cal ModifiedFollowing ModifiedFollowing Forward True Nothing Nothing
baseLeg <- iborLeg baseSchedule euribor3m [1.0] euriborDC ModifiedFollowing [] [] [bVal] [] [] False False
otherLeg <- iborLeg otherSchedule euribor6m [1.0] euriborDC ModifiedFollowing [] [] [] [] [] False False
sw <- swap baseLeg otherLeg
setPricingEngine sw eng
v <- npv sw
v `shouldSatisfy` closePrec 0 tolerance
mapM_ (\i -> checkBasisSwap (i, Years)) ([2 .. 10] :: [Int])
mapM_ (\i -> checkBasisSwap (i * 6, Months)) ([1 .. 3] :: [Int])
it "a makeVanillaSwap-built 6m swap on the bootstrapped curves reprices to zero" $
Context.keepingSettingsGc $ do
(_, _, _, thirty360, _, euribor6m, q, _, discountCurve, _, _) <- setupMultiCurve
qVal <- Quote.value q
eng <- discountingSwapEngine discountCurve Nothing Nothing Nothing
mapM_ (\i -> do
sw <- makeVanillaSwap (i, Years) euribor6m qVal (0, Days) (Just 2) (1, Years) thirty360
(Just Following) (Just Following) Nothing Nothing Nothing Nothing
setPricingEngine sw eng
v <- npv sw
v `shouldSatisfy` closePrec 0 tolerance
) ([2 .. 10] :: [Word])
-- A MultiCurve member that is not itself solved by the optimizer -- a deterministic
-- function (here, a fixed spread) of another member curve. Ports upstream's
-- testMultiCurvePiecewiseYieldCurveAndSpreadedCurve (piecewiseyieldcurve.cpp): the OIS
-- discounting curve is a spread over the 3m Euribor forecast curve, and the 3m curve's
-- own swap-rate helpers discount off that same OIS curve -- each curve is defined in
-- terms of the other, resolved the same way as the two-curve cycle above via
-- 'addBootstrappedCurve'\/'addNonBootstrappedCurve'.
let setupSpreadedMultiCurve = do
Context.setEvaluationDate (Just curveToday)
cal <- Calendar.calendar TARGET
euriborDC <- dayCounter (Actual360 False)
thirty360 <- dayCounter Thirty360BondBasis
intcurveois <- relinkableYieldTermStructure Nothing
intcurve3m <- relinkableYieldTermStructure Nothing
euribor3m <- iborIndex Euribor3M (Just intcurve3m)
q <- Quote.simpleQuote 0.03
b <- Quote.simpleQuote (-0.01)
-- these helpers discount off intcurveois, which is not yet linked to anything --
-- it is itself a spread over the curve being bootstrapped from these very helpers.
helpers3m <- mapM (\i -> swapRateHelperFromConventions q (i, Years) cal Annual Following thirty360 euribor3m Nothing (0, Days) (Just intcurveois)
Nothing LastRelevantDate Nothing False Nothing Nothing Nothing
>>= asRateHelper) [1 .. 10 :: Int]
ptr3m <- piecewiseYieldCurve (SettlementDays 0 cal) (fromList helpers3m) euriborDC []
(GlobalDiscountLogLinear 1.0e-10 []) False
mc <- multiCurve 1.0e-10
curve3m <- addBootstrappedCurve mc intcurve3m ptr3m
ptrois <- zeroSpreadedTermStructure intcurve3m b IR.Continuous NoFrequency
curveois <- addNonBootstrappedCurve mc intcurveois ptrois
pure (thirty360, euribor3m, q, b, curveois, curve3m)
it "a fixed spread over a bootstrapped curve reprices to that spread" $
Context.keepingSettingsGc $ do
(_, _, _, b, curveois, curve3m) <- setupSpreadedMultiCurve
bVal <- Quote.value b
zOis <- IR.rate <$> zeroRate curveois (RateAtTime 1.0) IR.Continuous NoFrequency False
z3m <- IR.rate <$> zeroRate curve3m (RateAtTime 1.0) IR.Continuous NoFrequency False
(zOis - z3m) `shouldSatisfy` closePrec bVal tolerance
it "swaps priced on the spreaded curve, discounted through the cycle, reprice to zero" $
Context.keepingSettingsGc $ do
(thirty360, euribor3m, q, _, curveois, _) <- setupSpreadedMultiCurve
qVal <- Quote.value q
eng <- discountingSwapEngine curveois Nothing Nothing Nothing
mapM_ (\i -> do
sw <- makeVanillaSwap (i, Years) euribor3m qVal (0, Days) (Just 2) (1, Years) thirty360
(Just Following) (Just Following) Nothing Nothing Nothing Nothing
setPricingEngine sw eng
v <- npv sw
v `shouldSatisfy` closePrec 0 tolerance
) ([1 .. 10] :: [Word])
-- GlobalBootstrap's instrumentWeights: overdetermined instrument sets (more instruments
-- than pillars) are fitted by least squares, weighted per instrument. Ports (the
-- weights-vector half of) upstream's testGlobalBootstrapInstrumentWeights
-- (piecewiseyieldcurve.cpp) -- its curve2, comparing against a custom-penalty functor
-- construction, is not ported: that overload needs GlobalBootstrap's functor-callback
-- constructors, which are not bound (see README's # TODO).
it "instrumentWeights shifts an overdetermined fit toward the more heavily weighted quote" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just curveToday)
cal <- Calendar.calendar TARGET
euriborDC <- dayCounter (Actual360 False)
-- two deposits over the same period at different rates: with no unique fit, the
-- weight on each pins where the (otherwise underdetermined) curve lands.
q1 <- Quote.simpleQuote 0.01
q2 <- Quote.simpleQuote 0.02
h1 <- depositRateHelper q1 (6, Months) 2 cal ModifiedFollowing True euriborDC
h2 <- depositRateHelper q2 (6, Months) 2 cal ModifiedFollowing True euriborDC
let helpers = [h1, h2]
curveMostlyQ2 <- piecewiseYieldCurve (SettlementDays 0 cal) helpers euriborDC []
(GlobalDiscountLogLinear 1.0e-10 [0.1, 0.9]) False
curveMostlyQ1 <- piecewiseYieldCurve (SettlementDays 0 cal) helpers euriborDC []
(GlobalDiscountLogLinear 1.0e-10 [0.9, 0.1]) False
settleFix <- advance cal curveToday (2, Days) Following False
pillar <- advance cal settleFix (6, Months) ModifiedFollowing True
d1 <- discount curveMostlyQ1 (DatePoint pillar) False
d2 <- discount curveMostlyQ2 (DatePoint pillar) False
-- higher weight on the higher rate (q2) means a lower discount factor at the pillar
d2 `shouldSatisfy` (< d1)
-- SimpleZeroYield x Linear is upstream QuantLib-SWIG's only bound GlobalBootstrap
-- combination (GlobalLinearSimpleZeroCurve); Discount x LogLinear is the combination
-- hasquant already had. Both must reprice the same input instruments to the same
-- discount factors *at the pillar dates* (bootstrap forces an exact fit regardless of
-- trait/interpolator), which is what distinguishes "a genuinely different CurveType" from
-- "the enum case aliased and dispatched to the same one" -- see also
-- smoke/CheckSimpleZeroYield.hs, which checks the complementary property (the two curves
-- *disagree* between pillars, since that's where the interpolation differs).
--
-- Uses deposit helpers (not FRAs, like the instrumentWeights test above), deliberately:
-- each DepositRateHelper's equation only involves the common curve-start point and its own
-- maturity, never another helper's pillar, so the bootstrap is well-determined pillar by
-- pillar with no dependence on inter-pillar interpolation shape. A first attempt with FRA
-- helpers here (start dates 1m/2m/3m falling before the first 4m pillar) failed: those
-- FRAs' *start* discount factors are themselves interpolated, and Discount/LogLinear vs.
-- SimpleZeroYield/Linear extrapolate that sub-pillar region differently, so the two curves'
-- solved pillar values genuinely disagreed -- not a test bug, but the wrong instrument
-- choice for isolating "same pillars" from "same interpolation".
it "SimpleZeroYield GlobalBootstrap curve reprices to the same pillar discount factors as Discount" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just curveToday)
cal <- Calendar.calendar TARGET
euriborDC <- dayCounter (Actual360 False)
q <- Quote.simpleQuote 0.03
helpersDiscount <- mapM (\i -> depositRateHelper q (i, Months) 2 cal ModifiedFollowing True euriborDC) [1 .. 5 :: Int]
helpersZero <- mapM (\i -> depositRateHelper q (i, Months) 2 cal ModifiedFollowing True euriborDC) [1 .. 5 :: Int]
discountCurve <- piecewiseYieldCurve (SettlementDays 0 cal) (fromList helpersDiscount) euriborDC []
(GlobalDiscountLogLinear 1.0e-10 []) False
zeroCurve <- piecewiseYieldCurve (SettlementDays 0 cal) (fromList helpersZero) euriborDC []
(GlobalSimpleZeroLinear 1.0e-10 []) False
settleFix <- advance cal curveToday (2, Days) Following False
mapM_ (\i -> do
pillar <- advance cal settleFix (i, Months) ModifiedFollowing True
dDiscount <- discount discountCurve (DatePoint pillar) False
dZero <- discount zeroCurve (DatePoint pillar) False
dZero `shouldSatisfy` closePrec dDiscount tolerance
) ([1 .. 5] :: [Int])
-- SimpleZeroYield is a valid IterativeBootstrap trait. Compare its pillar discounts with
-- Discount to pin the dispatch arm independently of GlobalBootstrap.
it "SimpleZeroYield reprices to the same pillar discount factors as Discount under IterativeBootstrap" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just curveToday)
cal <- Calendar.calendar TARGET
euriborDC <- dayCounter (Actual360 False)
q <- Quote.simpleQuote 0.03
helpersDiscount <- mapM (\i -> depositRateHelper q (i, Months) 2 cal ModifiedFollowing True euriborDC) [1 .. 5 :: Int]
helpersZero <- mapM (\i -> depositRateHelper q (i, Months) 2 cal ModifiedFollowing True euriborDC) [1 .. 5 :: Int]
discountCurve <- piecewiseYieldCurve (SettlementDays 0 cal) (fromList helpersDiscount) euriborDC []
(Iterative Discount Linear defaultIterativeBootstrapOpts) False
zeroCurve <- piecewiseYieldCurve (SettlementDays 0 cal) (fromList helpersZero) euriborDC []
(Iterative SimpleZeroYield Linear defaultIterativeBootstrapOpts) False
settleFix <- advance cal curveToday (2, Days) Following False
mapM_ (\i -> do
pillar <- advance cal settleFix (i, Months) ModifiedFollowing True
dDiscount <- discount discountCurve (DatePoint pillar) False
dZero <- discount zeroCurve (DatePoint pillar) False
dZero `shouldSatisfy` closePrec dDiscount tolerance
) ([1 .. 5] :: [Int])
-- GlobalBootstrap's functor-callback constructor (upstream QuantLib-SWIG's canned
-- AdditionalErrors/AdditionalDates), bound only for SimpleZeroYield x Linear -- the same
-- combination its GlobalLinearSimpleZeroCurve demonstrates. testGlobalBootstrap
-- (piecewiseyieldcurve.cpp) is not ported: its cached
-- expected values are for that test's own bespoke error formula's fixed point, not a
-- property derivable independently here.
--
-- A first version of this test compared two curves whose additionalHelpers "agreed" vs.
-- "disagreed" with the primary instruments, expecting a measurably different fit -- that
-- failed (0.0 difference): with additionalHelpers reusing the primary instruments' own
-- dates, AdditionalErrors' formula is evaluated on quotes the primary curve already fully
-- determines, so it imposes no new constraint and the fit is identical either way. That's
-- a real property of the canned formula (over-determined/degenerate when additionalHelpers
-- duplicates the primary grid), not a bug -- but the wrong property to test here. Testing
-- what the plan actually called for instead: additionalHelpers/additionalDates are present
-- and satisfied without breaking the primary instruments' own fit (each deposit still
-- reprices to its own input quote via the standard simple-compounding relation).
it "GlobalBootstrapFull reprices its own instruments correctly with additionalHelpers/additionalDates present" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just curveToday)
cal <- Calendar.calendar TARGET
euriborDC <- dayCounter (Actual360 False)
settleFix <- advance cal curveToday (2, Days) Following False
q <- Quote.simpleQuote 0.03
qVal <- Quote.value q
helpers <- fromList <$> mapM (\i -> depositRateHelper q (i, Months) 2 cal ModifiedFollowing True euriborDC) [1 .. 5 :: Int]
-- Deliberately *not* coincident with the primary monthly pillars above (45/75/105
-- days sit between the 1m/2m/3m/4m pillars): reusing the same dates as additionalDates
-- gave GlobalBootstrap two unknowns pinned to the same time, which visibly perturbed
-- the first three pillars' solved values (a first version of this test hit that).
extraDates <- mapM (\d -> advance cal settleFix (d, Days) ModifiedFollowing True) [45, 75, 105 :: Int]
-- settl=2, matching the deposit helpers' own fixingDays: otherwise the curve's
-- reference date is curveToday rather than settleFix, and the simple-compounding
-- relation below (which is anchored at settleFix, the deposits' own start) picks up a
-- spurious 2-day discounting gap -- confirmed by comparing against a settl=0 curve,
-- whose discount() came out identical to a plain (non-functor) curve but consistently
-- off from the hand-computed expectation.
curve <- piecewiseYieldCurve (SettlementDays 2 cal) helpers euriborDC []
(GlobalSimpleZeroLinearFull helpers extraDates 1.0e-10) False
mapM_ (\i -> do
pillar <- advance cal settleFix (i, Months) ModifiedFollowing True
-- Actual360's own year fraction: no dedicated QuantLib.yearFraction binding
-- exists (CLAUDE.md's "bind few inspectors" rule), and diffDays/360 reproduces it
-- exactly since Actual360 is a plain actual-days-over-360 day counter.
let tau = fromIntegral (diffDays pillar settleFix) / 360 :: Double
df <- discount curve (DatePoint pillar) False
-- simple-compounding deposit relation: df = 1 / (1 + qVal * tau)
df `shouldSatisfy` closePrec (1 / (1 + qVal * tau)) tolerance
) ([1 .. 5] :: [Int])
-- LocalBootstrap only works with an interpolator providing localInterpolate(), which
-- upstream only ConvexMonotone supplies, so the Local constructor selects ConvexMonotone
-- rather than taking an Interpolation argument. No cached upstream fixture
-- reuses this exact combination, so this checks the same reprices-its-own-instruments
-- property as the GlobalBootstrapFull test above: each deposit still solves back to its
-- own input quote via the standard simple-compounding relation. trait=ForwardRate, not
-- Discount: a standalone raw-QuantLib reproduction (independent of hasquant) showed
-- trait=Discount returns numerically wrong discount factors with LocalBootstrap+
-- ConvexMonotone -- see the QL_FAIL for that combination in qlTermStructureAux.cpp, and
-- upstream's own testLocalBootstrapConsistency, which likewise only exercises ForwardRate.
it "LocalBootstrap reprices its own instruments correctly" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just curveToday)
cal <- Calendar.calendar TARGET
euriborDC <- dayCounter (Actual360 False)
settleFix <- advance cal curveToday (2, Days) Following False
q <- Quote.simpleQuote 0.03
qVal <- Quote.value q
helpers <- fromList <$> mapM (\i -> depositRateHelper q (i, Months) 2 cal ModifiedFollowing True euriborDC) [1 .. 5 :: Int]
curve <- piecewiseYieldCurve (SettlementDays 2 cal) helpers euriborDC []
(Local LForwardRate 2 True 1.0e-10 0.3 0.7 True) False
mapM_ (\i -> do
pillar <- advance cal settleFix (i, Months) ModifiedFollowing True
let tau = fromIntegral (diffDays pillar settleFix) / 360 :: Double
df <- discount curve (DatePoint pillar) False
df `shouldSatisfy` closePrec (1 / (1 + qVal * tau)) tolerance
) ([1 .. 5] :: [Int])
-- piecewiseYieldCurve unifies both anchors and every bootstrapper behind ADTs.
-- Exercise every constructor and check that each curve reprices its own instruments.
it "piecewiseYieldCurve dispatches every Bootstrap constructor to a curve that reprices its own instruments" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just curveToday)
cal <- Calendar.calendar TARGET
euriborDC <- dayCounter (Actual360 False)
settleFix <- advance cal curveToday (2, Days) Following False
q <- Quote.simpleQuote 0.03
qVal <- Quote.value q
helpers <- fromList <$> mapM (\i -> depositRateHelper q (i, Months) 2 cal ModifiedFollowing True euriborDC) [1 .. 5 :: Int]
-- additionalDates for GlobalSimpleZeroLinearFull below: deliberately not coincident
-- with the primary monthly pillars, same reasoning as the GlobalBootstrapFull test above.
extraDates <- mapM (\d -> advance cal settleFix (d, Days) ModifiedFollowing True) [45, 75, 105 :: Int]
let checkCurve curve = mapM_ (\i -> do
pillar <- advance cal settleFix (i, Months) ModifiedFollowing True
let tau = fromIntegral (diffDays pillar settleFix) / 360 :: Double
df <- discount curve (DatePoint pillar) False
df `shouldSatisfy` closePrec (1 / (1 + qVal * tau)) tolerance
) ([1 .. 5] :: [Int])
checkReference reference = do
piecewiseYieldCurve reference helpers euriborDC [] (Iterative ForwardRate Linear defaultIterativeBootstrapOpts) False >>= checkCurve
piecewiseYieldCurve reference helpers euriborDC [] (GlobalDiscountLogLinear 1.0e-10 []) False >>= checkCurve
piecewiseYieldCurve reference helpers euriborDC [] (GlobalSimpleZeroLinear 1.0e-10 []) False >>= checkCurve
piecewiseYieldCurve reference helpers euriborDC [] (GlobalSimpleZeroLinearFull helpers extraDates 1.0e-10) False >>= checkCurve
piecewiseYieldCurve reference helpers euriborDC [] (GlobalForwardRateLinear 1.0e-10 []) False >>= checkCurve
piecewiseYieldCurve reference helpers euriborDC [] (GlobalZeroYieldLinear 1.0e-10 []) False >>= checkCurve
piecewiseYieldCurve reference helpers euriborDC [] (Local LForwardRate 2 True 1.0e-10 0.3 0.7 True) False >>= checkCurve
mapM_ checkReference ([ReferenceDate settleFix, SettlementDays 2 cal] :: [Reference])
-- issue #15: GlobalBootstrap widened to ForwardRate/Linear and ZeroYield/Linear, the other
-- two IterativeBootstrap traits paired with the cheapest interpolator. Same
-- reprices-its-own-instruments property as the SimpleZeroYield GlobalBootstrap test above,
-- through the common piecewiseYieldCurve dispatcher.
it "ForwardRate/ZeroYield GlobalBootstrap curves reprice to the same pillar discount factors as Discount" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just curveToday)
cal <- Calendar.calendar TARGET
euriborDC <- dayCounter (Actual360 False)
settleFix <- advance cal curveToday (2, Days) Following False
q <- Quote.simpleQuote 0.03
helpers <- fromList <$> mapM (\i -> depositRateHelper q (i, Months) 2 cal ModifiedFollowing True euriborDC) [1 .. 5 :: Int]
discountCurve <- piecewiseYieldCurve (SettlementDays 0 cal) helpers euriborDC []
(GlobalDiscountLogLinear 1.0e-10 []) False
forwardCurve <- piecewiseYieldCurve (SettlementDays 0 cal) helpers euriborDC []
(GlobalForwardRateLinear 1.0e-10 []) False
zeroCurve <- piecewiseYieldCurve (SettlementDays 0 cal) helpers euriborDC []
(GlobalZeroYieldLinear 1.0e-10 []) False
mapM_ (\i -> do
pillar <- advance cal settleFix (i, Months) ModifiedFollowing True
dfDiscount <- discount discountCurve (DatePoint pillar) False
dfForward <- discount forwardCurve (DatePoint pillar) False
dfZero <- discount zeroCurve (DatePoint pillar) False
dfForward `shouldSatisfy` closePrec dfDiscount tolerance
dfZero `shouldSatisfy` closePrec dfDiscount tolerance
) ([1 .. 5] :: [Int])
-- PiecewiseBlackVarianceSurface::makeFromGrid: upstream's testMakeFromGrid
-- (test-suite/piecewiseblackvariancesurface.cpp) has no cached NPV fixture, only
-- analytical self-consistency checks (exact reprice at grid nodes, etc). Check the
-- reprice-at-a-grid-node property indirectly through pricing: a European option struck and
-- expiring exactly at a grid node must reprice identically under the piecewise surface and
-- under a flat blackConstantVol at that node's own vol, since both surfaces have the same
-- variance there.
describe "BlackVolTermStructure blackVol/blackVolVariance/blackForwardVol/blackForwardVariance/minStrike/maxStrike" $
it "agree between DatePoint/TimePoint and DateInterval/TimeInterval coordinates, and expose generic strike bounds" $
Context.keepingSettingsGc $ do
let refDate = 11 `december` 2012
d1 = 11 `june` 2013
d2 = 11 `december` 2013
strike = 100
tolerance = 1.0e-6 :: Double
Context.setEvaluationDate (Just refDate)
cal <- Calendar.calendar TARGET
q <- Quote.simpleQuote 0.20
dc <- dayCounter Actual365FixedStandard
surface <- Vol.blackConstantVol (Vol.CalendarReferenceDate refDate) cal q dc
t1 <- timeFromReference surface d1
t2 <- timeFromReference surface d2
volAtDate <- Vol.blackVol surface (DatePoint d1) strike False
volAtTime <- Vol.blackVol surface (TimePoint t1) strike False
volAtDate `shouldSatisfy` closePrec volAtTime tolerance
varAtDate <- Vol.blackVolVariance surface (DatePoint d1) strike False
varAtTime <- Vol.blackVolVariance surface (TimePoint t1) strike False
varAtDate `shouldSatisfy` closePrec varAtTime tolerance
-- constant-vol identity: variance = vol^2 * t
varAtDate `shouldSatisfy` closePrec (0.20 * 0.20 * t1) tolerance
fwdVolDates <- Vol.blackForwardVol surface (DateInterval d1 d2) strike False
fwdVolTimes <- Vol.blackForwardVol surface (TimeInterval t1 t2) strike False
fwdVolDates `shouldSatisfy` closePrec fwdVolTimes tolerance
fwdVarDates <- Vol.blackForwardVariance surface (DateInterval d1 d2) strike False
fwdVarTimes <- Vol.blackForwardVariance surface (TimeInterval t1 t2) strike False
fwdVarDates `shouldSatisfy` closePrec fwdVarTimes tolerance
-- upstream identity: forward variance between two points is the variance difference
varAtD2 <- Vol.blackVolVariance surface (DatePoint d2) strike False
fwdVarDates `shouldSatisfy` closePrec (varAtD2 - varAtDate) tolerance
-- BlackConstantVol::minStrike/maxStrike return QL_MIN_REAL/QL_MAX_REAL: exercise the
-- generic 'HasStrikeBounds (GenVolatilityTermStructure v)' instance through a real
-- BlackVolTermStructure value, distinct from the CallableBondVolatilityStructure
-- instance already covered below.
minK <- Vol.minStrike surface
maxK <- Vol.maxStrike surface
minK `shouldSatisfy` (< -1.0e300)
maxK `shouldSatisfy` (> 1.0e300)
describe "piecewise Black variance surface" $
it "reproduces the input vol exactly at a grid node" $
Context.keepingSettingsGc $ do
let refDate = 11 `december` 2012
otherDate = 11 `june` 2013
nodeDate = 11 `december` 2013
nodeStrike = 100
nodeVol = 0.22
tolerance = 1.0e-6 :: Double
Context.setEvaluationDate (Just refDate)
underQ <- Quote.simpleQuote 100
riskFreeQ <- Quote.simpleQuote 0.03
dc <- dayCounter Actual365FixedStandard
ts <- flatForward (ReferenceDate refDate) riskFreeQ dc IR.Continuous Annual
divQ <- Quote.simpleQuote 0.0
divTS <- flatForward (ReferenceDate refDate) divQ dc IR.Continuous Annual
cal <- Calendar.calendar TARGET
let mkNpv vol = do
proc <- blackScholesMertonProcess underQ divTS ts vol EulerDiscretization False
opt <- vanillaOption (PlainVanilla (PlainVanillaPayoff Call nodeStrike))
(European (EuropeanExercise nodeDate))
analyticEuropeanEngine proc Nothing >>= setPricingEngine opt
npv opt
let volMatrix = either error id $ realMatrixFromVector 3 2 $ V.fromList
[ 0.30, 0.28
, 0.20, nodeVol
, 0.35, 0.32
]
piecewise <- Vol.piecewiseBlackVarianceSurface refDate [otherDate, nodeDate]
[80, 100, 120] volMatrix dc
q <- Quote.simpleQuote nodeVol
flat <- Vol.blackConstantVol (Vol.CalendarReferenceDate refDate) cal q dc
npvPiecewise <- mkNpv piecewise
npvFlat <- mkNpv flat
npvPiecewise `shouldSatisfy` closePrec npvFlat tolerance
-- BlackVolatilitySurfaceDelta: cached fixture ported from upstream's
-- testBlackVolSurfaceDeltaNonConstantVol (test-suite/blackvolsurfacedelta.cpp), which
-- exercises blackVolSmile directly -- the one binding-specific getter this class adds over
-- the generic BlackVolTermStructure.
describe "black volatility surface delta" $
it "reproduces upstream's cached smile volatilities" $
Context.keepingSettingsGc $ do
let refDate = 1 `january` 2010
atmStrike = 1.18
tolerance = 1.0e-8 :: Double
Context.setEvaluationDate (Just refDate)
d1M <- addPeriod refDate (1, Months)
d6M <- addPeriod refDate (6, Months)
d1Y <- addPeriod refDate (1, Years)
d2Y <- addPeriod refDate (2, Years)
d15D <- addPeriod refDate (15, Days)
d3M <- addPeriod refDate (3, Months)
dc <- dayCounter ActualActualISDA
cal <- Calendar.calendar TARGET
spot <- Quote.simpleQuote 1.18
dtsQ <- Quote.simpleQuote 0.02
dts <- flatForward (SettlementDays 0 cal) dtsQ dc IR.Continuous Annual
ftsQ <- Quote.simpleQuote 0.035
fts <- flatForward (SettlementDays 0 cal) ftsQ dc IR.Continuous Annual
let vols = either error id $ realMatrixFromVector 4 3 $ V.fromList
[ 0.15, 0.13, 0.135
, 0.14, 0.11, 0.125
, 0.13, 0.10, 0.12
, 0.125, 0.095, 0.115
]
surface <- Vol.blackVolatilitySurfaceDelta refDate [d1M, d6M, d1Y, d2Y] [-0.25] [0.25] True vols
dc cal spot dts fts
smile1M <- Vol.blackVolSmile surface (Vol.DatePoint d1M)
vol1M <- Vol.smileSectionVolatility smile1M atmStrike
vol1M `shouldSatisfy` closePrec 0.13010360399 tolerance
t1M <- yearFraction dc refDate d1M Nothing Nothing
smile1MAtTime <- Vol.blackVolSmile surface (Vol.TimePoint t1M)
vol1MAtTime <- Vol.smileSectionVolatility smile1MAtTime atmStrike
vol1MAtTime `shouldSatisfy` closePrec vol1M tolerance
smile15D <- Vol.blackVolSmile surface (Vol.DatePoint d15D)
vol15D <- Vol.smileSectionVolatility smile15D atmStrike
vol15D `shouldSatisfy` closePrec 0.13007226607 tolerance
smile3M <- Vol.blackVolSmile surface (Vol.DatePoint d3M)
vol3M <- Vol.smileSectionVolatility smile3M atmStrike
vol3M `shouldSatisfy` closePrec 0.115077252583 tolerance
smile6M <- Vol.blackVolSmile surface (Vol.DatePoint d6M)
volLow <- Vol.smileSectionVolatility smile6M 1.10
volHigh <- Vol.smileSectionVolatility smile6M 1.30
volLow `shouldSatisfy` closePrec 0.1411379628132 tolerance
volHigh `shouldSatisfy` closePrec 0.136291154962 tolerance
-- The plain-Matrix constructor
-- above always uses SmileLinear; this guards that 'Vol.CubicSpline' (reached only via the
-- full options-record entry point) is actually wired to a different upstream enum value --
-- an off-grid strike is where the two interpolation schemes have room to disagree, so an
-- equal result there would mean SmileInterpolationMethod's mapping had gone stale.
describe "black volatility surface delta (SmileInterpolationMethod)" $
it "CubicSpline disagrees with SmileLinear at an off-grid strike" $
Context.keepingSettingsGc $ do
let refDate = 1 `january` 2010
offGridStrike = 1.15
Context.setEvaluationDate (Just refDate)
d1M <- addPeriod refDate (1, Months)
d6M <- addPeriod refDate (6, Months)
d1Y <- addPeriod refDate (1, Years)
d2Y <- addPeriod refDate (2, Years)
dc <- dayCounter ActualActualISDA
cal <- Calendar.calendar TARGET
spot <- Quote.simpleQuote 1.18
dtsQ <- Quote.simpleQuote 0.02
dts <- flatForward (SettlementDays 0 cal) dtsQ dc IR.Continuous Annual
ftsQ <- Quote.simpleQuote 0.035
fts <- flatForward (SettlementDays 0 cal) ftsQ dc IR.Continuous Annual
let vols = either error id $ realMatrixFromVector 4 3 $ V.fromList
[ 0.15, 0.13, 0.135
, 0.14, 0.11, 0.125
, 0.13, 0.10, 0.12
, 0.125, 0.095, 0.115
]
linearOpts = Vol.defaultBlackVolatilitySurfaceDeltaOpts
cubicOpts = linearOpts { Vol.bvsdInterpolationMethod = Vol.CubicSpline }
surfaceLinear <- Vol.blackVolatilitySurfaceDeltaWithOptions refDate [d1M, d6M, d1Y, d2Y] [-0.25] [0.25] True vols
dc cal spot dts fts linearOpts
surfaceCubic <- Vol.blackVolatilitySurfaceDeltaWithOptions refDate [d1M, d6M, d1Y, d2Y] [-0.25] [0.25] True vols
dc cal spot dts fts cubicOpts
smileLinear <- Vol.blackVolSmile surfaceLinear (Vol.DatePoint d6M)
smileCubic <- Vol.blackVolSmile surfaceCubic (Vol.DatePoint d6M)
volLinear <- Vol.smileSectionVolatility smileLinear offGridStrike
volCubic <- Vol.smileSectionVolatility smileCubic offGridStrike
volLinear `shouldNotBe` volCubic
-- ConstantExtrapolation
-- and InterpolatorDefaultExtrapolation agree everywhere *inside* the strike grid (both
-- reproduce the interpolated surface there), so an in-grid query would pass no matter how
-- the enum is wired -- this queries a strike strictly above the grid's maximum strike,
-- where the two diverge. Same shape of guard as the SmileInterpolationMethod check above.
describe "FixedLocalVolSurface extrapolation" $
it "ConstantExtrapolation and InterpolatorDefaultExtrapolation disagree off-grid" $
Context.keepingSettingsGc $ do
let refDate = 15 `january` 2024
queryDate = 15 `july` 2025
offGridStrike = 200
dates <- mapM (\y -> addPeriod refDate (y, Years)) [1, 2, 3 :: Int]
let strikes = [80, 100, 120]
-- deliberately curved along both axes -- an affine surface would extrapolate
-- identically under either scheme, which would make the check vacuous
localVolMatrix = either error id $ realMatrixFromVector 3 3 $ V.fromList
[ 0.30, 0.26, 0.24
, 0.20, 0.18, 0.17
, 0.28, 0.25, 0.23
]
dc <- dayCounter Actual365FixedStandard
let localVolUnder extrap = do
surf <- Vol.fixedLocalVolSurface refDate dates strikes localVolMatrix dc extrap extrap
Vol.localVol surf queryDate offGridStrike True
constant <- localVolUnder Vol.FixedLocalVolSurfaceConstantExtrapolation
interpDefault <- localVolUnder Vol.FixedLocalVolSurfaceInterpolatorDefaultExtrapolation
abs (constant - interpDefault) / constant `shouldSatisfy` (> 1e-4)
-- ported from test-suite/noarbsabr.cpp::testConsistencyWithHagan (params from Doust's paper,
-- figure 3): a proper (arbitrage-free, Doust) 'noArbSabrSmileSection' should closely reproduce
-- Hagan's classic 'sabrSmileSection' formula away from the singular low-strike region where
-- the two are known to diverge. upstream's own 'testAbsorptionMatrix' case and the
-- absorptionProbability check inside this same case aren't ported: both need
-- NoArbSabrModel::absorptionProbability/the internal detail::D0Interpolator, neither of which
-- is part of any public QuantLib API to bind.
describe "NoArbSabrSmileSection vs. SabrSmileSection (Hagan) consistency" $
it "prices/digital-prices/densities agree closely across a strike sweep" $ do
let tau = 1.0; beta = 0.5; alpha = 0.026; rho = -0.1; nu = 0.4; f = 0.0488
strikes = [0.0001, 0.0011 .. 0.1491] :: [Double]
sabr <- Vol.sabrSmileSection tau f alpha beta nu rho 0 IR.ShiftedLognormal
noarb <- Vol.noArbSabrSmileSection (RateAtTime tau) f alpha beta nu rho 0 IR.ShiftedLognormal
forM_ strikes $ \strike -> do
sabrPrice <- Vol.smileSectionOptionPrice sabr strike Call 1.0
noarbPrice <- Vol.smileSectionOptionPrice noarb strike Call 1.0
abs (sabrPrice - noarbPrice) `shouldSatisfy` (< 1e-5)
sabrDigital <- Vol.smileSectionDigitalOptionPrice sabr strike Call 1.0 1.0e-5
noarbDigital <- Vol.smileSectionDigitalOptionPrice noarb strike Call 1.0 1.0e-5
abs (sabrDigital - noarbDigital) `shouldSatisfy` (< 1e-3)
sabrDensity <- Vol.smileSectionDensity sabr strike 1.0 1.0e-4
noarbDensity <- Vol.smileSectionDensity noarb strike 1.0 1.0e-4
abs (sabrDensity - noarbDensity) `shouldSatisfy` (< 1.0)
-- ported from test-suite/svivolatility.cpp::testSviSmileSection: at the strike where
-- log-moneyness k equals m, the SVI total-variance formula
-- a + b*(rho*(k-m) + sqrt((k-m)^2+sigma^2)) collapses to a + b*sigma, an exact
-- closed-form check (not a numerical-tolerance one).
describe "SviSmileSection" $
it "atmLevel is the forward, and variance at k=m collapses to a + b*sigma" $
Context.keepingSettingsGc $ do
let today' = 1 `march` 2010
expiry = addDays 11 today'
forward = 123.45
a = -0.0666; b = 0.229; sigma = 0.337; rho = 0.439; m = 0.193
strike = forward * exp m
Context.setEvaluationDate (Just today')
dc <- dayCounter Actual365FixedStandard
svi <- Vol.sviSmileSection expiry forward a b sigma rho m dc
Vol.smileSectionAtmLevel svi `shouldReturn` forward
variance <- Vol.smileSectionVariance svi strike
variance `shouldSatisfy` closePrec (a + b * sigma) 1.0e-8
-- SwaptionVolatilityMatrix (fixed reference date, fixed market data): no upstream cached
-- fixture applies here, since test-suite/swaptionvolatilitymatrix.cpp only exercises the
-- Handle<Quote>-based ("floating market data") overload, not the plain-Matrix one bound
-- here. Self-consistency checks instead: a constant grid must agree with the existing
-- flat-vol constructor, and a grid with distinct cells must reproduce each cell's input
-- exactly at its own (option tenor, swap tenor) node.
describe "swaption volatility matrix" $ do
let optionTenors = [(1, Years), (5, Years)]
swapTenors = [(2, Years), (10, Years)]
refDate = 11 `december` 2012
it "dispatches every option- and swap-maturity representation" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just refDate)
cal <- Calendar.calendar TARGET
dc <- dayCounter Actual365FixedStandard
volQ <- Quote.simpleQuote 0.20
flatVol <- Vol.constantSwaptionVolatility (Vol.CalendarReferenceDate refDate) cal ModifiedFollowing volQ dc IR.ShiftedLognormal 0
optionDate <- advance cal refDate (1, Years) ModifiedFollowing False
let coordinates :: [(Vol.OptionMaturity, Vol.SwapMaturity)]
coordinates =
[ (Vol.OptionDate optionDate, Vol.SwapLength 2.0)
, (Vol.OptionDate optionDate, Vol.SwapTenor (2, Years))
, (Vol.OptionTime 1.0, Vol.SwapLength 2.0)
, (Vol.OptionTime 1.0, Vol.SwapTenor (2, Years))
, (Vol.OptionTenor (1, Years), Vol.SwapLength 2.0)
, (Vol.OptionTenor (1, Years), Vol.SwapTenor (2, Years))
]
forM_ coordinates $ \(optionMaturity, swapMaturity) -> do
v <- Vol.swaptionVolatility flatVol optionMaturity swapMaturity 0.02 False
v `shouldBe` 0.20
variance <- Vol.swaptionBlackVariance flatVol optionMaturity swapMaturity 0.02 False
variance `shouldSatisfy` (> 0)
smile <- Vol.smileSection flatVol optionMaturity swapMaturity False
smileVol <- Vol.smileSectionVolatility smile 0.02
smileVol `shouldSatisfy` closePrec 0.20 1.0e-12
it "a constant grid agrees with constantSwaptionVolatility at the same point" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just refDate)
cal <- Calendar.calendar TARGET
dc <- dayCounter Actual365FixedStandard
let v = 0.20
shiftMatrix = either error id $ realMatrixFromVector 0 0 V.empty
volQuotes <- replicateM 4 (Quote.simpleQuote v)
let volMatrix = either error id $ objectMatrix 2 2 volQuotes
grid <- Vol.swaptionVolatilityMatrix refDate cal ModifiedFollowing optionTenors swapTenors
volMatrix dc False IR.ShiftedLognormal shiftMatrix
volQ <- Quote.simpleQuote v
flatVol <- Vol.constantSwaptionVolatility (Vol.CalendarReferenceDate refDate) cal ModifiedFollowing volQ dc IR.ShiftedLognormal 0
optionDate <- advance cal refDate (1, Years) ModifiedFollowing False
fromGrid <- Vol.swaptionVolatility grid (Vol.OptionDate optionDate) (Vol.SwapTenor (2, Years)) 0.02 False
fromFlat <- Vol.swaptionVolatility flatVol (Vol.OptionDate optionDate) (Vol.SwapTenor (2, Years)) 0.02 False
abs (fromGrid - fromFlat) `shouldSatisfy` (< 1.0e-6 * max 1 (abs fromFlat))
it "recovers each cell's input volatility exactly at its own grid node" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just refDate)
cal <- Calendar.calendar TARGET
dc <- dayCounter Actual365FixedStandard
-- rows are option tenors, columns are swap tenors, matching SwaptionVolatilityMatrix's
-- own row/column convention (M[i][j] = i-th option date, j-th swap tenor)
let vols = [[0.10, 0.20], [0.30, 0.40]]
shiftMatrix = either error id $ realMatrixFromVector 0 0 V.empty
volQuotes <- mapM Quote.simpleQuote (concat vols)
let volMatrix = either error id $ objectMatrix 2 2 volQuotes
grid <- Vol.swaptionVolatilityMatrix refDate cal ModifiedFollowing optionTenors swapTenors
volMatrix dc False IR.ShiftedLognormal shiftMatrix
optionDates <- mapM (\(n, u) -> advance cal refDate (fromIntegral n, u) ModifiedFollowing False) optionTenors
let nodes = [(od, st, expected)
| (od, oVols) <- zip optionDates vols
, (st, expected) <- zip swapTenors oVols]
mapM_ (\(od, st, expected) -> do
v <- Vol.swaptionVolatility grid (Vol.OptionDate od) (Vol.SwapTenor st) 0.02 False
abs (v - expected) `shouldSatisfy` (< 1.0e-6)
) nodes
-- The grid's own lowest corner locates to (0, 0).
case (optionDates, swapTenors) of
(od0:_, st0:_) -> do
(i0, j0) <- Vol.swaptionVolatilityMatrixLocate grid od0 st0
i0 `shouldBe` 0
j0 `shouldBe` 0
_ -> expectationFailure "expected at least one option date and one swap tenor"
-- SabrSwaptionVolatilityCube/InterpolatedSwaptionVolatilityCube: no upstream cached fixture
-- ported here (test-suite/swaptionvolatilitycube.cpp's CommonVars fixture is shared, nontrivial
-- hand-work disproportionate to this item). Self-consistency checks
-- instead: a zero-vol-spread cube should reprice close to its own flat ATM input (SABR
-- calibration is a least-squares fit, not exact recovery, so the tolerance here is much looser
-- than the exact-grid-recovery checks above), and the diagnostic getters should report
-- plausible, correctly-shaped output.
describe "swaption volatility cubes" $ do
let optionTenors = [(1, Years), (5, Years)]
swapTenors = [(2, Years), (10, Years)]
strikeSpreads = [-0.01, 0.0, 0.01]
refDate = 11 `december` 2012
flatVol = 0.20
mkFixture = do
Context.setEvaluationDate (Just refDate)
cal <- Calendar.calendar TARGET
dc <- dayCounter Actual365FixedStandard
fwdRateQ <- Quote.simpleQuote 0.03
fwdCurve <- flatForward (SettlementDays 0 cal) fwdRateQ dc IR.Continuous Annual
swapIndexBase <- liborSwapIndex EurLiborSwapIsdaFixA (10, Years) (Just fwdCurve) (Just fwdCurve)
shortSwapIndexBase <- liborSwapIndex EurLiborSwapIsdaFixA (1, Years) (Just fwdCurve) (Just fwdCurve)
volQ <- Quote.simpleQuote flatVol
atmVol <- Vol.constantSwaptionVolatility (Vol.CalendarReferenceDate refDate) cal ModifiedFollowing volQ dc IR.ShiftedLognormal 0
zeroSpreadQuotes <- replicateM (length optionTenors * length swapTenors * length strikeSpreads) (Quote.simpleQuote 0)
let volSpreads = either error id $ objectMatrix (fromIntegral (length optionTenors * length swapTenors)) (fromIntegral (length strikeSpreads)) zeroSpreadQuotes
guessQuotes <- concat <$> replicateM (length optionTenors * length swapTenors) (mapM Quote.simpleQuote [0.03, 0.5, 0.3, 0.0])
let parametersGuess = either error id $ objectMatrix (fromIntegral (length optionTenors * length swapTenors)) 4 guessQuotes
pure (cal, dc, atmVol, swapIndexBase, shortSwapIndexBase, volSpreads, parametersGuess)
it "sabrSwaptionVolatilityCube reprices close to its own flat ATM input at zero spread" $
Context.keepingSettingsGc $ do
(_, _, atmVol, swapIndexBase, shortSwapIndexBase, volSpreads, parametersGuess) <- mkFixture
cube <- Vol.sabrSwaptionVolatilityCube atmVol optionTenors swapTenors strikeSpreads volSpreads
swapIndexBase shortSwapIndexBase False parametersGuess
-- beta fixed: 3 strikeSpreads can't identify 4 free SABR params
-- ("less functions than available variables"), so pin beta at the guess.
False True False False False Nothing Nothing False 50 False 0.0001 Nothing Nothing
v <- Vol.swaptionVolatility cube (Vol.OptionDate (10 `december` 2013)) (Vol.SwapTenor (2, Years)) 0.03 False
-- SABR calibration is a least-squares fit, not exact recovery, so this is deliberately a
-- much looser tolerance than the exact-grid-recovery checks above -- don't tighten it.
abs (v - flatVol) `shouldSatisfy` (< 1.0e-2)
it "sabrSwaptionVolatilityCube's diagnostic getters report plausible, correctly-shaped output" $
Context.keepingSettingsGc $ do
(_, _, atmVol, swapIndexBase, shortSwapIndexBase, volSpreads, parametersGuess) <- mkFixture
cube <- Vol.sabrSwaptionVolatilityCube atmVol optionTenors swapTenors strikeSpreads volSpreads
swapIndexBase shortSwapIndexBase False parametersGuess
-- beta fixed: 3 strikeSpreads can't identify 4 free SABR params
-- ("less functions than available variables"), so pin beta at the guess.
-- isAtmCalibrated = False here, deliberately: upstream's isAtmCalibrated=True
-- path (fillVolatilityCube) dynamic_pointer_casts atmVolStructure to
-- SwaptionVolatilityDiscrete and dereferences the result unchecked, which
-- segfaults (boost "px != 0") when atmVolStructure is a flat
-- ConstantSwaptionVolatility, as this fixture's atmVol is -- it would need a
-- discrete grid structure (e.g. swaptionVolatilityMatrix) instead. Exercising
-- that path is out of scope for this shape/sanity test.
False True False False False Nothing Nothing False 50 False 0.0001 Nothing Nothing
-- trigger calibration (lazy -- see the shim comment on qlSabrSwaptionVolatilityCube)
_ <- Vol.swaptionVolatility cube (Vol.OptionDate (10 `december` 2013)) (Vol.SwapTenor (2, Years)) 0.03 False
let n = fromIntegral (length optionTenors * length swapTenors)
sparse <- Vol.sparseSabrParameters cube
realMatrixRows sparse `shouldBe` n
-- 2 metadata columns (swapLength, optionTime) + 4 SABR params + forward/error/maxError/endCriteria
realMatrixColumns sparse `shouldBe` 10
-- denseSabrParameters is only ever populated when the cube was built with
-- isAtmCalibrated = True (see the ctor body: denseParameters_ is never assigned
-- otherwise, staying at its empty default-Cube state) -- assert that documented
-- behavior rather than a populated shape. volCubeAtmCalibrated, by contrast, is always
-- set to a copy of marketVolCube_ regardless of isAtmCalibrated, so it's populated here.
dense <- Vol.denseSabrParameters cube
realMatrixRows dense `shouldBe` 0
market <- Vol.marketVolCube cube
realMatrixRows market `shouldBe` n
realMatrixColumns market `shouldBe` (fromIntegral (length strikeSpreads) + 2)
atmCalibrated <- Vol.volCubeAtmCalibrated cube
realMatrixRows atmCalibrated `shouldBe` n
realMatrixColumns atmCalibrated `shouldBe` (fromIntegral (length strikeSpreads) + 2)
-- alpha/nu are positive, rho within [-1,1] at every calibrated node (columns 2,4,5, 0-indexed)
let byRow cols = [realMatrixData sparse V.! (r * fromIntegral (realMatrixColumns sparse) + c) | r <- [0 .. fromIntegral n - 1], c <- cols]
mapM_ (`shouldSatisfy` (> 0)) (byRow [2])
mapM_ (`shouldSatisfy` (> 0)) (byRow [4])
mapM_ (`shouldSatisfy` (\r -> r >= -1 && r <= 1)) (byRow [5])
it "atmStrike returns a finite, plausible rate for a SABR cube" $
Context.keepingSettingsGc $ do
(_, _, atmVol, swapIndexBase, shortSwapIndexBase, volSpreads, parametersGuess) <- mkFixture
cube <- Vol.sabrSwaptionVolatilityCube atmVol optionTenors swapTenors strikeSpreads volSpreads
swapIndexBase shortSwapIndexBase False parametersGuess
-- beta fixed: 3 strikeSpreads can't identify 4 free SABR params
-- ("less functions than available variables"), so pin beta at the guess.
False True False False False Nothing Nothing False 50 False 0.0001 Nothing Nothing
k <- Vol.atmStrike cube (Vol.AtmStrikeTenor (1, Years)) (2 :: Word, Years)
k `shouldSatisfy` (\x -> x > -0.05 && x < 0.20)
kAtDate <- Vol.atmStrike cube (Vol.AtmStrikeDate (10 `december` 2013)) (2 :: Word, Years)
kAtDate `shouldSatisfy` (\x -> x > -0.05 && x < 0.20)
-- Drop Haskell's EndCriteria and OptimizationMethod references before collection. The cube
-- must retain shared ownership of both calibration objects.
it "keeps a caller-supplied EndCriteria/OptimizationMethod alive past Haskell's own GC" $
Context.keepingSettingsGc $ do
(_, _, atmVol, swapIndexBase, shortSwapIndexBase, volSpreads, parametersGuess) <- mkFixture
cube <- do
let endCriteria = EndCriteria 1000 100 1.0e-8 1.0e-8 1.0e-8
optMethod = Simplex 0.1
Vol.sabrSwaptionVolatilityCube atmVol optionTenors swapTenors strikeSpreads volSpreads
swapIndexBase shortSwapIndexBase False parametersGuess
False True False False False Nothing Nothing False 50 False 0.0001
(Just endCriteria) (Just optMethod)
k <- Vol.atmStrike cube (Vol.AtmStrikeTenor (1, Years)) (2 :: Word, Years)
k `shouldSatisfy` (\x -> x > -0.05 && x < 0.20)
-- NoArbSabrSwaptionVolatilityCube is the same XabrSwaptionVolatilityCube construction one
-- model policy over (arbitrage-free SABR instead of Hagan-formula SABR) -- same fixture,
-- same self-consistency shape as the sabrSwaptionVolatilityCube checks above. The fixture's
-- parametersGuess (alpha=0.03, beta=0.5, nu=0.3, rho=0.0 at forward=0.03) already satisfies
-- NoArbSabrModel's admissible domain (sigmaI = alpha*forward^(beta-1) ~= 0.17, within
-- [0.05,1.00]; beta within [0.01,0.99]; nu within [0.01,0.80]; rho within [-0.99,0.99]).
it "noArbSabrSwaptionVolatilityCube reprices close to its own flat ATM input at zero spread" $
Context.keepingSettingsGc $ do
(_, _, atmVol, swapIndexBase, shortSwapIndexBase, volSpreads, parametersGuess) <- mkFixture
cube <- Vol.noArbSabrSwaptionVolatilityCube atmVol optionTenors swapTenors strikeSpreads volSpreads
swapIndexBase shortSwapIndexBase False parametersGuess
-- beta fixed: 3 strikeSpreads can't identify 4 free SABR params
-- ("less functions than available variables"), so pin beta at the guess.
False True False False False Nothing Nothing False 50 False 0.0001 Nothing Nothing
v <- Vol.swaptionVolatility cube (Vol.OptionDate (10 `december` 2013)) (Vol.SwapTenor (2, Years)) 0.03 False
-- least-squares fit, not exact recovery -- same looser tolerance as the SABR cube check.
abs (v - flatVol) `shouldSatisfy` (< 1.0e-2)
it "atmStrike returns a finite, plausible rate for a no-arbitrage SABR cube" $
Context.keepingSettingsGc $ do
(_, _, atmVol, swapIndexBase, shortSwapIndexBase, volSpreads, parametersGuess) <- mkFixture
cube <- Vol.noArbSabrSwaptionVolatilityCube atmVol optionTenors swapTenors strikeSpreads volSpreads
swapIndexBase shortSwapIndexBase False parametersGuess
False True False False False Nothing Nothing False 50 False 0.0001 Nothing Nothing
k <- Vol.atmStrike cube (Vol.AtmStrikeTenor (1, Years)) (2 :: Word, Years)
k `shouldSatisfy` (\x -> x > -0.05 && x < 0.20)
kAtDate <- Vol.atmStrike cube (Vol.AtmStrikeDate (10 `december` 2013)) (2 :: Word, Years)
kAtDate `shouldSatisfy` (\x -> x > -0.05 && x < 0.20)
it "interpolatedSwaptionVolatilityCube reprices close to its own flat ATM input at zero spread" $
Context.keepingSettingsGc $ do
(_, _, atmVol, swapIndexBase, shortSwapIndexBase, volSpreads, _) <- mkFixture
cube <- Vol.interpolatedSwaptionVolatilityCube atmVol optionTenors swapTenors strikeSpreads volSpreads
swapIndexBase shortSwapIndexBase False
v <- Vol.swaptionVolatility cube (Vol.OptionDate (10 `december` 2013)) (Vol.SwapTenor (2, Years)) 0.03 False
abs (v - flatVol) `shouldSatisfy` (< 1.0e-2)
k <- Vol.atmStrike cube (Vol.AtmStrikeTenor (1, Years)) (2 :: Word, Years)
k `shouldSatisfy` (\x -> x > -0.05 && x < 0.20)
kAtDate <- Vol.atmStrike cube (Vol.AtmStrikeDate (10 `december` 2013)) (2 :: Word, Years)
kAtDate `shouldSatisfy` (\x -> x > -0.05 && x < 0.20)
it "interpolatedSwaptionVolatilityCubeVolSpreads reports the zero spreads the cube was built with" $
Context.keepingSettingsGc $ do
(_, _, atmVol, swapIndexBase, shortSwapIndexBase, volSpreads, _) <- mkFixture
cube <- Vol.interpolatedSwaptionVolatilityCube atmVol optionTenors swapTenors strikeSpreads volSpreads
swapIndexBase shortSwapIndexBase False
mapM_ (\i -> do
m <- Vol.interpolatedSwaptionVolatilityCubeVolSpreads cube i
realMatrixRows m `shouldBe` fromIntegral (length optionTenors)
realMatrixColumns m `shouldBe` fromIntegral (length swapTenors)
realMatrixData m `shouldSatisfy` V.all (== 0)
) ([0 .. fromIntegral (length strikeSpreads) - 1] :: [Word])
-- Fixture from QuantLib's test-suite/fdheston.cpp testFdmHestonConvergence (first row of its
-- HestonTestData table), which compares FdHestonVanillaEngine against AnalyticHestonEngine on
-- the same HestonModel and expects agreement within 2% relative (or 0.002 absolute for small
-- NPVs) -- this exercises HestonModel -> engine -> instrument end to end, unlike a
-- self-consistency check against the model's own inputs.
describe "FD Heston engines" $
it "fdHestonVanillaEngine agrees with analyticHestonEngine on the same Heston model" $
Context.keepingSettingsGc $ do
let refDate = 28 `march` 2004
Context.setEvaluationDate (Just refDate)
dc <- dayCounter Actual365FixedStandard
rQ <- Quote.simpleQuote 0.025
rTS <- flatForward (ReferenceDate refDate) rQ dc IR.Continuous Annual
qQ <- Quote.simpleQuote 0.0
qTS <- flatForward (ReferenceDate refDate) qQ dc IR.Continuous Annual
s0 <- Quote.simpleQuote 75
proc <- hestonProcess rTS (Just qTS) s0 0.04 1.5 0.04 0.3 (-0.9) QuadraticExponentialMartingale
model <- hestonModel proc
exerciseDate <- addPeriod refDate (365, Days)
opt <- vanillaOption (PlainVanilla (PlainVanillaPayoff Call 100))
(European (EuropeanExercise exerciseDate))
analyticHestonEngine model (IntegrationOrder 144) >>= setPricingEngine opt
expected <- npv opt
fdHestonVanillaEngine model [] 60 101 51 0 Hundsdorfer Nothing 1.0 >>= setPricingEngine opt
calculated <- npv opt
abs (calculated - expected) `shouldSatisfy` (< max 0.002 (0.02 * abs expected))
describe "equity-model volatility surfaces" $ do
it "HestonBlackVolSurface reproduces a Heston European price through Black-Scholes" $
Context.keepingSettingsGc $ do
let refDate = 28 `march` 2004
Context.setEvaluationDate (Just refDate)
dc <- dayCounter Actual365FixedStandard
rQ <- Quote.simpleQuote 0.025
rTS <- flatForward (ReferenceDate refDate) rQ dc IR.Continuous Annual
qQ <- Quote.simpleQuote 0.0
qTS <- flatForward (ReferenceDate refDate) qQ dc IR.Continuous Annual
s0 <- Quote.simpleQuote 75
proc <- hestonProcess rTS (Just qTS) s0 0.04 1.5 0.04 0.3 (-0.9) QuadraticExponentialMartingale
model <- hestonModel proc
exerciseDate <- addPeriod refDate (365, Days)
opt <- vanillaOption (PlainVanilla (PlainVanillaPayoff Call 100))
(European (EuropeanExercise exerciseDate))
analyticHestonEngine model (IntegrationOrder 144) >>= setPricingEngine opt
hestonPrice <- npv opt
surface <- Vol.hestonBlackVolSurface model AngledContour 160
bsProcess <- blackScholesMertonProcess s0 qTS rTS surface EulerDiscretization False
analyticEuropeanEngine bsProcess Nothing >>= setPricingEngine opt
blackPrice <- npv opt
blackPrice `shouldSatisfy` closePrec hestonPrice (1.0e-6 * abs hestonPrice)
it "GridModelLocalVolSurface marshals strike rows and exposes CalibratedModel" $
Context.keepingSettingsGc $ do
let refDate = 1 `march` 2010
dc <- dayCounter Actual365FixedStandard
d1 <- addPeriod refDate (90, Days)
d2 <- addPeriod refDate (180, Days)
grid <- Vol.gridModelLocalVolSurface refDate
[(d1, [80, 100, 120]), (d2, [75, 100, 125])] dc
Vol.FixedLocalVolSurfaceConstantExtrapolation Vol.FixedLocalVolSurfaceConstantExtrapolation
model <- Vol.gridModelLocalVolSurfaceAsCalibratedModel grid
params model `shouldReturn` replicate 6 1.0
it "Andreasen-Huge calibrates option-vol quotes and constructs both adapters" $
Context.keepingSettingsGc $ do
let refDate = 1 `march` 2010
optSpec strike typ = do
expiry <- addPeriod refDate (365, Days)
vanillaOption (PlainVanilla (PlainVanillaPayoff typ strike))
(European (EuropeanExercise expiry))
Context.setEvaluationDate (Just refDate)
dc <- dayCounter Actual365FixedStandard
zero <- Quote.simpleQuote 0.0
rTS <- flatForward (ReferenceDate refDate) zero dc IR.Continuous Annual
qZero <- Quote.simpleQuote 0.0
qTS <- flatForward (ReferenceDate refDate) qZero dc IR.Continuous Annual
spot <- Quote.simpleQuote 100
o1 <- optSpec 90 Put
o2 <- optSpec 100 Call
o3 <- optSpec 110 Call
v1 <- Quote.simpleQuote 0.20
v2 <- Quote.simpleQuote 0.20
v3 <- Quote.simpleQuote 0.20
interpl <- Vol.andreasenHugeVolatilityInterpolation [(o1, v1), (o2, v2), (o3, v3)] spot rTS qTS
Vol.AndreasenHugeInterpolationCubicSpline Vol.AndreasenHugeCalibrationAndreasenHugeCall 100
Nothing Nothing (LevenbergMarquardt 1.0e-8 1.0e-8 1.0e-8 False)
(EndCriteria 100 20 1.0e-10 1.0e-10 1.0e-10)
(_, maxError, avgError) <- Vol.andreasenHugeCalibrationError interpl
maxError `shouldSatisfy` (< 0.05)
avgError `shouldSatisfy` (< 0.05)
fwd <- Vol.andreasenHugeForward interpl 1.0
fwd `shouldSatisfy` closePrec 100.0 1.0e-10
price <- Vol.andreasenHugeOptionPrice interpl 1.0 100 Call
price `shouldSatisfy` (> 0.0)
directLocal <- Vol.andreasenHugeLocalVol interpl 1.0 100
directLocal `shouldSatisfy` (> 0.0)
_ <- Vol.andreasenHugeVolatilityAdapter interpl 1.0e-6
local <- Vol.andreasenHugeLocalVolAdapter interpl
adaptedLocal <- Vol.localVol local (1 `march` 2011) 100 True
adaptedLocal `shouldSatisfy` (> 0.0)
-- Ported from upstream test-suite/andreasenhugevolatilityinterpl.cpp's
-- AndreasenHugeExampleData/testAndreasenHugePut: the original paper's own
-- example market (Andreasen & Huge 2010, "Volatility Interpolation"), with
-- upstream's cached calibration-error bounds -- tighter and non-arbitrary,
-- unlike the ad-hoc "< 0.05" spot-check above.
it "Andreasen-Huge Put calibration reproduces upstream's cached errors" $
Context.keepingSettingsGc $ do
let today' = 1 `march` 2010
spotVal = 2772.7
maturityTimes :: [Double]
maturityTimes =
[0.025, 0.101, 0.197, 0.274, 0.523, 0.772, 1.769, 2.267, 2.784, 3.781, 4.778, 5.774]
raw :: [(Double, [Double])]
raw =
[ (0.5131, [0,0,0,0,0,0,0,0,0.3366,0.3291,0,0])
, (0.5864, [0,0,0,0,0,0,0,0,0.3178,0.3129,0.3008,0])
, (0.6597, [0,0,0,0,0,0,0,0,0.3019,0.2976,0.2975,0])
, (0.7330, [0,0,0,0,0,0,0,0,0.2863,0.2848,0.2848,0])
, (0.7697, [0,0,0,0.3262,0.3079,0.3001,0.2843,0,0,0,0,0])
, (0.8063, [0,0,0,0.3058,0.2936,0.2876,0.2753,0.2713,0.2711,0.2711,0.2722,0.2809])
, (0.8430, [0,0,0,0.2887,0.2798,0.2750,0.2666,0,0,0,0,0])
, (0.8613, [0.3365,0,0,0,0,0,0,0,0,0,0,0])
, (0.8796, [0.3216,0.2906,0.2764,0.2717,0.2663,0.2637,0.2575,0.2555,0.2580,0.2585,0.2611,0.2693])
, (0.8979, [0.3043,0.2797,0.2672,0,0,0,0,0,0,0,0,0])
, (0.9163, [0.2880,0.2690,0.2578,0.2557,0.2531,0.2519,0.2497,0,0,0,0,0])
, (0.9346, [0.2724,0.2590,0.2489,0,0,0,0,0,0,0,0,0])
, (0.9529, [0.2586,0.2488,0.2405,0.2407,0.2404,0.2411,0.2418,0.2410,0.2448,0.2469,0.2501,0.2584])
, (0.9712, [0.2466,0.2390,0.2329,0,0,0,0,0,0,0,0,0])
, (0.9896, [0.2358,0.2300,0.2253,0.2269,0.2284,0.2299,0.2347,0,0,0,0,0])
, (1.0079, [0.2247,0.2213,0.2184,0,0,0,0,0,0,0,0,0])
, (1.0262, [0.2159,0.2140,0.2123,0.2142,0.2173,0.2198,0.2283,0.2275,0.2322,0.2384,0.2392,0.2486])
, (1.0445, [0.2091,0.2076,0.2069,0,0,0,0,0,0,0,0,0])
, (1.0629, [0.2056,0.2024,0.2025,0.2039,0.2074,0.2104,0.2213,0,0,0,0,0])
, (1.0812, [0.2045,0.1982,0.1984,0,0,0,0,0,0,0,0,0])
, (1.0995, [0.2025,0.1959,0.1944,0.1962,0.1988,0.2022,0.2151,0.2161,0.2219,0.2269,0.2305,0.2399])
, (1.1178, [0.1933,0.1929,0.1920,0,0,0,0,0,0,0,0,0])
, (1.1362, [0,0,0,0.1902,0.1914,0.1950,0.2091,0,0,0,0,0])
, (1.1728, [0,0,0,0.1885,0.1854,0.1888,0.2039,0.2058,0.2122,0.2186,0.2223,0.2321])
, (1.2095, [0,0,0,0.1867,0.1811,0.1839,0.1990,0,0,0,0,0])
, (1.2461, [0,0,0,0.1871,0.1785,0.1793,0.1945,0,0.2054,0.2103,0.2164,0.2251])
, (1.3194, [0,0,0,0,0,0,0,0,0.1988,0.2054,0.2105,0.2190])
, (1.3927, [0,0,0,0,0,0,0,0,0.1930,0.2002,0.2054,0.2135])
, (1.4660, [0,0,0,0,0,0,0,0,0.1849,0.1964,0.2012,0])
]
Context.setEvaluationDate (Just today')
dc <- dayCounter Actual365FixedStandard
zero <- Quote.simpleQuote 0.0
rTS <- flatForward (ReferenceDate today') zero dc IR.Continuous Annual
qZero <- Quote.simpleQuote 0.0
qTS <- flatForward (ReferenceDate today') qZero dc IR.Continuous Annual
spot <- Quote.simpleQuote spotVal
calibList <- concat <$> mapM
(\(ratio, vols) -> do
let strike = spotVal * ratio
typ = if strike < spotVal then Put else Call
catMaybes <$> mapM
(\(t, v) ->
if v <= 0 then pure Nothing
else do
let maturity = addDays (truncate (365 * t) :: Integer) today'
opt <- vanillaOption (PlainVanilla (PlainVanillaPayoff typ strike)) (European (EuropeanExercise maturity))
q <- Quote.simpleQuote v
pure (Just (opt, q)))
(zip maturityTimes vols))
raw
interpl <- Vol.andreasenHugeVolatilityInterpolation (fromList calibList) spot rTS qTS
Vol.AndreasenHugeInterpolationCubicSpline Vol.AndreasenHugeCalibrationAndreasenHugePut 500
Nothing Nothing (LevenbergMarquardt 1.0e-8 1.0e-8 1.0e-8 False)
(EndCriteria 500 100 1.0e-12 1.0e-10 1.0e-10)
(_, maxError, avgError) <- Vol.andreasenHugeCalibrationError interpl
maxError `shouldSatisfy` (< 0.0015)
avgError `shouldSatisfy` (< 0.00035)
-- Instrument.additionalResults() marshals four discriminants: Real, std::string,
-- vector<Real>, and an Unsupported fallback (RTTI name) for anything else. The Real/String
-- and vector<Real> cases are each exercised here against a real engine that upstream QuantLib
-- 1.43 is known to populate that way (grepped ql/pricingengines/**/*.cpp): the Bjerksund-
-- Stensland American option engine writes `exerciseType`/`strikeGamma`, and the Black
-- cap/floor engine writes `optionletsPrice` as a vector<Real>. No shipped 1.43 engine ever
-- stores a type this binding can't name, so the Unsupported fallback isn't exercised here --
-- its C++ side is a trivial, visibly-correct `else`, and its Haskell side is a
-- compiler-checked exhaustive `case` (QuantLib.Instrument.convertResult).
describe "Instrument additionalResults" $ do
it "Bjerksund-Stensland engine reports exerciseType/strikeGamma" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (17 `may` 1998))
-- A zero-dividend American call is never optimally exercised early, so the engine
-- prices it as "European" -- a put (or a call with dividends) is what actually takes
-- the "American" branch upstream (bjerksundstenslandengine.cpp).
underQ <- Quote.simpleQuote 36
riskFreeQ <- Quote.simpleQuote 0.06
dc <- dayCounter Actual365FixedStandard
ts <- flatForward (ReferenceDate (17 `may` 1998)) riskFreeQ dc IR.Continuous Annual
divQ <- Quote.simpleQuote 0.0
divTS <- flatForward (ReferenceDate (17 `may` 1998)) divQ dc IR.Continuous Annual
volQ <- Quote.simpleQuote 0.20
cal <- Calendar.calendar TARGET
vol0 <- Vol.blackConstantVol (Vol.CalendarReferenceDate (17 `may` 1998)) cal volQ dc
proc <- blackScholesMertonProcess underQ divTS ts vol0 EulerDiscretization False
opt <- vanillaOption (PlainVanilla (PlainVanillaPayoff Put 40))
(American Nothing (17 `may` 1999) False)
bjerksundStenslandApproximationEngine proc >>= setPricingEngine opt
_ <- npv opt
res <- additionalResults opt
lookup "exerciseType" res `shouldBe` Just (StringVal "American")
case lookup "strikeGamma" res of
Just (RealVal g) -> g `shouldSatisfy` (> 0)
other -> expectationFailure $ "strikeGamma missing or wrong type: " ++ show other
it "Black cap/floor engine reports optionletsPrice as a RealVectorVal" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (11 `december` 2012))
cal <- Calendar.calendar TARGET
settle <- advance cal (11 `december` 2012) (2, Days) Following False
discQ <- Quote.simpleQuote 0.02
dc <- dayCounter Actual365FixedStandard
discountTS <- flatForward (ReferenceDate (11 `december` 2012)) discQ dc IR.Continuous Annual
idx <- iborIndex Euribor6M (Just discountTS)
floatDC <- dayCounter (Actual360 False)
floatSch <- schedule (Just settle) (11 `december` 2017) (6, Months) cal
ModifiedFollowing ModifiedFollowing Forward False Nothing Nothing
leg <- iborLeg floatSch idx [1000000] floatDC ModifiedFollowing [2] [1.0] [0.0] [] [] False False
capfl <- cap leg [0.03]
volQ <- Quote.simpleQuote 0.20
vol0 <- Vol.constantOptionletVolatility (Vol.CalendarReferenceDate (11 `december` 2012)) cal ModifiedFollowing volQ dc IR.ShiftedLognormal 0
eng <- blackCapFloorEngineFromVolatilityStructure discountTS vol0
setPricingEngine capfl eng
_ <- npv capfl
res <- additionalResults capfl
case lookup "optionletsPrice" res of
-- the near-dated optionlet(s) can legitimately price at (or near) zero; check the
-- vector is non-trivial and non-negative rather than requiring every entry positive
Just (RealVectorVal xs) -> do
xs `shouldSatisfy` (not . null)
xs `shouldSatisfy` all (>= 0)
xs `shouldSatisfy` any (> 0)
other -> expectationFailure $ "optionletsPrice missing or wrong type: " ++ show other