{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module Q.Greeks
  (
    module Q.Types
  , module Q.Options
  , Bump (..)
  , DiffMethod(..)
  , Bumpable(..)
  , firstOrder
  ) where

import Q.Types
import Q.Options
import Data.Coerce

-- | A relative or an absolute bump. Used with numerical Greeks.
data Bump = Abs Double
          | Rel Double

data DiffMethod = ForwardDiff
                | BackwardDiff
                | CenteralDiff

class Bumpable a where
  bumpUp   :: a -> Bump -> a
  bumpDown :: a -> Bump -> a
  stepSize :: a -> Bump -> Double

-- | Things we can bump to calculate Greeks such as 'Spot', 'Rate'..etc'
instance (Coercible a Double) => Bumpable a where
  bumpUp :: a -> Bump -> a
bumpUp a
a (Abs Double
bump) = Double -> a
coerce (Double -> a) -> Double -> a
forall a b. (a -> b) -> a -> b
$ a -> Double
coerce a
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
bump
  bumpUp a
a (Rel Double
bump) = Double -> a
coerce (Double -> a) -> Double -> a
forall a b. (a -> b) -> a -> b
$ a -> Double
coerce a
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
bump)

  bumpDown :: a -> Bump -> a
bumpDown a
a (Abs Double
bump) = Double -> a
coerce (Double -> a) -> Double -> a
forall a b. (a -> b) -> a -> b
$ a -> Double
coerce a
a Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
bump
  bumpDown a
a (Rel Double
bump) = Double -> a
coerce (Double -> a) -> Double -> a
forall a b. (a -> b) -> a -> b
$ a -> Double
coerce a
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
bump)

  stepSize :: a -> Bump -> Double
stepSize a
_ (Abs Double
bump)  = Double
bump
  stepSize a
s (Rel Double
bump) = a -> Double
coerce a
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
bump



firstOrder :: (Bumpable a) => DiffMethod -> Bump -> (a -> Double) -> a -> Double
firstOrder :: DiffMethod -> Bump -> (a -> Double) -> a -> Double
firstOrder DiffMethod
ForwardDiff Bump
b a -> Double
f a
a =  Double
df Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dx
  where df :: Double
df = a -> Double
f a
a' Double -> Double -> Double
forall a. Num a => a -> a -> a
- a -> Double
f a
a
        a' :: a
a' = a -> Bump -> a
forall a. Bumpable a => a -> Bump -> a
bumpUp a
a Bump
b
        dx :: Double
dx = a -> Bump -> Double
forall a. Bumpable a => a -> Bump -> Double
stepSize a
a Bump
b :: Double

firstOrder DiffMethod
BackwardDiff Bump
d a -> Double
f a
a = Double
df Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dx
   where df :: Double
df = a -> Double
f a
a Double -> Double -> Double
forall a. Num a => a -> a -> a
- a -> Double
f a
a'
         a' :: a
a' = a -> Bump -> a
forall a. Bumpable a => a -> Bump -> a
bumpDown a
a Bump
d
         dx :: Double
dx = Double -> Double
forall a. Num a => a -> a
negate (a -> Bump -> Double
forall a. Bumpable a => a -> Bump -> Double
stepSize a
a Bump
d )

firstOrder DiffMethod
CenteralDiff Bump
b a -> Double
f a
a = Double
df Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dx
   where df :: Double
df = a -> Double
f a
u Double -> Double -> Double
forall a. Num a => a -> a -> a
- a -> Double
f a
d
         u :: a
u = a -> Bump -> a
forall a. Bumpable a => a -> Bump -> a
bumpUp a
a Bump
b
         d :: a
d = a -> Bump -> a
forall a. Bumpable a => a -> Bump -> a
bumpDown a
a Bump
b
         dx :: Double
dx = Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* a -> Bump -> Double
forall a. Bumpable a => a -> Bump -> Double
stepSize a
a Bump
b