{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards       #-}

module Q.Options.BlackScholes (
    BlackScholes(..)
  , atmf
  , euOption
  , eucall
  , euput
  , module Q.Options
) where

import           Control.Monad.State
import           Data.Random                    hiding (Gamma)
import           Data.Time
import           Numeric.RootFinding
import           Q.ContingentClaim.Options
import           Q.MonteCarlo
import           Q.Options
import           Q.Stochastic.Discretize
import           Q.Stochastic.Process
import           Q.Time
import           Q.Types
import           Statistics.Distribution        (cumulative, density)
import           Statistics.Distribution.Normal (standard)
import qualified Q.Options.Black76 as B76

dcf :: Day -> Day -> Double
dcf = Thirty360 -> Day -> Day -> Double
forall m. DayCounter m => m -> Day -> Day -> Double
dcYearFraction Thirty360
ThirtyUSA

-- | Parameters for a simplified black scholes equation.
data BlackScholes = BlackScholes {
    BlackScholes -> Spot
bsSpot :: Spot -- ^ The asset's spot on the valuation date.
  , BlackScholes -> Rate
bsRate :: Rate   -- ^ Risk free rate.
  , BlackScholes -> Vol
bsVol  :: Vol    -- ^ Volatility.
} deriving Int -> BlackScholes -> ShowS
[BlackScholes] -> ShowS
BlackScholes -> String
(Int -> BlackScholes -> ShowS)
-> (BlackScholes -> String)
-> ([BlackScholes] -> ShowS)
-> Show BlackScholes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlackScholes] -> ShowS
$cshowList :: [BlackScholes] -> ShowS
show :: BlackScholes -> String
$cshow :: BlackScholes -> String
showsPrec :: Int -> BlackScholes -> ShowS
$cshowsPrec :: Int -> BlackScholes -> ShowS
Show



instance Model BlackScholes Double where
  discountFactor :: BlackScholes -> YearFrac -> YearFrac -> RVar Rate
discountFactor BlackScholes{Vol
Rate
Spot
bsVol :: Vol
bsRate :: Rate
bsSpot :: Spot
bsVol :: BlackScholes -> Vol
bsRate :: BlackScholes -> Rate
bsSpot :: BlackScholes -> Spot
..} 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
bsRate)
    where dt :: YearFrac
dt = YearFrac
t2 YearFrac -> YearFrac -> YearFrac
forall a. Num a => a -> a -> a
- YearFrac
t1

  evolve :: BlackScholes -> YearFrac -> StateT (YearFrac, Double) RVar Double
evolve (BlackScholes Spot
spot (Rate Double
r) (Vol Double
sigma)) (YearFrac Double
t) = do
    (YearFrac Double
t0, Double
s0) <- 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 st :: Double
st = Double
s0 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
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sigma Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sigma) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dt Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
sigma Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dw Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sqrt Double
dt)
    (YearFrac, Double) -> StateT (YearFrac, Double) RVar ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Double -> YearFrac
YearFrac Double
t, Double
st)
    Double -> StateT (YearFrac, Double) RVar Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
st

atmf :: BlackScholes -> YearFrac -> Strike
atmf :: BlackScholes -> YearFrac -> Strike
atmf BlackScholes{Vol
Rate
Spot
bsVol :: Vol
bsRate :: Rate
bsSpot :: Spot
bsVol :: BlackScholes -> Vol
bsRate :: BlackScholes -> Rate
bsSpot :: BlackScholes -> Spot
..} YearFrac
t = Double -> Strike
Strike (Double -> Strike) -> Double -> Strike
forall a b. (a -> b) -> a -> b
$ Double
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
d where
  (Rate Double
d) = Rate -> Rate
forall a. Floating a => a -> a
exp (YearFrac -> Rate -> Rate
forall a. TimeScaleable a => YearFrac -> a -> a
scale YearFrac
t (-Rate
bsRate))
  (Spot Double
s) = Spot
bsSpot



-- | European option valuation with black scholes.
euOption ::  BlackScholes ->  YearFrac -> OptionType -> Strike ->Valuation
euOption :: BlackScholes -> YearFrac -> OptionType -> Strike -> Valuation
euOption bs :: BlackScholes
bs@BlackScholes{Vol
Rate
Spot
bsVol :: Vol
bsRate :: Rate
bsSpot :: Spot
bsVol :: BlackScholes -> Vol
bsRate :: BlackScholes -> Rate
bsSpot :: BlackScholes -> Spot
..} YearFrac
t OptionType
cp Strike
k =
  let b76 :: Black76
b76 = Black76 :: Forward -> DF -> YearFrac -> Vol -> Black76
B76.Black76 {
          b76F :: Forward
b76F  = BlackScholes -> YearFrac -> Forward
forward BlackScholes
bs YearFrac
t
        , b76DF :: DF
b76DF = YearFrac -> Rate -> DF
Q.Types.discountFactor YearFrac
t Rate
bsRate
        , b76T :: YearFrac
b76T  = YearFrac
t
        , b76Vol :: Vol
b76Vol = Vol
bsVol
        }
  in Black76 -> OptionType -> Strike -> Valuation
B76.euOption Black76
b76 OptionType
cp Strike
k

-- | see 'euOption'
euput :: BlackScholes -> YearFrac -> Strike -> Valuation
euput BlackScholes
bs YearFrac
t = BlackScholes -> YearFrac -> OptionType -> Strike -> Valuation
euOption BlackScholes
bs YearFrac
t OptionType
Put
 
-- | see 'euOption'
eucall :: BlackScholes -> YearFrac -> Strike -> Valuation
eucall BlackScholes
bs YearFrac
t = BlackScholes -> YearFrac -> OptionType -> Strike -> Valuation
euOption BlackScholes
bs YearFrac
t OptionType
Call

forward :: BlackScholes -> YearFrac -> Forward
forward BlackScholes{Vol
Rate
Spot
bsVol :: Vol
bsRate :: Rate
bsSpot :: Spot
bsVol :: BlackScholes -> Vol
bsRate :: BlackScholes -> Rate
bsSpot :: BlackScholes -> Spot
..} (YearFrac Double
t) = Double -> Forward
Forward (Double -> Forward) -> Double -> Forward
forall a b. (a -> b) -> a -> b
$ Double
s 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
t)
  where (Spot Double
s) = Spot
bsSpot
        (Rate Double
r) = Rate
bsRate

corradoMillerIniitalGuess :: BlackScholes -> p -> Strike -> YearFrac -> Premium -> Double
corradoMillerIniitalGuess bs :: BlackScholes
bs@BlackScholes{Vol
Rate
Spot
bsVol :: Vol
bsRate :: Rate
bsSpot :: Spot
bsVol :: BlackScholes -> Vol
bsRate :: BlackScholes -> Rate
bsSpot :: BlackScholes -> Spot
..} p
cp (Strike Double
k) (YearFrac Double
t) (Premium Double
premium) =
  (Double -> Double
forall a. Fractional a => a -> a
recip (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ 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. Floating a => a -> a
sqrt (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
discountedStrike)) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
premium Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
discountedStrike)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Floating a => a -> a
sqrt ((Double
premium Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
discountedStrike)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)Double -> Double -> Double
forall a. Floating a => a -> a -> a
**Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- ((Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
discountedStrike)Double -> Double -> Double
forall a. Floating a => a -> a -> a
**Double
2Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
forall a. Floating a => a
pi))) where
    discountedStrike :: Double
discountedStrike = Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
* (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)
    (Rate Double
r) = Rate
bsRate
    (Spot Double
s) = Spot
bsSpot