hasquant-0.8.0.0: test/hspec/QuantLib/Spec/TermStructure.hs
{-# LANGUAGE ScopedTypeVariables, OverloadedLists, LambdaCase #-}
module QuantLib.Spec.TermStructure (spec) where
import Control.Exception(throwIO, IOException)
import Data.IORef
import Control.Monad(replicateM, forM_, when, zipWithM, (>=>))
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(isInfixOf, nub)
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 qualified QuantLib.TermStructure as TS
import QuantLib.Math
import QuantLib.Index(addFixing)
import qualified QuantLib.Index as Index(name)
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, quantLibAtMost143, unsupportedQuantLib144)
spec :: Spec
spec = do
describe "QuantLib 1.44 curves and helpers" $ do
it "moves the implied reference date and preserves discount ratios" $ Context.keepingSettingsGc $ do
let today' = fromGregorian 2024 1 2
Context.setEvaluationDate (Just today')
cal <- calendar TARGET
dc <- dayCounter Actual365FixedStandard
q <- Quote.simpleQuote 0.03
base <- flatForward (ReferenceDate today') q dc IR.Continuous Annual
if quantLibAtMost143 then
impliedTermStructureMoving base 2 cal `shouldThrow` unsupportedQuantLib144 "impliedTermStructureMoving"
else do
moved <- impliedTermStructureMoving base 2 cal
ref <- advance cal today' (2, Days) Following False
TS.referenceDate moved `shouldReturn` ref
let maturity = addGregorianYearsClip 1 ref
df <- discount base (DatePoint maturity) False
refDf <- discount base (DatePoint ref) False
discount moved (DatePoint maturity) False >>= (`shouldSatisfy` closePrec (df/refDf) 1e-10)
Context.setEvaluationDate (Just (addDays 1 today'))
next <- advance cal (addDays 1 today') (2, Days) Following False
TS.referenceDate moved `shouldReturn` next
it "reprices overnight basis and funding helpers" $ Context.keepingSettingsGc $ do
let today' = fromGregorian 2024 1 2
Context.setEvaluationDate (Just today')
cal <- calendar TARGET
dc <- dayCounter (Actual360 False)
q <- Quote.simpleQuote 0.03
basis <- Quote.simpleQuote 0.001
base <- flatForward (ReferenceDate today') q dc IR.Continuous Annual
on <- overnightIborIndex Sofr (Just base)
other <- overnightIborIndex Sofr Nothing
let basisHelper = overnightOvernightBasisSwapRateHelper basis (1, Years) 2 cal ModifiedFollowing False
on other (Just base) False 2 Quarterly AveragingCompound AveragingCompound False Backward
funding terms = overnightIndexedFundingRateHelper terms basis cal ModifiedFollowing False on
(3, Months) dc 2 False Backward LastRelevantDate Nothing
if quantLibAtMost143 then do
basisHelper `shouldThrow` unsupportedQuantLib144 "overnightOvernightBasisSwapRateHelper"
funding (FundingTenor 2 (1, Years)) `shouldThrow` unsupportedQuantLib144 "overnightIndexedFundingRateHelper"
funding (FundingBetweenDates (addDays 2 today') (addGregorianYearsClip 1 today'))
`shouldThrow` unsupportedQuantLib144 "overnightIndexedFundingRateHelper"
else do
bh <- basisHelper
fh <- funding (FundingTenor 2 (1, Years))
start <- advance cal today' (2, Days) Following False
end <- advance cal start (1, Years) ModifiedFollowing False
dated <- funding (FundingBetweenDates start end)
forM_ ([bh, fh, dated] :: [RateHelper]) $ \helper -> do
curve <- piecewiseYieldCurve (ReferenceDate today') [helper] dc []
(Iterative Discount LogLinear defaultIterativeBootstrapOpts) False
discount curve (TimePoint 0.5) False >>= (`shouldSatisfy` (\df -> df > 0 && df < 1))
impliedQuote helper >>= (`shouldSatisfy` closePrec 0.001 1e-9)
deps <- rateHelperFixingDependencies helper
deps `shouldSatisfy` maybe False (not . null)
it "owns initial-guess callbacks and supplies previous bootstrap data" $ Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (fromGregorian 2024 1 2))
cal <- calendar TARGET
dc <- dayCounter (Actual360 False)
q <- Quote.simpleQuote 0.03
helpers <- mapM (\n -> depositRateHelper q (DepositTenor (n, Months) 0 cal ModifiedFollowing False dc)) [3, 6]
calls <- newIORef ([] :: [(Int, Int)])
let guess times previous = do
modifyIORef' calls (++ [(V.length times, V.length previous)])
pure (V.map (\t -> exp (-0.03*t)) (V.drop 1 times))
curve <- piecewiseYieldCurve (SettlementDays 0 cal) (fromList helpers) dc []
(GlobalDiscountLogLinear 1e-12 [] (Just guess)) False
Context.collectGarbage
discount curve (TimePoint 0.2) False >>= (`shouldSatisfy` (> 0))
_ <- Quote.setValue q 0.04
discount curve (TimePoint 0.2) False >>= (`shouldSatisfy` (> 0))
seen <- readIORef calls
seen `shouldBe` if quantLibAtMost143 then [] else [(3,0), (3,3)]
it "transports callback exceptions and rejects wrong initial-guess lengths" $ Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (fromGregorian 2024 1 2))
cal <- calendar TARGET
dc <- dayCounter (Actual360 False)
q <- Quote.simpleQuote 0.03
helper <- depositRateHelper q (DepositTenor (6, Months) 0 cal ModifiedFollowing False dc)
let runGuess guess = piecewiseYieldCurve (SettlementDays 0 cal) [helper] dc []
(GlobalDiscountLogLinear 1e-12 [] (Just guess)) False
>>= \curve -> discount curve (TimePoint 0.2) False
marker (e :: IOException) = show e == "user error (initial guess failed)"
wrongLength (Context.CallbackResultLength expected actual) = expected == 1 && actual == 0
wrongLength _ = False
if quantLibAtMost143 then do
runGuess (\_ _ -> throwIO (userError "initial guess failed")) >>= (`shouldSatisfy` (> 0))
runGuess (\_ _ -> pure V.empty) >>= (`shouldSatisfy` (> 0))
else do
runGuess (\_ _ -> throwIO (userError "initial guess failed")) `shouldThrow` marker
runGuess (\_ _ -> pure V.empty) `shouldThrow` wrongLength
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 (DepositTenor (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)
swapRateHelper q (SwapRateTenor (n, u) cal Annual Unadjusted thirty360dc index (0, Days) Nothing Nothing) Nothing Nothing
LastRelevantDate Nothing False 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
-- Ports upstream termstructures.cpp's spreaded-forward interpolation tests: between spread
-- nodes the instantaneous forward is the base forward plus the interpolated spread.
it "piecewise forward-spreaded term structure interpolates instantaneous forward spreads" $
Context.keepingSettingsGc $ do
(cal, _settlementDays, ts) <- setup
todayD <- Context.evaluationDate
let businessDays n = advance cal todayD (n, Days) Following False
instFwd curve t = IR.rate <$> forwardRateBetweenTimes curve t t IR.Continuous NoFrequency True
q2 <- Quote.simpleQuote 0.02
q3 <- Quote.simpleQuote 0.03
q4 <- Quote.simpleQuote 0.04
d100 <- businessDays 100
d150 <- businessDays 150
d120 <- businessDays 120
t100 <- timeFromReference ts d100
t150 <- timeFromReference ts d150
t120 <- timeFromReference ts d120
linear <- piecewiseForwardSpreadedTermStructure ts (fromList [(d100, q2), (d150, q3)]) Linear
base120 <- instFwd ts t120
instFwd linear t120 >>= (`shouldSatisfy` closePrec (base120 + (0.03 - 0.02) / (t150 - t100) * (t120 - t100) + 0.02) 1.0e-9)
d75 <- businessDays 75
d260 <- businessDays 260
t100' <- timeFromReference ts d100
forwardFlat <- piecewiseForwardSpreadedTermStructure ts (fromList [(d75, q2), (d260, q3)]) ForwardFlat
base100 <- instFwd ts t100'
instFwd forwardFlat t100' >>= (`shouldSatisfy` closePrec (base100 + 0.02) 1.0e-9)
d200 <- businessDays 200
d300 <- businessDays 300
d110 <- businessDays 110
t110 <- timeFromReference ts d110
backwardFlat <- piecewiseForwardSpreadedTermStructure ts (fromList [(d100, q2), (d200, q3), (d300, q4)]) BackwardFlat
base110 <- instFwd ts t110
instFwd backwardFlat t110 >>= (`shouldSatisfy` closePrec (base110 + 0.03) 1.0e-9)
piecewiseForwardSpreadedTermStructure ts (fromList [(d100, q2), (d150, q3)]) LogLinear `shouldThrow` anyException
-- Mirrors upstream piecewiseyieldcurve.cpp's testPiecewiseSpreadYieldCurve: fewer swaps
-- bootstrapped as a spread over the base curve reprice, and the forward spread stays flat
-- past the base curve's max date.
it "piecewise spread yield curve reprices its instruments over the base curve" $
Context.keepingSettingsGc $ do
(cal, settlementDays, ts) <- setup
setExtrapolation ts True
refDate <- referenceDate ts
actual360dc <- dayCounter (Actual360 False)
thirty360dc <- dayCounter Thirty360BondBasis
ccy <- currency EUR
index <- iborIndex (Ibor "spread3m" (3, Months) settlementDays ccy cal ModifiedFollowing False actual360dc) Nothing
let swapData = [(1, 4.44), (3, 4.55), (6, 4.81), (9, 5.01), (15, 5.25), (30, 5.36)] :: [(Int, Double)]
mkHelpers = mapM (\(n, r) -> do
q <- Quote.simpleQuote (r / 100)
h <- swapRateHelper q (SwapRateTenor (n, Years) cal Annual Unadjusted thirty360dc index (0, Days) Nothing Nothing) Nothing Nothing
LastRelevantDate Nothing False Nothing Nothing >>= asRateHelper
pure (h, r / 100)) swapData
repricing bootstrap = do
hs <- mkHelpers
curve <- piecewiseSpreadYieldCurve ts (fromList (map fst hs)) bootstrap True
_ <- discount curve (DatePoint (addGregorianYearsClip 1 refDate)) True
mapM_ (\(h, r) -> impliedQuote h >>= (`shouldSatisfy` closePrec r 1.0e-8)) hs
pure curve
flatFwd curve t1 t2 = IR.rate <$> forwardRateBetweenTimes curve t1 t2 IR.Continuous NoFrequency True
logLinear <- repricing (SpreadIterative LogLinear defaultIterativeBootstrapOpts)
_ <- repricing (SpreadIterative Linear defaultIterativeBootstrapOpts)
_ <- repricing (SpreadGlobalLogLinear 1.0e-10 [] Nothing)
curveMax <- TS.maxDate logLinear
baseMax <- TS.maxDate ts
curveMax `shouldBe` baseMax
tMax <- timeFromReference ts curveMax
maxT <- TS.maxTime logLinear
maxT `shouldSatisfy` closePrec tMax 1.0e-12
before <- (-) <$> flatFwd logLinear (tMax - 1) tMax <*> flatFwd ts (tMax - 1) tMax
after <- (-) <$> flatFwd logLinear tMax (tMax + 1) <*> flatFwd ts tMax (tMax + 1)
after `shouldSatisfy` closePrec before 1.0e-9
-- A par rate read on a curve the helper did not bootstrap: the helpers' own quotes play no
-- part, and helpers bootstrapped at those rates read them back on the rebuilt curve.
it "impliedQuoteOn reads par rates on any curve" $
Context.keepingSettingsGc $ do
(cal, settlementDays, ts) <- setup
refDate <- referenceDate ts
actual360dc <- dayCounter (Actual360 False)
thirty360dc <- dayCounter Thirty360BondBasis
ccy <- currency EUR
index <- iborIndex (Ibor "par3m" (3, Months) settlementDays ccy cal ModifiedFollowing False actual360dc) Nothing
let tenors = [1, 3, 6, 9, 15, 30] :: [Int]
helperAt r n = do
q <- Quote.simpleQuote r
swapRateHelper q (SwapRateTenor (n, Years) cal Annual Unadjusted thirty360dc index (0, Days) Nothing Nothing) Nothing Nothing
LastRelevantDate Nothing False Nothing Nothing >>= asRateHelper
pars <- mapM (helperAt 0 >=> (`impliedQuoteOn` ts)) tenors
rebuiltHelpers <- zipWithM helperAt pars tenors
rebuilt <- piecewiseYieldCurve (ReferenceDate refDate) (fromList rebuiltHelpers) actual360dc [] (Iterative Discount LogLinear defaultIterativeBootstrapOpts) True
forM_ (zip tenors pars) $ \(n, r) -> do
r `shouldSatisfy` (\x -> x > 0.04 && x < 0.07)
fresh <- helperAt 0 n
impliedQuoteOn fresh rebuilt >>= (`shouldSatisfy` closePrec r 1.0e-10)
it "interpolated simple zero curve reproduces its simply-compounded node rates" $
Context.keepingSettingsGc $ do
let refDate = 15 `january` 2024
nodes = [(refDate, 0.02), (addGregorianYearsClip 1 refDate, 0.021), (addGregorianYearsClip 2 refDate, 0.022), (addGregorianYearsClip 5 refDate, 0.025)] :: [(Day, Double)]
Context.setEvaluationDate (Just refDate)
cal <- Calendar.calendar TARGET
dc <- dayCounter Actual365FixedStandard
curve <- interpolatedSimpleZeroCurve (fromList nodes) dc cal [] Linear
forM_ (drop 1 nodes) $ \(d, r) -> do
z <- IR.rate <$> zeroRate curve (RateAtDate d dc) IR.Simple Annual False
z `shouldSatisfy` closePrec r 1.0e-10
t <- timeFromReference curve d
df <- discount curve (DatePoint d) False
df `shouldSatisfy` closePrec (1 / (1 + r * t)) 1.0e-12
-- 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 (OisTenor 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 <- swapRateHelper q (SwapRateTenor (5, Years) cal Annual Unadjusted thirty360dc ibor (0, Days) Nothing Nothing) Nothing Nothing
LastRelevantDate Nothing False 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
-- Which fixings a bootstrapped curve reads from the store. The curve itself cannot say:
-- PiecewiseYieldCurve is a template with no instruments accessor and an Observer does not
-- expose what it registered with, so the question is asked of the helpers one at a time and
-- rateHelperFixingDependencies walks each helper's underlying instrument.
describe "rate helper fixing dependencies" $ do
it "reads a swap helper's fixings off its underlying swap" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar TARGET
thirty360dc <- dayCounter Thirty360BondBasis
q <- Quote.simpleQuote 0.03
ibor <- iborIndex Euribor6M Nothing
name <- Index.name ibor
(Just deps) <- swapRateHelper q (SwapRateTenor (5, Years) cal Annual Unadjusted thirty360dc ibor (0, Days) Nothing Nothing) Nothing Nothing
LastRelevantDate Nothing False Nothing Nothing
>>= asRateHelper >>= rateHelperFixingDependencies
-- One key per semi-annual coupon, named as QuantLib's fixing store names it, and the
-- first of them is today: a spot-starting helper's first coupon fixes on the
-- evaluation date, which is the fixing a shifted scenario has to supply.
map fst deps `shouldBe` replicate 10 name
take 1 (map snd deps) `shouldBe` [2 `january` 2024]
it "reports none for the helpers that read no stored fixing" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar TARGET
actual360dc <- dayCounter (Actual360 False)
q <- Quote.simpleQuote 0.03
ibor <- iborIndex Euribor6M Nothing
-- A relative-date deposit or FRA helper's convention form builds a "no-fix" index, and
-- its index form fixes today or later, which it forecasts rather than reads, so an empty
-- list is the answer here and not a gap in the walk.
(depositRateHelper q (DepositTenor (6, Months) 2 cal ModifiedFollowing True actual360dc)
>>= rateHelperFixingDependencies) `shouldReturn` Just []
(fraRateHelper q (FraMonthsFromIndex 3 ibor) LastRelevantDate Nothing True
>>= rateHelperFixingDependencies) `shouldReturn` Just []
-- A futures helper prices off the curve and an FX swap helper off spot and the collateral
-- curve. Each has its own case, because an unknown helper now answers Nothing.
(futuresRateHelper q (FuturesMonths (17 `january` 2024) 3 cal ModifiedFollowing True actual360dc) Nothing IMM
>>= asRateHelper >>= rateHelperFixingDependencies) `shouldReturn` Just []
actual365dc <- dayCounter Actual365FixedStandard
curve <- flatForward (SettlementDays 0 cal) q actual365dc IR.Continuous Annual
spot <- Quote.simpleQuote 1.1
(fxSwapRateHelper q spot (FxSwapTenor (1, Years) 2 cal ModifiedFollowing False cal) True curve
>>= rateHelperFixingDependencies) `shouldReturn` Just []
it "reports a fixed-date deposit's or indexed FRA's fixing only once it has passed" $
Context.keepingSettingsGc $ do
q <- Quote.simpleQuote 0.03
ibor <- iborIndex Euribor6M Nothing
name <- Index.name ibor
-- Euribor6M fixes two TARGET days before its value date: the FRA starting on the 17th
-- fixes on the 15th, the date the deposit is given.
let fixing = 15 `january` 2024
depo <- depositRateHelper q (DepositOnFixingDate fixing ibor)
fra <- fraRateHelper q (FraBetweenDates (17 `january` 2024) (17 `july` 2024) ibor) LastRelevantDate Nothing True
fraOffCurve <- fraRateHelper q (FraBetweenDates (17 `january` 2024) (17 `july` 2024) ibor) LastRelevantDate Nothing False
let depsOn d h = Context.setEvaluationDate (Just d) >> rateHelperFixingDependencies h
forM_ ([depo, fra] :: [RateHelper]) $ \h -> do
depsOn (12 `january` 2024) h `shouldReturn` Just []
-- On the fixing date itself fixing(d, true) still forecasts.
depsOn fixing h `shouldReturn` Just []
depsOn (16 `january` 2024) h `shouldReturn` Just [(name, fixing)]
-- Without an indexed coupon the FRA prices off the curve and reads no fixing at all.
depsOn (16 `january` 2024) fraOffCurve `shouldReturn` Just []
it "reports one key per averaged business day for an OIS helper" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
q <- Quote.simpleQuote 0.03
ois <- overnightIborIndex Sofr Nothing
(Just deps) <- oisRateHelper (OisTenor 2 (1, Years) (0, Days)) q ois Nothing
>>= asRateHelper >>= rateHelperFixingDependencies
-- The overnight leg of a 1Y OIS is one annual coupon: a hand-written list would carry
-- one date, where the coupon reads a fixing on every business day it compounds over.
length deps `shouldSatisfy` (> 200)
it "reports both legs' indexes for a basis swap helper" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar TARGET
actual365dc <- dayCounter Actual365FixedStandard
q <- Quote.simpleQuote 0.03
curve <- flatForward (SettlementDays 0 cal) q actual365dc IR.Continuous Annual
i3 <- iborIndex Euribor3M (Just curve)
i6 <- iborIndex Euribor6M (Just curve)
names <- mapM Index.name [i3, i6]
basis <- Quote.simpleQuote 0.001
(Just deps) <- iborIborBasisSwapRateHelper basis (2, Years) 2 cal ModifiedFollowing False i3 i6 curve True Nothing Backward 0 Nothing Nothing
>>= rateHelperFixingDependencies
-- A basis swap is two floating legs, so both indexes are dependencies; a walk that
-- stopped at the helper's "own" index would report half of what the curve reads.
nub (map fst deps) `shouldMatchList` names
it "reads a cross-currency helper's legs through its protected members" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar TARGET
actual365dc <- dayCounter Actual365FixedStandard
thirty360dc <- dayCounter Thirty360BondBasis
q <- Quote.simpleQuote 0.03
curve <- flatForward (SettlementDays 0 cal) q actual365dc IR.Continuous Annual
i3 <- iborIndex Euribor3M (Just curve)
i6 <- iborIndex Euribor6M (Just curve)
names <- mapM Index.name [i3, i6]
basis <- Quote.simpleQuote 0.001
(Just basisDeps) <- constNotionalCrossCurrencyBasisSwapRateHelper basis (2, Years) 2 cal ModifiedFollowing False
i3 i6 curve True True Nothing 0 Nothing Nothing False Nothing Nothing >>= rateHelperFixingDependencies
nub (map fst basisDeps) `shouldMatchList` names
(Just mtmDeps) <- mtmCrossCurrencyBasisSwapRateHelper basis (2, Years) 2 cal ModifiedFollowing False
i3 i6 curve True True True Nothing 0 Nothing 0 Nothing Nothing Nothing Nothing >>= rateHelperFixingDependencies
nub (map fst mtmDeps) `shouldMatchList` names
(Just fixedDeps) <- constNotionalCrossCurrencySwapRateHelper q (2, Years) 2 cal ModifiedFollowing False
Annual thirty360dc i6 curve True 0 Nothing Nothing Nothing >>= rateHelperFixingDependencies
nub (map fst fixedDeps) `shouldBe` drop 1 names
it "refuses non-default QuantLib 1.44 helper arguments on 1.43" $
if not quantLibAtMost143 then pendingWith "1.44 accepts these arguments" else Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar TARGET
actual365dc <- dayCounter Actual365FixedStandard
thirty360dc <- dayCounter Thirty360BondBasis
q <- Quote.simpleQuote 0.03
curve <- flatForward (SettlementDays 0 cal) q actual365dc IR.Continuous Annual
i3 <- iborIndex Euribor3M (Just curve)
i6 <- iborIndex Euribor6M (Just curve)
sofr <- overnightIborIndex Sofr (Just curve)
basis <- Quote.simpleQuote 0.001
iborIborBasisSwapRateHelper basis (2, Years) 2 cal ModifiedFollowing False i3 i6 curve True Nothing Backward 1 Nothing Nothing
`shouldThrow` unsupportedQuantLib144 "iborIborBasisSwapRateHelper"
overnightIborBasisSwapRateHelper basis (2, Years) 2 cal ModifiedFollowing False sofr i3 (Just curve)
False 0 Nothing Nothing Backward AveragingCompound True False Nothing
`shouldThrow` unsupportedQuantLib144 "overnightIborBasisSwapRateHelper"
constNotionalCrossCurrencyBasisSwapRateHelper basis (2, Years) 2 cal ModifiedFollowing False
i3 i6 curve True True Nothing 0 Nothing Nothing True Nothing Nothing
`shouldThrow` unsupportedQuantLib144 "constNotionalCrossCurrencyBasisSwapRateHelper"
mtmCrossCurrencyBasisSwapRateHelper basis (2, Years) 2 cal ModifiedFollowing False
i3 i6 curve True True True Nothing 0 Nothing 2 (Just cal) Nothing Nothing Nothing
`shouldThrow` unsupportedQuantLib144 "mtmCrossCurrencyBasisSwapRateHelper"
constNotionalCrossCurrencySwapRateHelper q (2, Years) 2 cal ModifiedFollowing False
Annual thirty360dc i6 curve True 0 Nothing (Just Quarterly) Nothing
`shouldThrow` unsupportedQuantLib144 "constNotionalCrossCurrencySwapRateHelper"
oisRateHelperWithOptions (OisTenor 2 (1, Years) (0, Days)) q sofr Nothing
defaultOisRateHelperOpts { oisFixedDayCount = Just thirty360dc }
`shouldThrow` unsupportedQuantLib144 "oisRateHelperWithOptions"
it "reports a started overnight-index futures contract's fixings up to the evaluation date" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
price <- Quote.simpleQuote 94.8
(sofrFutureRateHelper price QuantLib.Time.Date.March 2024 Quarterly Nothing LastRelevantDate Nothing
>>= rateHelperFixingDependencies) `shouldReturn` Just []
started <- sofrFutureRateHelper price QuantLib.Time.Date.December 2023 Quarterly Nothing
LastRelevantDate Nothing >>= rateHelperFixingDependencies
-- QuantLib <= 1.43 keeps the future private, so "cannot see it" is the only honest answer.
let sofrDates = map (`december` 2023) [20, 21, 22, 26, 27, 28, 29] ++ [2 `january` 2024]
started `shouldBe` if quantLibAtMost143 then Nothing else Just [("SOFRON Actual/360", d) | d <- sofrDates]
it "re-dates with the evaluation date" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar TARGET
thirty360dc <- dayCounter Thirty360BondBasis
q <- Quote.simpleQuote 0.03
ibor <- iborIndex Euribor6M Nothing
h <- swapRateHelper q (SwapRateTenor (5, Years) cal Annual Unadjusted thirty360dc ibor (0, Days) Nothing Nothing) Nothing Nothing
LastRelevantDate Nothing False Nothing Nothing >>= asRateHelper
(Just before') <- rateHelperFixingDependencies h
-- A relative-date helper re-initialises its schedule when the evaluation date moves, so
-- the keys must be read under the date whose fixings are being asked about.
(Just after') <- do
Context.setEvaluationDate (Just (1 `july` 2024))
rateHelperFixingDependencies h
take 1 (map snd after') `shouldBe` [1 `july` 2024]
map snd after' `shouldSatisfy` (/= map snd before')
it "keeps a fixed-date swap helper's first fixing when the evaluation date moves past it" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar TARGET
thirty360dc <- dayCounter Thirty360BondBasis
q <- Quote.simpleQuote 0.03
ibor <- iborIndex Euribor6M Nothing
name <- Index.name ibor
h <- swapRateHelper q (SwapRateBetweenDates (4 `january` 2024) (4 `january` 2029) cal Annual Unadjusted thirty360dc ibor Nothing)
Nothing Nothing LastRelevantDate Nothing False Nothing Nothing >>= asRateHelper
(Just before') <- rateHelperFixingDependencies h
(Just after') <- do
Context.setEvaluationDate (Just (1 `july` 2024))
rateHelperFixingDependencies h
-- The dates are the helper's own: the first coupon fixed on 2 January, now past and
-- read from the store, and nothing moved with the evaluation date.
map fst after' `shouldBe` replicate 10 name
take 1 (map snd after') `shouldBe` [2 `january` 2024]
after' `shouldBe` before'
-- 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" $ do
let buildFitted reference = 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 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
it "keeps a caller-supplied OptimizationMethod alive past Haskell's own GC" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar Null
fixedReference <- advance cal (2 `january` 2024) (3, Days) Following False
movingCurve <- buildFitted (SettlementDays 3 cal)
fixedCurve <- buildFitted (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
it "FittingMethod inspectors report the calibration result consistently" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar Null
curve <- buildFitted (SettlementDays 3 cal)
n <- fittingMethodSize curve
n `shouldBe` 9
sol <- fittingMethodSolution curve
V.length sol `shouldBe` 9
minCost <- minimumCostValue curve
minCost `shouldSatisfy` (>= 0)
iters <- numberOfIterations curve
iters `shouldSatisfy` (>= 0)
err <- fittingMethodErrorCode curve
err `shouldNotBe` EndNone
-- constrainAtZero = True above pins the fitted discount factor at t=0 to 1.
d0 <- fittingMethodDiscount curve (V.toList sol) 0.0
d0 `shouldSatisfy` closePrec 1.0 1.0e-8
-- 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" $ do
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 (FxSwapTenor (1, Years) fixingDays cal ModifiedFollowing False tradingCal)
True collateralCurve
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
it "FxSwapBetweenDates agrees with the FxSwapTenor landing on the same dates" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar TARGET
tradingCal <- calendar Null
actual360dc <- dayCounter (Actual360 False)
settlement <- advance cal (2 `january` 2024) (2, Days) Following False
maturity <- advance cal settlement (1, Years) ModifiedFollowing False
collRate <- Quote.simpleQuote 0.03
collateralCurve <- flatForward (SettlementDays 2 cal) collRate actual360dc IR.Continuous Annual
spotFx <- Quote.simpleQuote 1.10
fwdPoint <- Quote.simpleQuote 0.0025
let discountOn terms = do
rh <- fxSwapRateHelper fwdPoint spotFx terms True collateralCurve
ts <- piecewiseYieldCurve (ReferenceDate settlement) [rh] actual360dc [] (Iterative Discount LogLinear defaultIterativeBootstrapOpts) False
discount ts (DatePoint (2 `july` 2024)) True
tenor <- discountOn (FxSwapTenor (1, Years) 2 cal ModifiedFollowing False tradingCal)
dated <- discountOn (FxSwapBetweenDates settlement maturity)
dated `shouldSatisfy` closePrec tenor 1.0e-12
-- 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
-- The fixed-date and IMM forms, against the relative form that lands on the same dates on
-- 2 January 2024: spot is the 4th, so the deposit from the index fixes on the 2nd and the
-- 3M FRA 3M forward runs from 4 April to 4 July.
it "the fixed-date and IMM variants agree with the relative forms on the same dates" $
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 discountOn rh = do
ts <- piecewiseYieldCurve (ReferenceDate (2 `january` 2024)) ([rh] :: NonEmpty RateHelper) actual360dc []
(Iterative Discount LogLinear defaultIterativeBootstrapOpts) False
discount ts (DatePoint (2 `july` 2024)) True
fraDiscount indexed terms = fraRateHelper q terms LastRelevantDate Nothing indexed >>= discountOn
relativeDepo <- depositRateHelper q (DepositFromIndex euribor3m) >>= discountOn
fixedDepo <- depositRateHelper q (DepositOnFixingDate (2 `january` 2024) euribor3m) >>= discountOn
fixedDepo `shouldSatisfy` closePrec relativeDepo 1.0e-12
relativeFra <- fraDiscount True (FraPeriodFromIndex (3, Months) euribor3m)
fixedFra <- fraDiscount True (FraBetweenDates (4 `april` 2024) (4 `july` 2024) euribor3m)
fixedFra `shouldSatisfy` closePrec relativeFra 1.0e-12
-- The IMM form starts and ends on the first and second main-cycle IMM dates after spot,
-- found the way QuantLib's nthImmDate finds them. Without an indexed coupon the FRA ends
-- on the second, not one index tenor after the first.
imm1 <- nextImmDate (4 `january` 2024) True
imm2 <- nextImmDate imm1 True
immFra <- fraDiscount False (FraImmOffsets 1 2 euribor3m)
datedFra <- fraDiscount False (FraBetweenDates imm1 imm2 euribor3m)
immFra `shouldSatisfy` closePrec datedFra 1.0e-12
describe "swap rate helper terms" $ do
-- On 2 January 2024 spot is the 4th, so a 5Y swap from spot and the swap between 4 January
-- 2024 and 4 January 2029 are the same swap.
it "SwapRateBetweenDates agrees with the SwapRateTenor landing on the same dates" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
cal <- calendar TARGET
thirty360dc <- dayCounter Thirty360BondBasis
actual360dc <- dayCounter (Actual360 False)
q <- Quote.simpleQuote 0.03
ibor <- iborIndex Euribor6M Nothing
let priced terms = do
rh <- swapRateHelper q terms Nothing Nothing LastRelevantDate Nothing False Nothing Nothing >>= asRateHelper
ts <- piecewiseYieldCurve (ReferenceDate (2 `january` 2024)) ([rh] :: NonEmpty RateHelper) actual360dc []
(Iterative Discount LogLinear defaultIterativeBootstrapOpts) False
discount ts (DatePoint (2 `january` 2027)) True
tenor <- priced (SwapRateTenor (5, Years) cal Annual Unadjusted thirty360dc ibor (0, Days) Nothing Nothing)
dated <- priced (SwapRateBetweenDates (4 `january` 2024) (4 `january` 2029) cal Annual Unadjusted thirty360dc ibor Nothing)
dated `shouldSatisfy` closePrec tenor 1.0e-12
it "SwapRateFromIndex bootstraps a curve that reprices its own quote" $
Context.keepingSettingsGc $ do
Context.setEvaluationDate (Just (2 `january` 2024))
actual360dc <- dayCounter (Actual360 False)
q <- Quote.simpleQuote 0.03
idx <- liborSwapIndex EurLiborSwapIsdaFixA (5, Years) (Nothing :: Maybe YieldTermStructure) (Nothing :: Maybe YieldTermStructure)
rh <- swapRateHelper q (SwapRateFromIndex idx (0, Days)) Nothing Nothing LastRelevantDate Nothing False Nothing Nothing >>= asRateHelper
ts <- piecewiseYieldCurve (ReferenceDate (2 `january` 2024)) ([rh] :: NonEmpty RateHelper) actual360dc []
(Iterative Discount LogLinear defaultIterativeBootstrapOpts) False
_ <- discount ts (DatePoint (2 `january` 2027)) True
impliedQuote rh >>= (`shouldSatisfy` closePrec 0.03 1.0e-8)
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)
it "optionDateFromTenor matches Calendar.advance under the structure's own calendar/convention" $
Context.keepingSettingsGc $ do
let refDate = 11 `december` 2012
Context.setEvaluationDate (Just refDate)
cal <- Calendar.calendar TARGET
dc <- dayCounter Actual365FixedStandard
volQ <- Quote.simpleQuote 0.20
vol0 <- Vol.constantSwaptionVolatility (Vol.CalendarReferenceDate refDate) cal ModifiedFollowing volQ dc IR.ShiftedLognormal 0
got <- Vol.optionDateFromTenor vol0 (6, Months)
expected <- advance cal refDate (6, Months) ModifiedFollowing False
got `shouldBe` expected
-- 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 0
when quantLibAtMost143 $
Vol.optionletStripper capVolSurface idx Nothing 1.0e-6 100 (Just discountH) IR.ShiftedLognormal 0 False Nothing 2
`shouldThrow` unsupportedQuantLib144 "optionletStripper"
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 0
stripper2 <- Vol.optionletStripperWithAtm capVolSurface idx Nothing 1.0e-6 100
(Just discountH) IR.ShiftedLognormal 0 False Nothing capVolCurve 0
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 Nothing Backward 0 Nothing Nothing) [2 .. 10]
helpers6mBasis <- mapM (\i -> iborIborBasisSwapRateHelper b (i * 6, Months) 2 cal ModifiedFollowing True euribor3m euribor6m discountCurve False Nothing Backward 0 Nothing Nothing) [1 .. 3]
helpers6mSwap <- mapM (\i -> swapRateHelper q (SwapRateTenor (i, Years) cal Annual Following thirty360 euribor6m (0, Days) Nothing Nothing) Nothing (Just discountCurve)
LastRelevantDate Nothing False Nothing Nothing) [2 .. 10]
>>= mapM asRateHelper -- swapRateHelper 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 [] Nothing) False
ptr6m <- piecewiseYieldCurve (SettlementDays 0 cal) (fromList (helpers6mBasis ++ helpers6mSwap)) euriborDC []
(GlobalDiscountLogLinear 1.0e-10 [] Nothing) False
mc <- multiCurve 1.0e-10
curve3m <- addBootstrappedCurve mc intcurve3m ptr3m
curve6m <- addBootstrappedCurve mc intcurve6m ptr6m
-- Pricing indexes must own the external handles; internal handles do not retain the cycle.
pricing3m <- iborIndex Euribor3M (Just curve3m)
pricing6m <- iborIndex Euribor6M (Just curve6m)
pure (cal, settleFix, euriborDC, thirty360, pricing3m, pricing6m, 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 -> swapRateHelper q (SwapRateTenor (i, Years) cal Annual Following thirty360 euribor3m (0, Days) Nothing Nothing) Nothing (Just intcurveois)
LastRelevantDate Nothing False Nothing Nothing
>>= asRateHelper) [1 .. 10 :: Int]
ptr3m <- piecewiseYieldCurve (SettlementDays 0 cal) (fromList helpers3m) euriborDC []
(GlobalDiscountLogLinear 1.0e-10 [] Nothing) False
mc <- multiCurve 1.0e-10
curve3m <- addBootstrappedCurve mc intcurve3m ptr3m
ptrois <- zeroSpreadedTermStructure intcurve3m b IR.Continuous NoFrequency
curveois <- addNonBootstrappedCurve mc intcurveois ptrois
pricing3m <- iborIndex Euribor3M (Just curve3m)
pure (thirty360, pricing3m, 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 (DepositTenor (6, Months) 2 cal ModifiedFollowing True euriborDC)
h2 <- depositRateHelper q2 (DepositTenor (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] Nothing) False
curveMostlyQ1 <- piecewiseYieldCurve (SettlementDays 0 cal) helpers euriborDC []
(GlobalDiscountLogLinear 1.0e-10 [0.9, 0.1] Nothing) 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)
-- Deposit helpers isolate pillar values from interpolation between pillars, so both
-- curve types must reprice them to the same discounts at maturity.
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 (DepositTenor (i, Months) 2 cal ModifiedFollowing True euriborDC)) [1 .. 5 :: Int]
helpersZero <- mapM (\i -> depositRateHelper q (DepositTenor (i, Months) 2 cal ModifiedFollowing True euriborDC)) [1 .. 5 :: Int]
discountCurve <- piecewiseYieldCurve (SettlementDays 0 cal) (fromList helpersDiscount) euriborDC []
(GlobalDiscountLogLinear 1.0e-10 [] Nothing) False
zeroCurve <- piecewiseYieldCurve (SettlementDays 0 cal) (fromList helpersZero) euriborDC []
(GlobalSimpleZeroLinear 1.0e-10 [] Nothing) 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 (DepositTenor (i, Months) 2 cal ModifiedFollowing True euriborDC)) [1 .. 5 :: Int]
helpersZero <- mapM (\i -> depositRateHelper q (DepositTenor (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])
-- Additional helpers and dates must preserve each deposit's fitted quote.
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 (DepositTenor (i, Months) 2 cal ModifiedFollowing True euriborDC)) [1 .. 5 :: Int]
-- Keep extra dates between pillars so GlobalBootstrap has distinct unknowns.
extraDates <- mapM (\d -> advance cal settleFix (d, Days) ModifiedFollowing True) [45, 75, 105 :: Int]
-- Match the helpers' two-day settlement so their start date anchors the discount.
curve <- piecewiseYieldCurve (SettlementDays 2 cal) helpers euriborDC []
(GlobalSimpleZeroLinearFull helpers extraDates 1.0e-10 [] Nothing) False
mapM_ (\i -> do
pillar <- advance cal settleFix (i, Months) ModifiedFollowing True
-- Actual360's year fraction is actual days divided by 360.
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 (DepositTenor (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 (DepositTenor (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 [] Nothing) False >>= checkCurve
piecewiseYieldCurve reference helpers euriborDC [] (GlobalSimpleZeroLinear 1.0e-10 [] Nothing) False >>= checkCurve
piecewiseYieldCurve reference helpers euriborDC [] (GlobalSimpleZeroLinearFull helpers extraDates 1.0e-10 [] Nothing) False >>= checkCurve
piecewiseYieldCurve reference helpers euriborDC [] (GlobalForwardRateLinear 1.0e-10 [] Nothing) False >>= checkCurve
piecewiseYieldCurve reference helpers euriborDC [] (GlobalZeroYieldLinear 1.0e-10 [] Nothing) 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])
-- ForwardRate/Linear and ZeroYield/Linear must also reprice their input instruments.
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 (DepositTenor (i, Months) 2 cal ModifiedFollowing True euriborDC)) [1 .. 5 :: Int]
discountCurve <- piecewiseYieldCurve (SettlementDays 0 cal) helpers euriborDC []
(GlobalDiscountLogLinear 1.0e-10 [] Nothing) False
forwardCurve <- piecewiseYieldCurve (SettlementDays 0 cal) helpers euriborDC []
(GlobalForwardRateLinear 1.0e-10 [] Nothing) False
zeroCurve <- piecewiseYieldCurve (SettlementDays 0 cal) helpers euriborDC []
(GlobalZeroYieldLinear 1.0e-10 [] Nothing) 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
describe "extended Black variance surface" $
it "rejects QuantLib <= 1.43 before entering its out-of-bounds implementation" $
Context.keepingSettingsGc $ do
let refDate = 15 `january` 2024
Context.setEvaluationDate (Just refDate)
d1 <- addPeriod refDate (1, Years)
d2 <- addPeriod refDate (2, Years)
cal <- Calendar.calendar TARGET
dc <- dayCounter Actual365FixedStandard
quotes <- mapM Quote.simpleQuote [0.20, 0.21, 0.22, 0.23]
let vols = either error id $ objectMatrix 2 2 quotes
construct = Vol.extendedBlackVarianceSurface refDate cal [d1, d2] [90, 110] vols dc
Vol.ExtendedBlackVarianceSurfaceConstantExtrapolation
Vol.ExtendedBlackVarianceSurfaceConstantExtrapolation
if quantLibAtMost143
then construct `shouldThrow` \case
Context.CPlusPlusException message ->
"implementation accesses the volatility grid out of bounds" `isInfixOf` message
_ -> False
else do
surface <- construct
Vol.blackVol surface (DatePoint d1) 90 False `shouldReturn` 0.20
-- 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 False
v <- Vol.swaptionVolatility cube (Vol.OptionDate (10 `december` 2013)) (Vol.SwapTenor (2, Years)) 0.03 False
when quantLibAtMost143 $
Vol.sabrSwaptionVolatilityCube atmVol optionTenors swapTenors strikeSpreads volSpreads
swapIndexBase shortSwapIndexBase False parametersGuess
False True False False False Nothing Nothing False 50 False 0.0001 Nothing Nothing True
`shouldThrow` unsupportedQuantLib144 "sabrSwaptionVolatilityCube"
-- 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 False
-- 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 False
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) False
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 False
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 False
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)
-- The same fixture with a fifth (gamma) guess column; gamma = 1 approximates SABR, and beta
-- and gamma stay fixed because three strikes cannot identify five parameters.
it "zabrSwaptionVolatilityCube reprices close to its own flat ATM input and reports ZABR nodes" $
Context.keepingSettingsGc $ do
(_, _, atmVol, swapIndexBase, shortSwapIndexBase, volSpreads, _) <- mkFixture
let nodeCount = length optionTenors * length swapTenors
guessQuotes <- concat <$> replicateM nodeCount (mapM Quote.simpleQuote ([0.03, 0.5, 0.3, 0.0, 1.0] :: [Double]))
let parametersGuess = either error id $ objectMatrix (fromIntegral nodeCount) 5 guessQuotes
cube <- Vol.zabrSwaptionVolatilityCube atmVol optionTenors swapTenors strikeSpreads volSpreads
swapIndexBase shortSwapIndexBase False parametersGuess
False True False False True False Nothing Nothing False 50 False 0.0001 Nothing Nothing False
v <- Vol.swaptionVolatility cube (Vol.OptionDate (10 `december` 2013)) (Vol.SwapTenor (2, Years)) 0.03 False
abs (v - flatVol) `shouldSatisfy` (< 1.0e-2)
sparse <- Vol.zabrSparseParameters cube
realMatrixRows sparse `shouldBe` fromIntegral nodeCount
-- 2 metadata columns + 5 ZABR params + forward/error/maxError/endCriteria
realMatrixColumns sparse `shouldBe` 11
k <- Vol.atmStrike cube (Vol.AtmStrikeTenor (1, Years)) (2 :: Word, Years)
k `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