hquantlib 0.0.1.2 → 0.0.2.0

raw patch · 9 files changed

+261/−39 lines, 9 filesdep +parallelPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: parallel

API changes (from Hackage documentation)

Files

• hquantlib.cabal +12/−7
• src/QuantLib/Event.hs +11/−7
• src/QuantLib/Methods/MonteCarlo.hs +76/−0
• src/QuantLib/PricingEngines.hs +5/−2
• src/QuantLib/Stochastic/Process.hs +10/−8
• src/QuantLib/Stochastic/Random.hs +16/−15
• src/QuantLib/Time.hs +8/−0
• src/QuantLib/Time/Date.hs +60/−0
• src/QuantLib/Time/DayCounter.hs +63/−0

@@ -1,5 +1,5 @@ name:           hquantlib-version:        0.0.1.2+version:        0.0.2.0 license:        LGPL license-file:   LICENSE author:         Pavel Ryzhov@@ -19,7 +19,7 @@ source-repository this         type:           hg         location:       https://hquantlib.googlecode.com/hg/-        tag:            0.0.1+        tag:            0.0.2  library         default-language: Haskell2010@@ -33,11 +33,13 @@                 QuantLib.PricingEngines.BlackFormula                 QuantLib.Quotes                 QuantLib.VolatilityModel+                QuantLib.Time                 QuantLib.TimeSeries                 QuantLib.Money                 QuantLib.Prices                 QuantLib.Position                 QuantLib.Options+                QuantLib.Methods.MonteCarlo                  other-modules:                 QuantLib.Currencies.America@@ -48,14 +50,17 @@                 QuantLib.Stochastic.Process                 QuantLib.Stochastic.Random                 QuantLib.Currency+                QuantLib.Time.Date+                QuantLib.Time.DayCounter                  build-depends:  -                        haskell2010 == 1.0.0.0,-                        time    >= 1.2.0.0,-                        containers >= 0.4.0.0,-                        hmatrix >= 0.11.0.0,+                        haskell2010     == 1.0.0.0,+                        time            >= 1.2.0.0,+                        containers      >= 0.4.0.0,+                        hmatrix         >= 0.11.0.0,                         hmatrix-special >= 0.1.1,-                        gsl-random >= 0.4.0+                        gsl-random      >= 0.4.0,+                        parallel        >= 3.1.0.0          hs-source-dirs: src         ghc-options:    -Wall

@@ -2,15 +2,15 @@         (module QuantLib.Event         ) where -import Data.Time.LocalTime import QuantLib.Prices+import QuantLib.Time.Date  class Event a where-        evDate          :: a->LocalTime-        evOccured       :: a->LocalTime->Bool+        evDate          :: a->Date+        evOccured       :: a->Date->Bool         evOccured event date = (evDate event) < date -        evOccuredInclude:: a->LocalTime->Bool+        evOccuredInclude:: a->Date->Bool         evOccuredInclude event date = (evDate event) <= date          evCompare :: a->a->Ordering@@ -22,8 +22,9 @@         evEqual :: a->a->Bool         evEqual x y = (evDate x) == (evDate y) +-- | Cash flows data type data CashFlow = CashFlow {-        cfDate          :: LocalTime,+        cfDate          :: Date,         cfAmount        :: Double         } deriving (Show) @@ -36,12 +37,15 @@ instance Ord CashFlow where         compare = evCompare +-- | Sequence of cash-flows+type Leg        = [CashFlow]+ data Callability = Call {          cPrice  :: CallPrice,-        cDate   :: LocalTime+        cDate   :: Date         } | Put {         cPrice  :: CallPrice,-        cDate   :: LocalTime+        cDate   :: Date         } deriving (Show)  instance Event Callability where

@@ -0,0 +1,76 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, BangPatterns #-}+module QuantLib.Methods.MonteCarlo+        ( module QuantLib.Methods.MonteCarlo+        ) where++import Control.Monad()+import Control.Parallel.Strategies+import QuantLib.Stochastic.Process+import QuantLib.Stochastic.Random++-- | Summary type class aggregates all priced values of paths+class PathPricer p => Summary m p | m->p where+        -- | Updates summary with given priced pathes+        sSummarize      :: m->[p]->m+        -- | Defines a metric, i.e. calculate distance between 2 summaries+        sNorm           :: m->m->Double++-- | Path generator is a stochastic path generator+class PathGenerator m where+        pgMkNew         :: m->IO m+        pgGenerate      :: m->IO Path++-- | Path pricer provides a price for given path+class PathPricer m where+        ppPrice         :: m->Path->m+++-- | Monte Carlo engine function+monteCarlo :: (Summary s p, PathPricer p, PathGenerator g) => PathMonteCarlo s p g->Int->IO s+monteCarlo (PathMonteCarlo s p g) size = do+        priced <- mapM (\_ -> pricing) [1..size]+        return $ sSummarize s priced+        where   pricing = do+                        rnd <- pgMkNew g+                        !path <- pgGenerate rnd+                        return $! ppPrice p path++-- | Monte Carlo engine function. Parallelized version+monteCarloParallel :: (Summary s p, PathPricer p, PathGenerator g) => PathMonteCarlo s p g->Int->IO s+monteCarloParallel (PathMonteCarlo s p g) size = do+        priced <- mapM (\_ -> pricing) [1..size] `using` rpar+        return $ sSummarize s priced+        where   pricing = do+                        !path <- pgGenerate g+                        return $! ppPrice p path++-- | Path-dependant Monte Carlo engine+data (Summary s p, PathPricer p, PathGenerator g) => PathMonteCarlo s p g+        = PathMonteCarlo {+                pmcSummary      :: s,+                pmcPricer       :: p,+                pmcGenerator    :: g+                }++-- | This pricer gets the last point of path+data LastPointPricer = LastPointPricer Dot++instance PathPricer LastPointPricer where+        ppPrice _ path = LastPointPricer (last path) ++-- | Stochastic process generator+data (StochasticProcess sp, NormalGenerator b, Discretize d) => ProcessGenerator sp b d +        = ProcessGenerator {+                pgStart         :: Dot,+                pgLength        :: Int,+                pgProcess       :: sp,+                pgGenerator     :: b,+                pgDiscretize    :: d+        }++instance (StochasticProcess sp, NormalGenerator b, Discretize d) => PathGenerator (ProcessGenerator sp b d) where+        pgMkNew (ProcessGenerator start len process rnd d)       = do+                newRnd <- ngMkNew rnd+                return $! ProcessGenerator start len process newRnd d+        pgGenerate (ProcessGenerator start len sp b d) = generatePath b d sp len start+

@@ -1,6 +1,9 @@+{-# LANGUAGE MultiParamTypeClasses #-} module QuantLib.PricingEngines         ( module QuantLib.PricingEngines         ) where -class PricingEngine a where-        peCalculate :: a->a+import QuantLib.Event++class Event e => PricingEngine a e where+        peCalculate :: e->a->e

@@ -1,9 +1,10 @@-+{-# LANGUAGE BangPatterns #-} module QuantLib.Stochastic.Process         ( module QuantLib.Stochastic.Process )         where  import Control.Monad (foldM)+import Data.List (foldl') import QuantLib.Stochastic.Random (NormalGenerator (..))  -- | Discretization of stochastic process over given interval@@ -31,13 +32,14 @@ -- | Generates sample path for given stochastic process under discretization and normal generator for given amount of steps, starting from x0 generatePath :: (StochasticProcess a, NormalGenerator b, Discretize c) => b->c->a->Int->Dot->IO Path generatePath rnd discr sp steps x0 = do-        let s    = replicate steps (1 :: Int)-        (path, _) <- foldM intGenPath ([x0], rnd) s-        return path-        where   intGenPath (p, r) _ = do-                        (dw, newRnd) <- ngGetNext r-                        let newDot = evolve discr sp (last p) dw-                        return (p ++ [newDot], newRnd)+        (!list, _) <- foldM generator ([], rnd) [1..steps]+        let path = foldl' evolver [x0] list+        return $! reverse path+        where   evolver p dw = (evolve discr sp (head p) dw) : p+                generator (list, r) _ = do+                        (p, newRnd) <- ngGetNext r+                        return (p:list, newRnd)+  -- | Geometric Brownian motion data GeometricBrownian = GeometricBrownian { 

@@ -1,12 +1,13 @@+{-# LANGUAGE BangPatterns #-} module QuantLib.Stochastic.Random         ( BoxMuller         , createNormalGen+        , mkNormalGen         , NormalGenerator (..)         , module GSL.Random.Gen         ) where  import GSL.Random.Gen-import Control.Monad  -- | Box-Muller method data BoxMuller = BoxMuller {@@ -15,6 +16,11 @@         bmRng           :: RNG         } +mkNormalGen ::  IO BoxMuller+mkNormalGen = do+        rng <- newRNG mt19937+        return $! createNormalGen rng+ -- | Creates normally distributed generator createNormalGen :: RNG->BoxMuller createNormalGen r = BoxMuller {@@ -23,37 +29,32 @@         bmRng           = r         } --- | Generates a list of normally distributed number using generator-getRndList :: NormalGenerator a => a->Int->IO ([Double], a)-getRndList rnd n = do-        let ns = replicate n (1 :: Int)-        foldM foldFunc ([], rnd) ns-        where   foldFunc (xs, r) _ = do-                    (x, newRnd) <- ngGetNext r-                    return (xs++[x], newRnd)- -- | Normally distributed generator class NormalGenerator a where         ngGetNext :: a -> IO (Double, a)+        ngMkNew   :: a -> IO a  instance NormalGenerator BoxMuller where+        ngMkNew _       = mkNormalGen         ngGetNext (BoxMuller True _ rng) = do                 (r, s1, s2) <- getRs-                let ratio = sqrt (-2.0*(log r)/r)+                let !ratio = sqrt (-2.0*(log r)/r)                 let bm = BoxMuller {                         bmFirst         = False,                         bmSecondValue   = s2*ratio,                         bmRng           = rng                         }-                return (s1*ratio, bm)+                return $! (s1*ratio, bm)                 where   getRs = do                                 x1 <- getUniformPos rng                                 x2 <- getUniformPos rng-                                let r = x1*x1 + x2*x2+                                let s1 = 2.0*x1-1.0+                                let s2 = 2.0*x2-1.0+                                let r = s1*s1 + s2*s2                                 if (r>=1.0 || r<=0.0) then                                         getRs                                 else-                                        return (r, x1, x2)+                                        return $! (r, s1, s2)                                  ngGetNext (BoxMuller False s r) = do-                return (s, BoxMuller True s r)+                return $! (s, BoxMuller True s r)

@@ -0,0 +1,8 @@+module QuantLib.Time+        ( module QuantLib.Time.Date+        , module QuantLib.Time.DayCounter+        ) where++import QuantLib.Time.Date+import QuantLib.Time.DayCounter+

@@ -0,0 +1,60 @@+module QuantLib.Time.Date+        ( module QuantLib.Time.Date+        ) where++import Data.Time+import Data.Time.Calendar.WeekDate++{- | Business Day conventions+ - These conventions specify the algorithm used to adjust a date in case it is not a valid business day.+ -}+data BusinessDayConvention = Following +        | ModifiedFollowing +        | Preceding+        | ModifiedPreceding+        | Unadjusted+        deriving (Show, Eq, Enum)++-- | Week days+data WeekDay = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday+        deriving (Show, Eq, Enum)++-- | Date+type Date = Day++-- | Defines a holidays for given calendar. Corresponds to calendar class in QuantLib+class Holiday m where+        isHoliday :: m->(Integer, Int, Int)->Bool+        +        isBusinessDay :: m->Date->Bool+        isBusinessDay m d = not (isHoliday m $ toGregorian d)++        hBusinessDayBetween :: m->(Date, Date)->Int+        hBusinessDayBetween m (fd, td) = foldl countDays 0 listOfDates+                where   countDays counter x     = counter + (fromEnum $ isBusinessDay m x)+                        listOfDates             = getDaysBetween (fd, td)++-- | Gets a week day +getWeekDay :: Date->WeekDay+getWeekDay d   = toEnum (weekDay - 1)+        where   (_, _, weekDay) = toWeekDate d++-- | Generate a list of all dates inbetween+getDaysBetween ::  (Day, Day) -> [Day]+getDaysBetween (fd, td) = reverse $ generator fd []+        where   generator date x+                        | date < td     = generator nextDate (nextDate : x)+                        | otherwise     = x+                        where   nextDate        = addDays 1 date++-- | Checks if the day is a weekend, i.e. Saturday or Sunday+isWeekEnd :: Date->Bool+isWeekEnd d     = (weekday == Saturday) || (weekday == Sunday)+        where   weekday = getWeekDay d++-- | Gets the next working day+getNextBusinessDay :: Holiday a => a->Date->Date+getNextBusinessDay m d+        | isBusinessDay m nextDay       = nextDay+        | otherwise                     = getNextBusinessDay m nextDay+        where   nextDay = addDays 1 d

@@ -0,0 +1,63 @@+module QuantLib.Time.DayCounter+        ( module QuantLib.Time.DayCounter+        ) where++import QuantLib.Time.Date+import Data.Time.Calendar++-- | Day counter type class+class DayCounter m where+        -- | Name of day counter+        dcName          :: m->String+        -- | Number of business days inbetween+        dcCount         :: m->Date->Date->Int+        -- | Year fraction+        dcYearFraction  :: m->Date->Date->Double++{-+data SimpleDayCounter = SimpleDayCounter++instance DayCounter SimpleDayCounter where+        dcName _        = "Simple"+        dcCount         = undefined+        dcYearFraction  = undefined+-}++-- | Thirty day counters as in QuantLib+data Thirty360 = ThirtyUSA | ThirtyEuropean | ThirtyItalian++instance DayCounter Thirty360 where+        dcName ThirtyUSA        = "Thirty USA"+        dcName ThirtyEuropean   = "Thirty Euro"+        dcName ThirtyItalian    = "Thirty Italian"++        dcYearFraction  dc fromDate toDate = (fromIntegral $ dcCount dc fromDate toDate)/360.0++        dcCount ThirtyUSA fd td = 360*(yy2-yy1) + 30*(mm2-mm1-1) + (max 0 (30-dd1)) + (min 30 dd2)+                where   (y1, mm1, dd1) = toGregorian fd+                        (y2, m2, d2)   = toGregorian td+                        yy1            = fromIntegral y1+                        yy2            = fromIntegral y2+                        (dd2, mm2)     = adjust dd1 d2 m2+                        adjust x1 x2 z2+                                | x2 == 31 && x1 < 30   = (1, z2+1)+                                | otherwise             = (x2, z2)+++        dcCount ThirtyEuropean fd td = 360*(yy2-yy1) + 30*(m2-m1-1) + (max 0 (30-d1)) + (min 30 d2)+                where   (y1, m1, d1)    = toGregorian fd+                        (y2, m2, d2)    = toGregorian td+                        yy1             = fromIntegral y1+                        yy2             = fromIntegral y2++        dcCount ThirtyItalian fd td = 360*(yy2-yy1) + 30*(mm2-mm1-1) + (max 0 (30-dd1)) + (min 30 dd2)+                where   (y1, mm1, d1)   = toGregorian fd+                        (y2, mm2, d2)   = toGregorian td+                        yy1             = fromIntegral y1+                        yy2             = fromIntegral y2+                        dd1             = adjust d1 mm1+                        dd2             = adjust d2 mm2+                        adjust x1 z1+                                | z1 == 2 && x1 > 27    = 30+                                | otherwise             = x1+