{-# LANGUAGE BangPatterns #-}
module QuantLib.Methods.Pricer
      ( MaxMinClosePricer (..)
      , LastPointPricer (..)
      , LogLastPointPricer (..)
      ) where

import           QuantLib.Methods.MonteCarlo (PathPricer (..))
import           QuantLib.Stochastic.Process (Dot (..))

data MaxMinClosePricer = MMCP {
        MaxMinClosePricer -> Double
mmcpHigh  :: Double,
        MaxMinClosePricer -> Double
mmcpLow   :: Double,
        MaxMinClosePricer -> Double
mmcpClose :: Double
        } deriving (Int -> MaxMinClosePricer -> ShowS
[MaxMinClosePricer] -> ShowS
MaxMinClosePricer -> String
(Int -> MaxMinClosePricer -> ShowS)
-> (MaxMinClosePricer -> String)
-> ([MaxMinClosePricer] -> ShowS)
-> Show MaxMinClosePricer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaxMinClosePricer] -> ShowS
$cshowList :: [MaxMinClosePricer] -> ShowS
show :: MaxMinClosePricer -> String
$cshow :: MaxMinClosePricer -> String
showsPrec :: Int -> MaxMinClosePricer -> ShowS
$cshowsPrec :: Int -> MaxMinClosePricer -> ShowS
Show)

instance PathPricer MaxMinClosePricer where
        ppPrice :: MaxMinClosePricer -> Path -> MaxMinClosePricer
ppPrice MaxMinClosePricer
_ Path
path = Double -> Double -> Double -> MaxMinClosePricer
MMCP Double
high Double
low Double
close
                where   !close :: Double
close   = [Double] -> Double
forall a. [a] -> a
last [Double]
xs
                        !high :: Double
high    = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
xs
                        !low :: Double
low     = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
xs
                        xs :: [Double]
xs      = (Dot -> Double) -> Path -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Dot -> Double
getX Path
path

-- | This pricer gets the last point of path
newtype LastPointPricer = LastPointPricer Double

instance PathPricer LastPointPricer where
        ppPrice :: LastPointPricer -> Path -> LastPointPricer
ppPrice LastPointPricer
_ = Double -> LastPointPricer
LastPointPricer (Double -> LastPointPricer)
-> (Path -> Double) -> Path -> LastPointPricer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dot -> Double
getX (Dot -> Double) -> (Path -> Dot) -> Path -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Dot
forall a. [a] -> a
last

-- | This pricer estimates the log of difference between start and end of process
newtype LogLastPointPricer = LogLastPointPricer Double

instance PathPricer LogLastPointPricer where
        ppPrice :: LogLastPointPricer -> Path -> LogLastPointPricer
ppPrice LogLastPointPricer
_ Path
path = Double -> LogLastPointPricer
LogLastPointPricer (Double -> Double
forall a. Floating a => a -> a
log (Double
lastX Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
firstX))
          where
            lastX :: Double
lastX = Dot -> Double
getX (Dot -> Double) -> Dot -> Double
forall a b. (a -> b) -> a -> b
$ Path -> Dot
forall a. [a] -> a
last Path
path
            firstX :: Double
firstX = Dot -> Double
getX (Dot -> Double) -> Dot -> Double
forall a b. (a -> b) -> a -> b
$ Path -> Dot
forall a. [a] -> a
head Path
path