{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Q.MonteCarlo where
import Control.Monad.State
import Data.RVar
import Q.Stochastic.Discretize
import Q.Stochastic.Process
import Control.Monad
import Q.ContingentClaim
import Data.Random
import Q.Time
import Data.Time
import Statistics.Distribution (cumulative)
import Statistics.Distribution.Normal (standard)
import Q.ContingentClaim.Options
import Q.Types
type Path b = [(Time, b)]
class (PathPricer p) => Summary m p | m->p where
sSummarize :: m -> [p] -> m
sNorm :: m -> m -> Double
class PathGenerator m where
pgMkNew :: m->IO m
pgGenerate :: Integer -> m -> Path b
class PathPricer m where
ppPrice :: m -> Path b -> m
type MonteCarlo s a = StateT [(Time, s)] RVar a
trajectory :: forall a b d. (StochasticProcess a b, Discretize d b) =>
d
-> a
-> b
-> [Time]
-> [RVar b]
-> RVar [b]
trajectory :: d -> a -> b -> [Time] -> [RVar b] -> RVar [b]
trajectory d
disc a
p b
s0 [Time]
times [RVar b]
dws = [b] -> [b]
forall a. [a] -> [a]
reverse ([b] -> [b]) -> RVar [b] -> RVar [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT [(Time, b)] RVar [b] -> [(Time, b)] -> RVar [b]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ([Time] -> [RVar b] -> StateT [(Time, b)] RVar [b]
onePath [Time]
times [RVar b]
dws) [(Time, b)]
initState' where
initState' :: [(Time, b)]
initState' :: [(Time, b)]
initState' = [(Time
0, b
s0)]
onePath :: [Time] -> [RVar b] -> MonteCarlo b [b]
onePath :: [Time] -> [RVar b] -> StateT [(Time, b)] RVar [b]
onePath [] [RVar b]
_ = do
[(Time, b)]
s <- StateT [(Time, b)] RVar [(Time, b)]
forall s (m :: * -> *). MonadState s m => m s
get
[b] -> StateT [(Time, b)] RVar [b]
forall (m :: * -> *) a. Monad m => a -> m a
return ([b] -> StateT [(Time, b)] RVar [b])
-> [b] -> StateT [(Time, b)] RVar [b]
forall a b. (a -> b) -> a -> b
$ ((Time, b) -> b) -> [(Time, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Time, b) -> b
forall a b. (a, b) -> b
snd [(Time, b)]
s
onePath (Time
t1:[Time]
tn) (RVar b
dw1:[RVar b]
dws) = do
[(Time, b)]
s <- StateT [(Time, b)] RVar [(Time, b)]
forall s (m :: * -> *). MonadState s m => m s
get
let t0 :: (Time, b)
t0 = [(Time, b)] -> (Time, b)
forall a. [a] -> a
head [(Time, b)]
s
b
b <- RVar b -> StateT [(Time, b)] RVar b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RVar b -> StateT [(Time, b)] RVar b)
-> RVar b -> StateT [(Time, b)] RVar b
forall a b. (a -> b) -> a -> b
$ a -> d -> (Time, b) -> Time -> RVar b -> RVar b
forall a b d.
(StochasticProcess a b, Discretize d b) =>
a -> d -> (Time, b) -> Time -> RVar b -> RVar b
pEvolve a
p d
disc (Time, b)
t0 Time
t1 RVar b
dw1
[(Time, b)] -> StateT [(Time, b)] RVar ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([(Time, b)] -> StateT [(Time, b)] RVar ())
-> [(Time, b)] -> StateT [(Time, b)] RVar ()
forall a b. (a -> b) -> a -> b
$ (Time
t1, b
b) (Time, b) -> [(Time, b)] -> [(Time, b)]
forall a. a -> [a] -> [a]
: [(Time, b)]
s
[Time] -> [RVar b] -> StateT [(Time, b)] RVar [b]
onePath [Time]
tn [RVar b]
dws
trajectories:: forall a b d. (StochasticProcess a b, Discretize d b) =>
Int
-> d
-> a
-> b
-> [Time]
-> [RVar b]
-> RVar [[b]]
trajectories :: Int -> d -> a -> b -> [Time] -> [RVar b] -> RVar [[b]]
trajectories Int
n d
disc a
p b
initState [Time]
times [RVar b]
dws = Int -> RVarT Identity [b] -> RVar [[b]]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (RVarT Identity [b] -> RVar [[b]])
-> RVarT Identity [b] -> RVar [[b]]
forall a b. (a -> b) -> a -> b
$ d -> a -> b -> [Time] -> [RVar b] -> RVarT Identity [b]
forall a b d.
(StochasticProcess a b, Discretize d b) =>
d -> a -> b -> [Time] -> [RVar b] -> RVar [b]
trajectory d
disc a
p b
initState [Time]
times [RVar b]
dws
observationTimes :: ContingentClaim a -> [Day]
observationTimes :: ContingentClaim a -> [Day]
observationTimes = ContingentClaim a -> [Day]
forall a. HasCallStack => a
undefined
class Model a b | a -> b where
discountFactor :: a -> YearFrac -> YearFrac -> RVar Rate
evolve :: a -> YearFrac -> StateT (YearFrac, b) RVar Double