Commit c6ec1b2e authored by Simon Marlow's avatar Simon Marlow

add blackscholes

parent 2640ba70
TOP = ..
include $(TOP)/mk/boilerplate.mk
SUBDIRS = parfib partree sumeuler matmult ray gray prsa mandel queens coins
SUBDIRS = parfib partree sumeuler matmult ray gray prsa mandel queens coins blackscholes
# CPP SYMBOLS
#
......
module Future (Eval(..), Future, runEval, rseq, fork, join, deep) where
import Control.DeepSeq
import Control.Parallel
import Control.Parallel.Strategies
data Future a = Future a
fork :: Eval a -> Eval (Future a)
fork a = do a' <- rpar (runEval a); return (Future a')
join :: Future a -> Eval a
join (Future a) = a `pseq` return a
deep :: NFData a => Eval a -> Eval a
deep m = do a <- m; rnf a `pseq` return a
TOP = ../..
include $(TOP)/mk/boilerplate.mk
PROG_ARGS = 10000 15000000
SRC_HC_OPTS += -package parallel
include $(TOP)/mk/target.mk
{-# LANGUAGE RecordWildCards,CPP #-}
-- Intel Concurrent Collections for Haskell
-- Copyright (c) 2010, Intel Corporation.
--
-- This program is free software; you can redistribute it and/or modify it
-- under the terms and conditions of the GNU Lesser General Public License,
-- version 2.1, as published by the Free Software Foundation.
--
-- This program is distributed in the hope it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for
-- more details.
--
-- You should have received a copy of the GNU Lesser General Public License along with
-- this program; if not, write to the Free Software Foundation, Inc.,
-- 51 Franklin St - Fifth Floor, Boston, MA 02110-1301 USA.
-- Ported from CnC/C++ program by Ryan Newton
-- Description
-- ===========
-- The Black-Scholes equation is a differential equation that describes how,
-- under a certain set of assumptions, the value of an option changes as the
-- price of the underlying asset changes.
-- The formula for a put option is similar. The cumulative normal distribution
-- function, CND(x), gives the probability that normally distributed random
-- variable will have a value less than x. There is no closed form expression for
-- this function, and as such it must be evaluated numerically. The other
-- parameters are as follows: S underlying asset's current price,
-- X the strike price, T time to the expiration date, r risk-less rate of return,
-- and v stock's volatility.
-- Blackscholes has a single step collection called (compute). It is executed once
-- for each tag in the tag collection <tags>. This tag collection is produced
-- by the environment.
-- (compute) inputs [data] items. Each [data] item contains a pointer to an
-- array of ParameterSet objects. For each ParameterSet object the Black-Scholes equation
-- is solved, and results are stored in the emitted items [price].
-- To reduce the influence of the serial part each calculation is repeated for NUM_RUNS times.
-- There are no constraints on the parallelism in this example. An instance of
-- (compute) does not rely on a data item from another instance and it does not
-- relay on a control tag from another instance. All the tags are produced by
-- the environment before the program begins execution. All steps can be executed
-- in parallel if there are enough processors.
-- Usage
-- =====
-- The command line is:
-- blackscholes b n
-- b : positive integer for the size of blocks
-- n : positive integer for the number of options
-- e.g.
-- blackscholes 100000 100 4
import Control.Monad hiding (join)
--import Data.Array
import Data.Array.Unboxed
import System.Environment
import Control.Parallel.Strategies
import Control.DeepSeq
import Future
-- #define fptype float
-- #define ERR_CHK
num_runs = 100
type FpType = Float
-- -- This scheme is for the original data tuples in the input:
-- data OptionData = OptionData {
-- s :: FpType, -- spot price
-- strike :: FpType, -- strike price
-- r :: FpType , -- risk-free interest rate
-- divq :: FpType , -- dividend rate
-- v :: FpType , -- volatility
-- t :: FpType , -- time to maturity or option expiration in years
-- -- (1yr = 1.0, 6mos = 0.5, 3mos = 0.25, ..., etc)
-- optionType :: String, -- Option type. "P"=PUT, "C"=CALL
-- divs :: FpType, -- dividend vals (not used in this test)
-- dGrefval :: FpType -- DerivaGem Reference Value
-- } deriving Show
-- -- These are the blocked/chunked inputs to our kernel extracted from
-- -- the original tuples:
-- data ParameterSet = ParameterSet {
-- dat :: OptionData,
-- sptprice :: UArray Int FpType,
-- strikep :: UArray Int FpType,
-- rate :: UArray Int FpType,
-- volatility :: UArray Int FpType ,
-- otime :: UArray Int FpType,
-- otype :: UArray Int Bool,
-- granularity :: Int
-- } deriving Show
-- This tuple contains the inputs for one invocation of our kernel
data ParameterSet = ParameterSet {
sptprice :: FpType,
strike :: FpType,
rate :: FpType,
volatility :: FpType ,
otime :: FpType,
otype :: Bool
} deriving Show
--data_init :: Array Int Int
--data_init :: Array Int OptionData
data_init :: Array Int ParameterSet
-- This defines some hard coded data as a big constant array:
#include "blackscholes_data.hs"
size_init = let (s,e) = bounds data_init in e - s + 1
inv_sqrt_2xPI = 0.39894228040143270286
cndf :: FpType -> FpType
cndf inputX = if sign then 1.0 - xLocal else xLocal
where
sign = inputX < 0.0
inputX' = if sign then -inputX else inputX
-- Compute NPrimeX term common to both four & six decimal accuracy calcs
xNPrimeofX = inv_sqrt_2xPI * exp(-0.5 * inputX * inputX);
xK2 = 1.0 / (0.2316419 * inputX + 1.0);
xK2_2 = xK2 * xK2; -- Need all powers of xK2 from ^1 to ^5:
xK2_3 = xK2_2 * xK2;
xK2_4 = xK2_3 * xK2;
xK2_5 = xK2_4 * xK2;
xLocal = 1.0 - xLocal_1 * xNPrimeofX;
xLocal_1 = xK2 * 0.319381530 + xLocal_2;
xLocal_2 = xK2_2 * (-0.356563782) + xLocal_3 + xLocal_3' + xLocal_3'';
xLocal_3 = xK2_3 * 1.781477937;
xLocal_3' = xK2_4 * (-1.821255978);
xLocal_3'' = xK2_5 * 1.330274429;
blkSchlsEqEuroNoDiv :: FpType -> FpType -> FpType -> FpType -> FpType -> Bool -> Float -> FpType
blkSchlsEqEuroNoDiv sptprice strike rate volatility time otype timet =
if not otype
then (sptprice * nofXd1) - (futureValueX * nofXd2)
else let negNofXd1 = 1.0 - nofXd1
negNofXd2 = 1.0 - nofXd2
in (futureValueX * negNofXd2) - (sptprice * negNofXd1)
where
logValues = log( sptprice / strike )
xPowerTerm = 0.5 * volatility * volatility
xDen = volatility * sqrt(time)
xD1 = (((rate + xPowerTerm) * time) + logValues) / xDen
xD2 = xD1 - xDen
nofXd1 = cndf xD1
nofXd2 = cndf xD1
futureValueX = strike * exp ( -(rate) * (time) )
executeStep :: Int -> Int -> UArray Int FpType
executeStep t granularity =
-- stepPutStr$ " Executing "++ show granularity ++ " iterations starting at "++ show t ++ "\n"
-- let ls = map (\ j ->
listArray (0, granularity-1) $
Prelude.map (\i ->
-- let OptionData { .. } = data_init ! (t+i `mod` size_init)
let ParameterSet { .. } = data_init ! ((t+i) `mod` size_init)
in blkSchlsEqEuroNoDiv sptprice strike rate volatility otime otype 0)
[0 .. granularity-1]
-- )
-- [0 .. num_runs-1]
blackscholes :: Int -> Int -> Eval Float
blackscholes numOptions granularity =
do
fs <- forM [0, granularity .. numOptions-1] $ \t ->
fork (return (executeStep t granularity))
foldM (\ acc f ->
do x <- join f
return (acc + (x ! 0)))
0 fs
main = do args <- getArgs
let (numOptions, granularity) =
case args of
-- [] -> (10, 5)
[] -> (10000, 1000)
[b] -> (10, read b)
[b,n] -> (read n, read b)
if granularity > numOptions
then error "Granularity must be bigger than numOptions!!"
else return ()
putStrLn$ "Running blackscholes, numOptions "++ show numOptions ++ " and block size " ++ show granularity
let result = runEval $ blackscholes numOptions granularity
-- putStrLn$ "Final result, here's one price: "++ show ((result !! 0) ! 0)
--putStrLn$ "Final result, here's one price: "++ show (result UB.! 0)
putStrLn$ "Final result: "++ show result
return result
This source diff could not be displayed because it is too large. You can view the blob instead.
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment