{-# LANGUAGE BangPatterns           #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
module QuantLib.Methods.MonteCarlo
        ( module QuantLib.Methods.MonteCarlo
        ) where

import           Control.Monad               ()
import           Control.Parallel.Strategies
import           QuantLib.Stochastic.Process
import           QuantLib.Stochastic.Random

-- | Summary type class aggregates all priced values of paths
class PathPricer p => Summary m p | m->p where
        -- | Updates summary with given priced pathes
        sSummarize      :: m -> [p] -> m
        -- | Defines a metric, i.e. calculate distance between 2 summaries
        sNorm           :: m -> m -> Double

-- | Path generator is a stochastic path generator
class PathGenerator m where
        pgMkNew         :: m->IO m
        pgGenerate      :: Integer -> m->Path

-- | Path pricer provides a price for given path
class PathPricer m where
        ppPrice         :: m -> Path -> m


-- | Monte Carlo engine function
monteCarlo :: (Summary s p, PathGenerator g) => PathMonteCarlo s p g->Int->s
monteCarlo :: PathMonteCarlo s p g -> Int -> s
monteCarlo (PathMonteCarlo s
s p
p g
g) Int
size = s -> [p] -> s
forall m p. Summary m p => m -> [p] -> m
sSummarize s
s [p]
priced
  where
        !priced :: [p]
priced = (Int -> p) -> [Int] -> [p]
forall a b. (a -> b) -> [a] -> [b]
map Int -> p
forall a. Integral a => a -> p
pricing [Int
1..Int
size]
        pricing :: a -> p
pricing a
seed = p -> Path -> p
forall m. PathPricer m => m -> Path -> m
ppPrice p
p (Integer -> g -> Path
forall m. PathGenerator m => Integer -> m -> Path
pgGenerate (a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
seed) g
g)

-- | Monte Carlo engine function. Parallelized version
monteCarloParallel :: (Summary s p, PathGenerator g) => PathMonteCarlo s p g->Int->s
monteCarloParallel :: PathMonteCarlo s p g -> Int -> s
monteCarloParallel (PathMonteCarlo s
s p
p g
g) Int
size = s -> [p] -> s
forall m p. Summary m p => m -> [p] -> m
sSummarize s
s [p]
priced
  where
        !priced :: [p]
priced = (Int -> p) -> [Int] -> [p]
forall a b. (a -> b) -> [a] -> [b]
map Int -> p
forall a. Integral a => a -> p
pricing [Int
1..Int
size] [p] -> Strategy [p] -> [p]
forall a. a -> Strategy a -> a
`using` Strategy [p]
forall a. Strategy a
rpar
        pricing :: a -> p
pricing a
seed = p -> Path -> p
forall m. PathPricer m => m -> Path -> m
ppPrice p
p (Integer -> g -> Path
forall m. PathGenerator m => Integer -> m -> Path
pgGenerate (a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
seed) g
g)

-- | Path-dependant Monte Carlo engine
data PathMonteCarlo s p g =
        PathMonteCarlo {
                PathMonteCarlo s p g -> s
pmcSummary   :: s,
                PathMonteCarlo s p g -> p
pmcPricer    :: p,
                PathMonteCarlo s p g -> g
pmcGenerator :: g
        }

-- | Stochastic process generator
data ProcessGenerator sp b d =
        ProcessGenerator {
                ProcessGenerator sp b d -> Dot
pgStart      :: Dot,
                ProcessGenerator sp b d -> Int
pgLength     :: Int,
                ProcessGenerator sp b d -> sp
pgProcess    :: sp,
                ProcessGenerator sp b d -> b
pgGenerator  :: b,
                ProcessGenerator sp b d -> d
pgDiscretize :: d
        }

instance (StochasticProcess sp, NormalGenerator b, Discretize d) => PathGenerator (ProcessGenerator sp b d) where
        pgMkNew :: ProcessGenerator sp b d -> IO (ProcessGenerator sp b d)
pgMkNew (ProcessGenerator Dot
start Int
len sp
process b
rnd d
d)       = do
                b
newRnd <- b -> IO b
forall a. NormalGenerator a => a -> IO a
ngMkNew b
rnd
                ProcessGenerator sp b d -> IO (ProcessGenerator sp b d)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessGenerator sp b d -> IO (ProcessGenerator sp b d))
-> ProcessGenerator sp b d -> IO (ProcessGenerator sp b d)
forall a b. (a -> b) -> a -> b
$! Dot -> Int -> sp -> b -> d -> ProcessGenerator sp b d
forall sp b d.
Dot -> Int -> sp -> b -> d -> ProcessGenerator sp b d
ProcessGenerator Dot
start Int
len sp
process b
newRnd d
d
        pgGenerate :: Integer -> ProcessGenerator sp b d -> Path
pgGenerate Integer
seed (ProcessGenerator Dot
start Int
len sp
sp b
b d
d) = b -> d -> sp -> Int -> Dot -> Path
forall a b c.
(StochasticProcess a, NormalGenerator b, Discretize c) =>
b -> c -> a -> Int -> Dot -> Path
generatePath b
newB d
d sp
sp Int
len Dot
start
          where (b
_, b
newB) = Integer -> b -> (b, b)
forall a. NormalGenerator a => Integer -> a -> (a, a)
ngSplitWithSeed Integer
seed b
b