{-# LANGUAGE MultiParamTypeClasses #-}

module Q.Options.Bachelier (
    Bachelier(..)
  , euOption
  , eucall
  , euput
  , module Q.Options
) where
import           Data.Time                      ()
import           Q.Stochastic.Discretize        ()
import           Q.Stochastic.Process           ()
import           Q.Time                         ()
import           Statistics.Distribution        (cumulative, density)
import           Statistics.Distribution.Normal (standard)
import           Control.Monad.State
import           Data.Random                    (RVar, stdNormal)
import           Q.MonteCarlo
import           Q.Options
import           Q.Types


data Bachelier = Bachelier Forward Rate Vol deriving Int -> Bachelier -> ShowS
[Bachelier] -> ShowS
Bachelier -> String
(Int -> Bachelier -> ShowS)
-> (Bachelier -> String)
-> ([Bachelier] -> ShowS)
-> Show Bachelier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bachelier] -> ShowS
$cshowList :: [Bachelier] -> ShowS
show :: Bachelier -> String
$cshow :: Bachelier -> String
showsPrec :: Int -> Bachelier -> ShowS
$cshowsPrec :: Int -> Bachelier -> ShowS
Show

-- | European option valuation with bachelier model.
euOption ::  Bachelier -> YearFrac -> OptionType -> Strike -> Valuation
euOption :: Bachelier -> YearFrac -> OptionType -> Strike -> Valuation
euOption (Bachelier (Forward Double
f) (Rate Double
r) (Vol Double
sigma)) (YearFrac Double
t) OptionType
cp (Strike Double
k)
  = Premium -> Delta -> Vega -> Gamma -> Valuation
Valuation Premium
premium Delta
delta Vega
vega Gamma
gamma where
    premium :: Premium
premium = Double -> Premium
Premium (Double -> Premium) -> Double -> Premium
forall a b. (a -> b) -> a -> b
$ Double
df Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
*(Double
f Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
k)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double -> Double
n(Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
d1) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
sigmaDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double -> Double
forall a. Floating a => a -> a
sqrt(Double
t)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
sqrt2Pi Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Double
forall a. Floating a => a -> a
exp(-Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
d1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d1)))
    delta :: Delta
delta   = Double -> Delta
Delta   (Double -> Delta) -> Double -> Delta
forall a b. (a -> b) -> a -> b
$ Double
df Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
n (Double
q Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d1)
    vega :: Vega
vega    = Double -> Vega
Vega    (Double -> Vega) -> Double -> Vega
forall a b. (a -> b) -> a -> b
$ Double
df Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Double
forall a. Floating a => a -> a
sqrt Double
t) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sqrt2Pi Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Double
forall a. Floating a => a -> a
exp (-Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d1))
    gamma :: Gamma
gamma   = Double -> Gamma
Gamma   (Double -> Gamma) -> Double -> Gamma
forall a b. (a -> b) -> a -> b
$ (Double
dfDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/(Double
sigma Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Double
forall a. Floating a => a -> a
sqrt Double
t)))Double -> Double -> Double
forall a. Num a => a -> a -> a
*(Double -> Double
forall a. Fractional a => a -> a
recip Double
sqrt2Pi)Double -> Double -> Double
forall a. Num a => a -> a -> a
*(Double -> Double
forall a. Floating a => a -> a
exp(-Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
d1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d1))
    d1 :: Double
d1 = (Double
f Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
k) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
sigma Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sqrt(Double
t))
    q :: Double
q = OptionType -> Double
forall p. Num p => OptionType -> p
cpi OptionType
cp
    sqrt2Pi :: Double
sqrt2Pi = Double -> Double
forall a. Floating a => a -> a
sqrt (Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi)
    df :: Double
df =  Double -> Double
forall a. Floating a => a -> a
exp (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ (-Double
r) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
t
    n :: Double -> Double
n = NormalDistribution -> Double -> Double
forall d. Distribution d => d -> Double -> Double
cumulative NormalDistribution
standard

-- | see 'euOption'
euput :: Bachelier -> YearFrac -> Strike -> Valuation
euput Bachelier
b YearFrac
t =  Bachelier -> YearFrac -> OptionType -> Strike -> Valuation
euOption Bachelier
b YearFrac
t OptionType
Put

-- | see 'euOption'
eucall :: Bachelier -> YearFrac -> Strike -> Valuation
eucall Bachelier
b YearFrac
t = Bachelier -> YearFrac -> OptionType -> Strike -> Valuation
euOption Bachelier
b YearFrac
t OptionType
Call


instance Model Bachelier Double where
  discountFactor :: Bachelier -> YearFrac -> YearFrac -> RVar Rate
discountFactor (Bachelier Forward
_ Rate
r Vol
_) YearFrac
t1 YearFrac
t2 = Rate -> RVar Rate
forall (m :: * -> *) a. Monad m => a -> m a
return (Rate -> RVar Rate) -> Rate -> RVar Rate
forall a b. (a -> b) -> a -> b
$ Rate -> Rate
forall a. Floating a => a -> a
exp (YearFrac -> Rate -> Rate
forall a. TimeScaleable a => YearFrac -> a -> a
scale YearFrac
dt Rate
r)
    where dt :: YearFrac
dt = YearFrac
t2 YearFrac -> YearFrac -> YearFrac
forall a. Num a => a -> a -> a
- YearFrac
t1

  evolve :: Bachelier -> YearFrac -> StateT (YearFrac, Double) RVar Double
evolve (Bachelier (Forward Double
f) (Rate Double
r) (Vol Double
sigma)) (YearFrac Double
t) = do
    (YearFrac Double
t0, Double
f0) <- StateT (YearFrac, Double) RVar (YearFrac, Double)
forall s (m :: * -> *). MonadState s m => m s
get
    let dt :: Double
dt = Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t0
    Double
dW <- (RVarT Identity Double -> StateT (YearFrac, Double) RVar Double
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift RVarT Identity Double
forall a. Distribution Normal a => RVar a
stdNormal)::StateT (YearFrac, Double) RVar Double
    let ft :: Double
ft = Double
f0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
exp (Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dt) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Floating a => a -> a
sqrt(Double
sigmaDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
sigmaDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* ((Double -> Double
forall a. Floating a => a -> a
exp (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dt)) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1)) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dW
    (YearFrac, Double) -> StateT (YearFrac, Double) RVar ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Double -> YearFrac
YearFrac Double
t, Double
ft)
    Double -> StateT (YearFrac, Double) RVar Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
ft