{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE ScopedTypeVariables #-}
module QuantLib.Stochastic.Process
        ( module QuantLib.Stochastic.Process )
        where

import           Data.List                  (foldl')
import           QuantLib.Stochastic.Random (NormalGenerator (..))

-- | Discretization of stochastic process over given interval
class Discretize b where
        dDrift :: StochasticProcess a => a->b->Dot->Double
        dDiff  :: StochasticProcess a => a->b->Dot->Double
        dDt    :: StochasticProcess a => a->b->Dot->Double

-- | 1D Stochastic process
class StochasticProcess a where
        drift  :: a -> Dot -> Double
        diff   :: a -> Dot -> Double
        evolve :: Discretize b=> b -> a -> Dot -> Double -> Dot
        evolve b
discr a
p Dot
dot Double
dw = Double -> Double -> Dot
Dot Double
newT Double
newX
                where   !newT :: Double
newT = Dot -> Double
getT Dot
dot Double -> Double -> Double
forall a. Num a => a -> a -> a
+ a -> b -> Dot -> Double
forall b a.
(Discretize b, StochasticProcess a) =>
a -> b -> Dot -> Double
dDt a
p b
discr Dot
dot
                        !newX :: Double
newX = Dot -> Double
getX Dot
dot Double -> Double -> Double
forall a. Num a => a -> a -> a
+ a -> b -> Dot -> Double
forall b a.
(Discretize b, StochasticProcess a) =>
a -> b -> Dot -> Double
dDrift a
p b
discr Dot
dot Double -> Double -> Double
forall a. Num a => a -> a -> a
+ a -> b -> Dot -> Double
forall b a.
(Discretize b, StochasticProcess a) =>
a -> b -> Dot -> Double
dDiff a
p b
discr Dot
dot Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dw

-- | Dot. t and x pair
data Dot = Dot { Dot -> Double
getT :: {-# UNPACK #-} !Double, Dot -> Double
getX :: {-# UNPACK #-} !Double }
        deriving (Int -> Dot -> ShowS
[Dot] -> ShowS
Dot -> String
(Int -> Dot -> ShowS)
-> (Dot -> String) -> ([Dot] -> ShowS) -> Show Dot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dot] -> ShowS
$cshowList :: [Dot] -> ShowS
show :: Dot -> String
$cshow :: Dot -> String
showsPrec :: Int -> Dot -> ShowS
$cshowsPrec :: Int -> Dot -> ShowS
Show, Dot -> Dot -> Bool
(Dot -> Dot -> Bool) -> (Dot -> Dot -> Bool) -> Eq Dot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dot -> Dot -> Bool
$c/= :: Dot -> Dot -> Bool
== :: Dot -> Dot -> Bool
$c== :: Dot -> Dot -> Bool
Eq)

-- | Path as list of Dots
type Path = [Dot]

-- | Generates sample path for given stochastic process under discretization and normal generator for given amount of steps, starting from x0
generatePath :: (StochasticProcess a, NormalGenerator b, Discretize c) => b->c->a->Int->Dot->Path
generatePath :: b -> c -> a -> Int -> Dot -> [Dot]
generatePath b
rnd c
discr a
sp Int
steps Dot
x0 = [Dot] -> [Dot]
forall a. [a] -> [a]
reverse [Dot]
path
  where
        (![Double]
list, b
_) = (([Double], b) -> Int -> ([Double], b))
-> ([Double], b) -> [Int] -> ([Double], b)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([Double], b) -> Int -> ([Double], b)
forall b p.
NormalGenerator b =>
([Double], b) -> p -> ([Double], b)
generator ([], b
rnd) [Int
1..Int
steps]
        !path :: [Dot]
path = ([Dot] -> Double -> [Dot]) -> [Dot] -> [Double] -> [Dot]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Dot] -> Double -> [Dot]
evolver [Dot
x0] [Double]
list
        evolver :: [Dot] -> Double -> [Dot]
evolver [Dot]
p Double
dw = c -> a -> Dot -> Double -> Dot
forall a b.
(StochasticProcess a, Discretize b) =>
b -> a -> Dot -> Double -> Dot
evolve c
discr a
sp ([Dot] -> Dot
forall a. [a] -> a
head [Dot]
p) Double
dw Dot -> [Dot] -> [Dot]
forall a. a -> [a] -> [a]
: [Dot]
p
        generator :: ([Double], b) -> p -> ([Double], b)
generator ([Double]
l, b
r) p
_ = (Double
pDouble -> [Double] -> [Double]
forall a. a -> [a] -> [a]
:[Double]
l, b
newRnd)
          where
                (!Double
p, b
newRnd) = b -> (Double, b)
forall a. NormalGenerator a => a -> (Double, a)
ngGetNext b
r

-- | Geometric Brownian motion
data GeometricBrownian = GeometricBrownian {
        GeometricBrownian -> Double
gbDrift :: Double,
        GeometricBrownian -> Double
gbDiff  :: Double
        } deriving (Int -> GeometricBrownian -> ShowS
[GeometricBrownian] -> ShowS
GeometricBrownian -> String
(Int -> GeometricBrownian -> ShowS)
-> (GeometricBrownian -> String)
-> ([GeometricBrownian] -> ShowS)
-> Show GeometricBrownian
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GeometricBrownian] -> ShowS
$cshowList :: [GeometricBrownian] -> ShowS
show :: GeometricBrownian -> String
$cshow :: GeometricBrownian -> String
showsPrec :: Int -> GeometricBrownian -> ShowS
$cshowsPrec :: Int -> GeometricBrownian -> ShowS
Show)

instance StochasticProcess GeometricBrownian where
        drift :: GeometricBrownian -> Dot -> Double
drift GeometricBrownian
p (Dot Double
_ Double
x) = GeometricBrownian -> Double
gbDrift GeometricBrownian
p Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x
        diff :: GeometricBrownian -> Dot -> Double
diff  GeometricBrownian
p (Dot Double
_ Double
x) = GeometricBrownian -> Double
gbDiff GeometricBrownian
p  Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x

-- | Ito process
data ItoProcess = ItoProcess {
        ItoProcess -> Dot -> Double
ipDrift :: Dot->Double,
        ItoProcess -> Dot -> Double
ipDiff  :: Dot->Double
        }

instance StochasticProcess ItoProcess where
        drift :: ItoProcess -> Dot -> Double
drift   = ItoProcess -> Dot -> Double
ipDrift
        diff :: ItoProcess -> Dot -> Double
diff    = ItoProcess -> Dot -> Double
ipDiff

-- | Square-root process
data SquareRootProcess = SquareRootProcess {
        SquareRootProcess -> Double
srpSpeed :: Double,
        SquareRootProcess -> Double
srpMean  :: Double,
        SquareRootProcess -> Double
srpSigma :: Double
        } deriving (Int -> SquareRootProcess -> ShowS
[SquareRootProcess] -> ShowS
SquareRootProcess -> String
(Int -> SquareRootProcess -> ShowS)
-> (SquareRootProcess -> String)
-> ([SquareRootProcess] -> ShowS)
-> Show SquareRootProcess
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SquareRootProcess] -> ShowS
$cshowList :: [SquareRootProcess] -> ShowS
show :: SquareRootProcess -> String
$cshow :: SquareRootProcess -> String
showsPrec :: Int -> SquareRootProcess -> ShowS
$cshowsPrec :: Int -> SquareRootProcess -> ShowS
Show)

instance StochasticProcess SquareRootProcess where
       drift :: SquareRootProcess -> Dot -> Double
drift SquareRootProcess
p (Dot Double
_ Double
x) = SquareRootProcess -> Double
srpSpeed SquareRootProcess
p Double -> Double -> Double
forall a. Num a => a -> a -> a
* (SquareRootProcess -> Double
srpMean SquareRootProcess
p Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x)
       diff :: SquareRootProcess -> Dot -> Double
diff  SquareRootProcess
p (Dot Double
_ Double
x) = SquareRootProcess -> Double
srpSigma SquareRootProcess
p Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sqrt Double
x

-- | Ornstein-Uhlenbeck process
data OrnsteinUhlenbeckProcess = OrnsteinUhlenbeckProcess {
        OrnsteinUhlenbeckProcess -> Double
oupSpeed :: Double,
        OrnsteinUhlenbeckProcess -> Double
oupLevel :: Double,
        OrnsteinUhlenbeckProcess -> Double
oupSigma :: Double
        } deriving (Int -> OrnsteinUhlenbeckProcess -> ShowS
[OrnsteinUhlenbeckProcess] -> ShowS
OrnsteinUhlenbeckProcess -> String
(Int -> OrnsteinUhlenbeckProcess -> ShowS)
-> (OrnsteinUhlenbeckProcess -> String)
-> ([OrnsteinUhlenbeckProcess] -> ShowS)
-> Show OrnsteinUhlenbeckProcess
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrnsteinUhlenbeckProcess] -> ShowS
$cshowList :: [OrnsteinUhlenbeckProcess] -> ShowS
show :: OrnsteinUhlenbeckProcess -> String
$cshow :: OrnsteinUhlenbeckProcess -> String
showsPrec :: Int -> OrnsteinUhlenbeckProcess -> ShowS
$cshowsPrec :: Int -> OrnsteinUhlenbeckProcess -> ShowS
Show)

instance StochasticProcess OrnsteinUhlenbeckProcess where
        drift :: OrnsteinUhlenbeckProcess -> Dot -> Double
drift OrnsteinUhlenbeckProcess
p (Dot Double
_ Double
x) = OrnsteinUhlenbeckProcess -> Double
oupSpeed OrnsteinUhlenbeckProcess
p Double -> Double -> Double
forall a. Num a => a -> a -> a
* (OrnsteinUhlenbeckProcess -> Double
oupLevel OrnsteinUhlenbeckProcess
p Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x)
        diff :: OrnsteinUhlenbeckProcess -> Dot -> Double
diff  OrnsteinUhlenbeckProcess
p Dot
_         = OrnsteinUhlenbeckProcess -> Double
oupSigma OrnsteinUhlenbeckProcess
p

-- | Generalized Black-Scholes process
data BlackScholesProcess = BlackScholesProcess {
        BlackScholesProcess -> Double -> Double
bspRiskFree :: Double->Double,
        BlackScholesProcess -> Double -> Double
bspDividend :: Double->Double,
        BlackScholesProcess -> Dot -> Double
bspBlackVol :: Dot->Double
        }

instance StochasticProcess BlackScholesProcess where
        drift :: BlackScholesProcess -> Dot -> Double
drift (BlackScholesProcess Double -> Double
r Double -> Double
q Dot -> Double
v) Dot
dot = Double -> Double
r (Dot -> Double
getT Dot
dot) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
q ( Dot -> Double
getT Dot
dot) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Dot -> Double
v Dot
dot Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2
        diff :: BlackScholesProcess -> Dot -> Double
diff = BlackScholesProcess -> Dot -> Double
bspBlackVol