aivika-lattice 0.5 → 0.6

raw patch · 7 files changed

+115/−9 lines, 7 filesdep ~aivikadep ~aivika-transformersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aivika, aivika-transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• Simulation/Aivika/Lattice/Estimate.hs +1/−1
• Simulation/Aivika/Lattice/Internal/LIO.hs +1/−0
• Simulation/Aivika/Lattice/Internal/Lattice.hs +13/−5
• Simulation/Aivika/Lattice/LIO.hs +1/−0
• aivika-lattice.cabal +4/−3
• examples/BinomialPricingModel.hs +90/−0

@@ -1,4 +1,9 @@ +Version 0.6+-----++* Added the newRandomLatticeWithProb function.+ Version 0.5 ----- 

@@ -151,7 +151,7 @@ estimateAt :: Int               -- ^ the lattice time index               -> Int-              -- ^ the lattice size index+              -- ^ the lattice member index               -> Estimate LIO a               -- ^ the computation               -> Estimate LIO a

@@ -17,6 +17,7 @@         LIOLattice(..),         lattice,         newRandomLattice,+        newRandomLatticeWithProb,         invokeLIO,         runLIO,         lioParams,

@@ -12,7 +12,8 @@ module Simulation.Aivika.Lattice.Internal.Lattice        (LIOLattice(..),         lattice,-        newRandomLattice) where+        newRandomLattice,+        newRandomLatticeWithProb) where  import Control.Monad import Control.Monad.Trans@@ -30,9 +31,11 @@                -- ^ Tha lattice size.              } --- | Create a new random lattice by the specified size.-newRandomLattice :: Int -> IO LIOLattice-newRandomLattice m =+-- | Create a new random lattice by the specified probability and size,+-- where the probabilty defines whether the interior child node derives+-- from the right parent.+newRandomLatticeWithProb :: Double -> Int -> IO LIOLattice+newRandomLatticeWithProb p m =   do g <- MWC.withSystemRandom (return :: MWC.GenIO -> IO MWC.GenIO)      xss0 <- forM [0 .. m] $ \i ->        do xs0 <- forM [0 .. i] $ \k ->@@ -41,7 +44,7 @@             else if k == i                  then return (k - 1)                  else do x <- MWC.uniform g :: IO Double-                         if x <= 0.5+                         if x > p                            then return (k - 1)                            else return k           return $ listArray (0, i) xs0@@ -49,6 +52,11 @@      return LIOLattice { lioParentMemberIndex = \i k -> (xss ! i) ! k,                          lioSize = m                        }++-- | Create a new random lattice by the specified size with equal probabilities,+-- whether the interior child node derives from the left or right parents.+newRandomLattice :: Int -> IO LIOLattice+newRandomLattice = newRandomLatticeWithProb 0.5  -- | Return a lattice by the specifed size and the parent member function. lattice :: Int

@@ -14,6 +14,7 @@         LIOLattice,         lattice,         newRandomLattice,+        newRandomLatticeWithProb,         runLIO,         latticeTimeIndex,         latticeMemberIndex,

@@ -1,5 +1,5 @@ name:            aivika-lattice-version:         0.5+version:         0.6 synopsis:        Nested discrete event simulation module for the Aivika library using lattice description:     This experimental package extends the aivika-transformers [1] library and allows @@ -20,6 +20,7 @@ tested-with:     GHC == 7.10.3  extra-source-files:  CHANGELOG.md+                     examples/BinomialPricingModel.hs                      tests/Distribution.hs                      tests/MachRep1.hs                      tests/TraversingLattice1.hs@@ -55,8 +56,8 @@                      containers >= 0.4.0.0,                      random >= 1.0.0.3,                      mwc-random >= 0.13.0.0,-                     aivika >= 5.2,-                     aivika-transformers >= 5.2+                     aivika >= 5.4,+                     aivika-transformers >= 5.4      extensions:      TypeFamilies,                      MultiParamTypeClasses,

@@ -0,0 +1,90 @@++{-+  A binomial option pricing model++  Assume a put option with strike price $110 currently trading at $100 and+  expiring in one year. Annual risk free rate is at 5%. Price is expected+  to increase 20% and decrease 15% every six months. It is necessary to estimate+  the price of the put option.+ -}++import Control.Monad+import Control.Monad.Trans++import Simulation.Aivika.Trans+import Simulation.Aivika.Lattice+import Simulation.Aivika.Experiment.Histogram++-- the lattice size+n = 50++-- the up and down factors+u0 = 1.2+d0 = 0.85++-- corrected factors for the lattice size+u = exp (log u0 / (fromIntegral n / 2))+d = exp (log d0 / (fromIntegral n / 2))++-- initial stock price+s0 = 100.0++-- strike price for put option+strikePrice = 110.0++-- risk free rate+r = 0.05++specs = Specs { spcStartTime = 0.0,+                spcStopTime = 1.0,+                spcDT = 0.1,+                spcMethod = RungeKutta4,+                spcGeneratorType = SimpleGenerator }+        +model :: Simulation LIO Double+model =+  do -- stock price+     s <- newRef s0++     -- calculate the stock price tree+     runEventInStartTime $+       enqueueEventWithLatticeTimes $+       do k  <- liftComp latticeMemberIndex+          k0 <- liftComp latticeParentMemberIndex+          case k0 of+            Nothing -> return ()+            Just k0 | k == k0 ->+              modifyRef s (\x -> x * u)+            Just k0 | k == k0 + 1 ->+              modifyRef s (\x -> x * d)++     -- the lattice time step+     dt <- liftParameter latticeTimeStep++     -- calculate the up move probability+     let p = (exp (- r * dt) - d) / (u - d)++     -- estimate the option price in the end time+     let leaf :: Estimate LIO Double+         leaf =+           do x <- readObservable s+              -- this is a put option+              return $ max (strikePrice - x) 0++     -- estimate the option price by the forecast+     let reduce :: Double -> Double -> Estimate LIO Double+         reduce x1 x2 =+           return $+           exp (- r * dt) * (p * x1 + (1 - p) * x2)++     price <- foldEstimate reduce leaf++     runEstimateInStartTime price+ +main :: IO ()+main =+  do lat <- newRandomLattice n+     e <- runLIO lat $+          runSimulation model specs+     putStrLn "Estimation:"+     putStrLn (show e)