{- 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)