hasquant-0.7.0.0: test/example/QuantLib/Example/TARF.hs
module QuantLib.Example.TARF
(
run
, Result(..)
) where
import Control.Monad(replicateM)
import Data.Time.Calendar(fromGregorian)
import Data.List.NonEmpty(fromList, toList)
import qualified Data.Vector.Storable as V
import QuantLib.Time.Calendar
import QuantLib.Time.Date
import QuantLib.Time.Schedule
import QuantLib.CashFlow
--import QuantLib.InterestRate
import QuantLib.Math
import QuantLib.Process
import QuantLib.Quote
import QuantLib.TermStructure.Yield
import QuantLib.TermStructure.Volatility
import QuantLib.Method
import QuantLib.Context
data State = State{_remPL :: !Double, _flows :: ![Double]}
data Result = Result{rnpv :: !Double, implFwds :: ![Double], simFwds :: ![Double]}
roundTo :: Double -> Int -> Double
roundTo x n = fromIntegral (round (x*mult) :: Int) / mult where mult = 10.0**fromIntegral n
run :: IO Result
run = do
setEvaluationDate (Just valDate)
calILS <- calendar IsraelSettlement
calEUR <- calendar TARGET
calEURILS <- calendar $ Joint2 calILS calEUR JoinHolidays
dcEUR <- dayCounter (Actual360 False)
dcILS <- dayCounter Actual365FixedStandard
sched <- schedule (Just $ 2 `november` 2022) (2 `october` 2023) (1, Months) calEUR ModifiedFollowing ModifiedFollowing Forward False Nothing Nothing
ds_ <- dates sched
let ds = fromList ds_
mandatory <- V.fromList <$> mapM (\x -> yearFraction dcILS valDate x Nothing Nothing) (toList ds)
grid <- maybe (fail "TARF: empty mandatory time grid") timeGridFromVector (nonEmptyVector mandatory)
vols <- mapM (\(d, q) -> parse d >>= \x -> advance calEURILS valDate x ModifiedFollowing False >>= \dd -> return (dd, q/100)) vEURILS
volEURILS <- blackVarianceCurve valDate (fromList vols) dcILS True (Just Linear)
ycILS <- interpolatedDiscountCurve (fromList dfILS) dcILS calILS [] LogLinear False
ycEUR <- interpolatedDiscountCurve (fromList dfEUR) dcEUR calEUR [] LogLinear False
dfILS' <- points grid >>= mapM (\d -> discount ycILS (TimePoint d) False) . V.toList
dfEUR' <- points grid >>= mapM (\d -> discount ycEUR (TimePoint d) False) . V.toList
let fwds = map ((`roundTo` fxrateDigits) . (* spot)) $ zipWith (/) dfEUR' dfILS'
-- -- alternatively you can use Black-Scholes process
-- let dsILS = map fst dfILS
-- zrILS <- mapM (\x -> rate <$> zeroRate ycILS (RateAtDate x dcILS) Continuous Once False) dsILS
-- zrEUR <- mapM (\x -> rate <$> zeroRate ycEUR (RateAtDate x dcILS) Continuous Once False) dsILS
-- let mins = zipWith (-) zrEUR zrILS
-- yc <- interpolatedZeroCurve (zip dsILS mins) dcILS calILS [] Linear
-- proc <- blackScholesProcess spotQuote yc volEURILS EulerDiscretization >>= asStochasticProcess1D >>= asStochasticProcess
-- spotQuote <- simpleQuote spot
-- proc <- blackScholesMertonProcess spotQuote ycILS ycEUR volEURILS EulerDiscretization False
-- >>= asStochasticProcess1D >>= asStochasticProcess
spotQuote <- simpleQuote spot
proc <- garmanKohlhagenProcess spotQuote ycEUR ycILS volEURILS EulerDiscretization False
>>= asStochasticProcess1D >>= asStochasticProcess
-- fixed nonzero seed (0 means "seed from entropy" in QuantLib's
-- MersenneTwisterUniformRng) so the simulated path set, and hence rnpv/simFwds,
-- is reproducible for `test/QuantLib/Spec/Examples.hs`'s "check values" assertion
gen <- pathGenerator PseudoRandom proc grid 42 (size grid - 1) False
pps <- replicateM trials $ nextNPV gen (toList ds) ycILS
let (ps, sFwds) = unzip pps
let ff = map (\x -> roundTo (x/realToFrac trials) fxrateDigits) $ deepFold sFwds (+)
return $ Result ((`roundTo` notionalDigits) $ sum ps/fromIntegral trials/spot) fwds ff
where
valDate = 15 `august` 2022
strike = 3.2
spot = 3.3084
eurNotional = 500000
ilsTarget = 0.4 * eurNotional
leverage = 2.0
notionalDigits = 2
fxrateDigits = 4
trials = 2^(16::Int)
deepFold :: [[a]] -> (a -> a -> a) -> [a]
deepFold [] _ = []
deepFold (h:t) f = foldr (zipWith f) h t
nextNPV :: PathGenerator -> [Day] -> GenYieldTermStructure y -> IO (Double, [Double])
nextNPV g ds yc = do
s <- next g
sim <- asset s 0
let State _ fs = foldl genFlows (State ilsTarget []) $ map (`roundTo` fxrateDigits) (V.toList sim)
l <- leg $ zip ds fs
v <- (`roundTo` notionalDigits) <$> npv l (DiscountingCurve yc) True Nothing Nothing
return (v, V.toList sim)
genFlows :: State -> Double -> State
genFlows s@(State 0 _) _ = s
genFlows (State tgt fs) spt | spt > strike = State (tgt-cash) (fs ++ [cash])
where cash = min (roundTo ((spt-strike)*eurNotional) notionalDigits) tgt
genFlows (State tgt fs) spt = State tgt (fs ++ [cash])
where cash = roundTo ((spt-strike)*eurNotional*leverage) notionalDigits
dfEUR = [(valDate, 1.0),
(fromGregorian 2022 09 16, 0.999910),
(fromGregorian 2022 10 18, 0.999818),
(fromGregorian 2022 11 16, 0.999734),
(fromGregorian 2022 12 16, 0.999520),
(fromGregorian 2023 01 16, 0.999267),
(fromGregorian 2023 02 16, 0.999013),
(fromGregorian 2023 03 16, 0.998445),
(fromGregorian 2023 04 17, 0.997667),
(fromGregorian 2023 05 16, 0.996962),
(fromGregorian 2023 06 16, 0.996122),
(fromGregorian 2023 07 17, 0.995263),
(fromGregorian 2023 08 16, 0.994432),
(fromGregorian 2023 09 18, 0.993524),
(fromGregorian 2023 10 16, 0.992756),
(fromGregorian 2023 11 16, 0.991907),
(fromGregorian 2023 12 18, 0.991030),
(fromGregorian 2024 01 16, 0.990237),
(fromGregorian 2024 02 16, 0.989389),
(fromGregorian 2024 03 18, 0.988542),
(fromGregorian 2024 04 16, 0.987751),
(fromGregorian 2024 05 16, 0.986933),
(fromGregorian 2024 06 17, 0.986061),
(fromGregorian 2024 07 16, 0.985271),
(fromGregorian 2024 08 16, 0.984428),
(fromGregorian 2024 09 16, 0.983618),
(fromGregorian 2024 10 16, 0.982840),
(fromGregorian 2024 11 18, 0.981986),
(fromGregorian 2024 12 16, 0.981261),
(fromGregorian 2025 01 16, 0.980460),
(fromGregorian 2025 02 17, 0.979633),
(fromGregorian 2025 03 17, 0.978911),
(fromGregorian 2025 04 16, 0.978137),
(fromGregorian 2025 05 16, 0.977364),
(fromGregorian 2025 06 16, 0.976565),
(fromGregorian 2025 07 16, 0.975794),
(fromGregorian 2025 08 18, 0.974945),
(fromGregorian 2025 09 16, 0.974162),
(fromGregorian 2025 10 16, 0.973349),
(fromGregorian 2025 11 17, 0.972484)]
dfILS = [(valDate, 1.0),
(fromGregorian 2022 09 16, 0.999573),
(fromGregorian 2022 10 18, 0.999132),
(fromGregorian 2022 11 16, 0.998733),
(fromGregorian 2022 12 16, 0.997864),
(fromGregorian 2023 01 16, 0.996849),
(fromGregorian 2023 02 16, 0.995835),
(fromGregorian 2023 03 16, 0.994821),
(fromGregorian 2023 04 17, 0.993626),
(fromGregorian 2023 05 16, 0.992544),
(fromGregorian 2023 06 16, 0.991427),
(fromGregorian 2023 07 17, 0.990321),
(fromGregorian 2023 08 16, 0.989251),
(fromGregorian 2023 09 18, 0.988081),
(fromGregorian 2023 10 16, 0.987090),
(fromGregorian 2023 11 16, 0.985994),
(fromGregorian 2023 12 18, 0.984864),
(fromGregorian 2024 01 16, 0.983841),
(fromGregorian 2024 02 16, 0.982748),
(fromGregorian 2024 03 18, 0.981657),
(fromGregorian 2024 04 16, 0.980638),
(fromGregorian 2024 05 16, 0.979584),
(fromGregorian 2024 06 17, 0.978461),
(fromGregorian 2024 07 16, 0.977445),
(fromGregorian 2024 08 16, 0.976360),
(fromGregorian 2024 09 16, 0.975416),
(fromGregorian 2024 10 16, 0.974531),
(fromGregorian 2024 11 18, 0.973557),
(fromGregorian 2024 12 16, 0.972732),
(fromGregorian 2025 01 16, 0.971819),
(fromGregorian 2025 02 17, 0.970878),
(fromGregorian 2025 03 17, 0.970055),
(fromGregorian 2025 04 16, 0.969174),
(fromGregorian 2025 05 16, 0.968294),
(fromGregorian 2025 06 16, 0.967386),
(fromGregorian 2025 07 16, 0.966507),
(fromGregorian 2025 08 18, 0.965542),
(fromGregorian 2025 09 16, 0.964752),
(fromGregorian 2025 10 16, 0.963940),
(fromGregorian 2025 11 17, 0.963074)]
vEURILS = [
("1D", 8.885),
("1W", 9.690),
("2W", 9.900),
("3W", 9.680),
("1M", 9.915),
("2M", 9.750),
("3M", 9.535),
("4M", 9.440),
("5M", 9.374),
("6M", 9.295),
("9M", 9.185),
("1Y", 9.130),
("18M", 9.295),
("2Y", 9.385),
("3Y", 9.300),
("4Y", 9.197),
("5Y", 9.115),
("6Y", 9.117),
("7Y", 9.122),
("10Y", 9.133),
("15Y", 9.148),
("20Y", 9.164),
("25Y", 9.180),
("30Y", 9.196)]
-- vim: set ft=haskell ff=unix ts=8 sts=2 sw=2 et: