netrium-0.6.0: share/Options.hs
-- |Netrium is Copyright Anthony Waite, Dave Hetwett, Shaun Laurens 2009-2015, and files herein are licensed
-- |under the MIT license, the text of which can be found in license.txt
--
-- Module for options
--
-- Options are built up as follows:
--
-- In general terms, an option is a contract that gives you the right, under
-- certain conditions, to buy (call) or sell (put) some underlying asset.
--
-- There are two separate aspects to an \"underlying\":
--
-- * There are the rights (ie a contract) you get when you choose to exercise
-- the option (e.g. the right to buy some physical or financial asset)
--
-- * An observable, usually related to the spot price of the physical or
-- financial asset that the option involves.
--
module Options where
import Prelude hiding (and, or, min, max, abs, negate, not, read, until)
import Contract
import Common
import Data.List (transpose)
import Data.Monoid
-- * Types
-- | Add an exercise condition to a contract, e.g. to add a barrier condition
type ExerciseCondition = Contract -> Contract
-- | Define a time window when a condition applies as a set of time ranges
type ConditionWindow = [(DateTime, DateTime)]
-- | An expiration condition
type ExpirationCondition = Contract -> Contract
-- | The spot price of the underlying asset
type UnderlyingPrice = Price
-- | The rights to acquire the underlying asset. This must include
-- any payments (which may depend on the option strike price).
--
type UnderlyingContract = StrikePrice -> Contract
-- | The price the option owner pays to acquire the underlying
type StrikePrice = Price
-- | The direction of the option (put or call)
data OptionDirection = CallOption -- ^ Option to buy underlying
| PutOption -- ^ Option to sell underlying
-- | Option contracts differ in the detail of when and at what price the
-- option can be exercised.
--
newtype ExerciseDetails
= ExerciseDetails (ChoiceId -> (StrikePrice -> Contract) -> Contract)
-- * Option template
-- | Basic option template. Flexibility is achieved through 'ExerciseDetails'.
option :: ChoiceId -- ^Choice label
-> ExerciseDetails -- ^Details of when and at what price the option can be exercised
-> OptionDirection -- ^Direction of the option (call or put)
-> OptionAttrs -- ^Extra option attributes / features
-> UnderlyingContract -- ^Underlying asset
-> Contract
option cid (ExerciseDetails exerciseDetails)
optionDirection (OptionAttrs attrs) underlyingContract
= attrs $ exerciseDetails cid $ \strikePrice ->
case optionDirection of
CallOption -> underlyingContract strikePrice
PutOption -> give (underlyingContract strikePrice)
-- ** Option atributes
-- | Additional optional attributes of an 'option'.
--
newtype OptionAttrs = OptionAttrs (Contract -> Contract)
instance Monoid OptionAttrs where
mempty = OptionAttrs id
mappend (OptionAttrs a) (OptionAttrs b) = OptionAttrs (b . a)
emptyOptionAttrs :: OptionAttrs
emptyOptionAttrs = mempty
-- | Pay the given premium on aquiring the option.
--
withPremium :: Price -> Currency -> OptionAttrs
withPremium premium cur =
OptionAttrs (and payPremium)
where
payPremium = give $ financial premium cur (CashFlowType "premium")
-- | Pay the given premium multiple times acording to the payment schedule.
--
withPremiumSchedule :: Price -> Currency -> Schedule -> OptionAttrs
withPremiumSchedule premium cur schedule =
OptionAttrs (and payPremium)
where
payPremium = scheduled payInstallment schedule
payInstallment = give $ financial premium cur (CashFlowType "premium")
-- * Templates for option parameters
-- ** Exercise time
-- | European exercise: option may be exercised only at the expiry date of the
-- option, i.e. at a single pre-defined point in time.
europeanExercise :: DateTime -> StrikePrice -> ExerciseDetails
europeanExercise exTime strikePrice =
ExerciseDetails $ \cid c ->
when (at exTime) (orZero cid (c strikePrice))
-- | American exercise: option may be exercised at any time before the
-- expiry date.
americanExercise :: (DateTime, DateTime) -> StrikePrice -> ExerciseDetails
americanExercise (t1, t2) strikePrice =
ExerciseDetails $ \cid c ->
anytime cid (after t1 %&& before t2) (c strikePrice)
-- | Bermudan exercise: option may be exercised at a set (always discretely
-- spaced) number of times.
bermudanExercise :: [(DateTime, DateTime)] -> StrikePrice -> ExerciseDetails
bermudanExercise exerciseWindows strikePrice =
ExerciseDetails $ \cid c ->
allOf
[ anytime cid (after t1 %&& before t2) (c strikePrice)
| (t1, t2) <- exerciseWindows ]
-- ** Payoff
-- | Asian exercise: option where the payoff is not determined by the underlying
-- price at maturity
-- but by the average underlying price over some pre-set period of time.
asianExercise :: UnderlyingPrice -> Schedule -> ExerciseDetails
asianExercise underlyingPrice sch =
ExerciseDetails $ \cid c ->
foldr sample (final cid c) sch 0
where
sample t remainder sum =
when (at t) $
letin "sum" (sum + underlyingPrice) $ \sum ->
remainder sum
final cid c sum = orZero cid (c strikePrice)
where
strikePrice = sum / fromIntegral (length sch)
-- ** Exercise conditions
-- | Barrier knock-in: options that start their lives worthless and only become
-- active in the event a predetermined knock-in barrier price is breached
-- Barrier options become activated or, on the contrary, null and void only if
-- the underlier reaches a predetermined level (barrier).
barrierKnockIn :: Obs Bool -> ExerciseDetails -> ExerciseDetails
barrierKnockIn condition (ExerciseDetails exerciseDetails) =
ExerciseDetails $ \cid c ->
when condition (exerciseDetails cid c)
-- | Barrier up-and-in: spot price starts below the barrier level and has to
-- move up for the option to become activated
barrierUpAndIn :: Index -> Price -> ExerciseDetails -> ExerciseDetails
barrierUpAndIn index ceiling = barrierKnockIn (index %>= ceiling)
-- | Barrier down-and-in: spot price starts above the barrier level and has to
-- move down for the option to become activated.
barrierDownAndIn :: Index -> Price -> ExerciseDetails -> ExerciseDetails
barrierDownAndIn index floor = barrierKnockIn (index %<= floor)
-- * More advanced option templates
-- | Commodity Spread Option: a strip of options with a spread underlying
-- (e.g. with x legs)
--
-- Exercise is determined by an offset to the earliest delivery date of the
-- underlying for each given option
--
-- Generic so:
--
-- * Options can be daily, monthly or any grain/combination of grains
--
-- * Underlying can have any number of legs (the grain of the leg does
-- not have to be the same)
commoditySpreadOption :: ChoiceId -- ^Choice label
-> [( Market
, Volume
, Price, Currency, CashFlowType
, SegmentedSchedule
, FeeCalc )] -- ^List of underlying legs
-> DiffDateTime -- ^Exercise date offset (relative to leg)
-> DiffDateTime -- ^Payment date offset (relative to exercise)
-> OptionDirection -- ^Option direction (put or call)
-> StrikePrice -- ^Strike price of the option
-> Currency -- ^Currency of the strike price
-> CashFlowType -- ^Cashflow type of the strike price
-> Obs Double -- ^Premium
-> Currency -- ^Currency for the premium
-> Contract
commoditySpreadOption cid legs exerciseDiffTime paymentDiffTime opDir strikePrice currency cftype premium pCur =
allOf
[ legOption groupedLeg $
allOf [ forward fee m pr cur cft vol seg seg
| (m, pr, cur, cft, vol, seg, fee) <- groupedLeg ]
| groupedLeg <- groupedLegs ]
where
groupedLegs =
transpose
[ [ (m, pr, cur, cft, vol, seg, fee) | seg <- sch ]
| (m, pr, cur, cft, vol, sch, fee) <- legs ]
legOption groupedLeg underlying =
option cid exerciseDetails opDir optionPremium $ \strikePrice ->
give (financial strikePrice currency cftype)
`and` underlying
where
exerciseDetails = europeanExercise exerciseTime strikePrice
exerciseTime = adjustDateTime earliestDeliveryTime exerciseDiffTime
where
earliestDeliveryTime =
minimum [ t | (_, _, _, _, _, (t:_), _) <- groupedLeg ]
optionPremium = withPremiumSchedule premium pCur [premiumTime]
premiumTime = adjustDateTime exerciseTime paymentDiffTime