Monte Carlo methods are implemented and partially tested.

Consume too much of memory now.

build.sh

@@ -0,0 +1,5 @@
+#/usr/bash
+
+cabal clean
+cabal configure
+cabal build

hquantlib.cabal

@@ -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 head
 source-repository this
         type:           hg
         location:       https://hquantlib.googlecode.com/hg/
-        tag:            0.0.1
+        tag:            0.0.2
 
 library
         default-language: Haskell2010
@@ -39,6 +39,7 @@ library
                 QuantLib.Prices
                 QuantLib.Position
                 QuantLib.Options
+                QuantLib.Methods.MonteCarlo
 
         other-modules:
                 QuantLib.Currencies.America

src/QuantLib/Methods/MonteCarlo.hs

@@ -7,42 +7,44 @@ import Control.Monad
 import QuantLib.Stochastic.Process
 import QuantLib.Stochastic.Random
 
-class Summary m where
-        sSummarize      :: PathPricer p => m->[p]->m
+-- | 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
         pgGenerate      :: m->IO Path
 
+-- | Path pricer provides a price for given path
 class PathPricer m where
         ppPrice         :: m->Path->m
 
-class (Summary m, PathGenerator m, PathPricer m) => MonteCarlo m where
-        mcCalculate     :: m->Int->IO m
 
-        mcCalculate mc size     = do 
-                liftM (sSummarize mc) priced
-                where   paths   = map (\_ -> pgGenerate mc) [1..size]
-                        priced  = mapM (liftM (ppPrice mc)) paths
-
-monteCarlo :: (Summary s, PathPricer p, PathGenerator g) => PathMonteCarlo s p g->Int->IO s
+-- | 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
         liftM (sSummarize s) priced
         where   paths   = map (\_ -> pgGenerate g) [1..size]
                 priced  = mapM (liftM (ppPrice p)) paths
 
-data (Summary s, PathPricer p, PathGenerator g) => PathMonteCarlo s p g
+-- | Path-dependant Monte Carlo engine
+data (Summary s p, PathPricer p, PathGenerator g) => PathMonteCarlo s p g
         = PathMonteCarlo {
                 pmcSummary      :: s,
                 pmcPricer       :: p,
                 pmcGenerator    :: g
                 }
 
-data LastPointPricer = LastPointPricer
+-- | This pricer gets the last point of path
+data LastPointPricer = LastPointPricer Dot
 
 instance PathPricer LastPointPricer where
-        pgGenerate _ path = 
+        ppPrice _ path = LastPointPricer (last path) 
 
+-- | Stochastic process generator
 data (StochasticProcess sp, NormalGenerator b, Discretize d) => ProcessGenerator sp b d 
         = ProcessGenerator {
                 pgStart         :: Dot,

src/QuantLib/Stochastic/Random.hs

@@ -49,11 +49,13 @@ instance NormalGenerator BoxMuller where
                 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)

src/Tests/McTest.hs

@@ -0,0 +1,57 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+module Main where
+
+import Control.Monad
+import qualified Data.Map as M
+import QuantLib.Methods.MonteCarlo
+import QuantLib.Stochastic
+import GSL.Random.Gen
+import Data.List
+
+data MaxMinClosePricer = MMCP {
+        mmcpHigh        :: Double,
+        mmcpLow         :: Double,
+        mmcpClose       :: Double
+        } deriving (Show)
+
+instance PathPricer MaxMinClosePricer where
+        ppPrice _ path = MMCP high low close
+                where   close   = last xs
+                        high    = maximum xs
+                        low     = minimum xs
+                        xs      = map getX path
+
+data HistoSummary = HS (M.Map Double Int)
+        deriving (Show)
+
+addOnePath :: HistoSummary->MaxMinClosePricer->HistoSummary
+addOnePath (HS m) (MMCP _ _ close) = HS newM
+        where   (_, newM) = M.insertLookupWithKey inserter roundedClose 1 m
+                roundedClose =  ((fromIntegral . round) (close*10000))/10000
+                inserter _ new_value old_value = old_value+new_value
+
+instance Summary HistoSummary MaxMinClosePricer where
+        sNorm _ _ = 0.0 -- we don't care about convergence now
+        sSummarize m paths = foldl' addOnePath m paths  
+
+printMap :: HistoSummary->IO ()
+printMap (HS m) = do
+forM_ list printPlain
+where
+        printPlain (a, b) = do 
+                putStrLn $ (show a)++","++(show b)
+        list    = M.toList m
+
+main :: IO ()
+main = do
+        let summary = HS M.empty
+        let mmcp    = MMCP 0.0 0.0 0.0
+        let start   = Dot 0.0 1.0
+        let sp      = GeometricBrownian 0.0 1.0
+        let discrete= Euler 0.01
+        rng <- newRNG mt19937
+        let generator=createNormalGen rng 
+        let pg      = ProcessGenerator start 100 sp generator discrete
+        let pmc     = PathMonteCarlo summary mmcp pg
+        s <- monteCarlo pmc 10000
+        printMap s