monad-par-0.1.0.3/0000755000000000000000000000000011673650535011730 5ustar0000000000000000monad-par-0.1.0.3/LICENSE0000644000000000000000000000275511673650534012745 0ustar0000000000000000Copyright Simon Marlow 2011 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Simon Marlow nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. monad-par-0.1.0.3/Setup.hs0000644000000000000000000000011011673650535013354 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain monad-par-0.1.0.3/monad-par.cabal0000644000000000000000000000622611673650535014600 0ustar0000000000000000Name: monad-par Version: 0.1.0.3 Synopsis: A library for parallel programming based on a monad Description: This library offers an alternative parallel programming API to that provided by the @parallel@ package. The 'Par' monad allows the simple description of parallel computations, and can be used to add parallelism to pure Haskell code. The basic API is straightforward: the monad supports forking and simple communication in terms of 'IVar's. The library comes with an efficient work-stealing implementation, but the internals are also exposed so that you can build your own scheduler if necessary. Examples of use can be found in the examples/ directory of the source package. Homepage: https://github.com/simonmar/monad-par License: BSD3 License-file: LICENSE Author: Simon Marlow Maintainer: Simon Marlow Copyright: (c) Simon Marlow 2011 Stability: Experimental Category: Control,Parallelism,Monads Build-type: Simple Cabal-version: >=1.2 extra-source-files: examples/benchlist.txt examples/benchmark.sh examples/blackscholes_data.hs examples/blackscholes.hs examples/cholesky.hs examples/cholesky_matrix6.dat examples/coins.hs examples/common.mk examples/get_cholesky_data.sh examples/Makefile examples/mandel.hs examples/matmult/ListAux.hs examples/matmult/Makefile examples/matmult/MatMult.hs examples/matmult/matmult.stdout examples/minimax/Board.hs examples/minimax/Game.hs examples/minimax/Main.hs examples/minimax/Makefile examples/minimax/minimax.stdout examples/minimax/Prog.hs examples/minimax/Tree.hs examples/minimax/Wins.hs examples/nbody.hs examples/ntimes examples/ntimes_minmedmax examples/parfib.hs examples/partree/Makefile examples/partree/partree.hs examples/partree/Tree.hs examples/plot_scaling.hs examples/PortablePixmap.lhs examples/primes.hs examples/queens.hs examples/run_tests.sh examples/stream/DEVLOG.txt examples/stream/disjoint_working_sets_pipeline.hs examples/stream/fft_pipeline.hs examples/stream/Makefile examples/stream/simple1_measureSrc.hs examples/sumeuler/ListAux.hs examples/sumeuler/Makefile examples/sumeuler/SumEuler.hs examples/sumeuler/SumEulerPrimes.hs examples/timeout.sh tests/AListTest.hs tests/Test.hs Control/Monad/Par/Stream.hs Library Exposed-modules: Control.Monad.Par , Control.Monad.Par.OpenList , Control.Monad.Par.AList , Control.Monad.Par.IList , Control.Monad.Par.Internal Build-depends: base >= 4 && < 5, deepseq >= 1.1 && < 1.4, HUnit >= 1.2 ghc-options: -O2 Other-modules: monad-par-0.1.0.3/Control/0000755000000000000000000000000011673650534013347 5ustar0000000000000000monad-par-0.1.0.3/Control/Monad/0000755000000000000000000000000011673650534014405 5ustar0000000000000000monad-par-0.1.0.3/Control/Monad/Par.hs0000644000000000000000000002470211673650534015470 0ustar0000000000000000{-# LANGUAGE RankNTypes, NamedFieldPuns, BangPatterns, ExistentialQuantification #-} {-# OPTIONS_GHC -Wall -fno-warn-name-shadowing -fwarn-unused-imports #-} -- | This module provides a monad @Par@, for speeding up pure -- computations using parallel processors. It cannot be used for -- speeding up computations that use IO (for that, see -- @Control.Concurrent@). The result of a given @Par@ computation is -- always the same - ie. it is deterministic, but the computation may -- be performed more quickly if there are processors available to -- share the work. -- -- For example, the following program fragment computes the values of -- @(f x)@ and @(g x)@ in parallel, and returns a pair of their results: -- -- > runPar $ do -- > fx <- pval (f x) -- start evaluating (f x) -- > gx <- pval (g x) -- start evaluating (g x) -- > a <- get fx -- wait for fx -- > b <- get gx -- wait for gx -- > return (a,b) -- return results -- -- @Par@ can be used for specifying pure parallel computations in -- which the order of the computation is not known beforehand. -- The programmer specifies how information flows from one -- part of the computation to another, but not the order in which -- computations will be evaluated at runtime. Information flow is -- described using "variables" called @IVar@s, which support 'put' and -- 'get' operations. For example, suppose you have a problem that -- can be expressed as a network with four nodes, where @b@ and @c@ -- require the value of @a@, and @d@ requires the value of @b@ and @c@: -- -- > a -- > / \ -- > b c -- > \ / -- > d -- -- Then you could express this in the @Par@ monad like this: -- -- > runPar $ do -- > [a,b,c,d] <- sequence [new,new,new,new] -- > fork $ do x <- get a; put b (x+1) -- > fork $ do x <- get a; put c (x+2) -- > fork $ do x <- get b; y <- get c; put d (x+y) -- > fork $ do put a (3 :: Int) -- > get d -- -- The result of the above computation is always 9. The 'get' operation -- waits until its input is available; multiple 'put's to the same -- @IVar@ are not allowed, and result in a runtime error. Values -- stored in @IVar@s are usually fully evaluated (although there are -- ways provided to pass lazy values if necessary). -- -- In the above example, @b@ and @c@ will be evaluated in parallel. -- In practice the work involved at each node is too small here to see -- the benefits of parallelism though: typically each node should -- involve much more work. The granularity is completely under your -- control - too small and the overhead of the @Par@ monad will -- outweigh any parallelism benefits, whereas if the nodes are too -- large then there might not be enough parallelism to use all the -- available processors. -- -- Unlike @Control.Parallel@, in @Control.Monad.Par@ parallelism is -- not combined with laziness, so sharing and granulairty are -- completely under the control of the programmer. New units of -- parallel work are only created by @fork@, @par@, and a few other -- combinators. -- -- The implementation is based on a work-stealing scheduler that -- divides the work as evenly as possible betwen the available -- processors at runtime. -- module Control.Monad.Par ( -- * The @Par@ monad Par, runPar, fork, -- * Communication: @IVar@s IVar, new, newFull, newFull_, get, put, put_, -- * Operations pval, spawn, spawn_, parMap, parMapM, parMapReduceRangeThresh, parMapReduceRange, InclusiveRange(..), parFor, ) where import Control.Monad.Par.Internal import Control.DeepSeq import Data.Traversable import Control.Monad as M hiding (mapM, sequence, join) import Prelude hiding (mapM, sequence, head,tail) import GHC.Conc (numCapabilities) -- ----------------------------------------------------------------------------- -- | forks a computation to happen in parallel. The forked -- computation may exchange values with other computations using -- @IVar@s. fork :: Par () -> Par () fork p = Par $ \c -> Fork (runCont p (\_ -> Done)) (c ()) -- > both a b >> c == both (a >> c) (b >> c) -- is this useful for anything? -- both :: Par a -> Par a -> Par a -- both a b = Par $ \c -> Fork (runCont a c) (runCont b c) -- ----------------------------------------------------------------------------- -- Derived functions -- | Like 'spawn', but the result is only head-strict, not fully-strict. spawn_ :: Par a -> Par (IVar a) spawn_ p = do r <- new fork (p >>= put_ r) return r -- | Like 'fork', but returns a @IVar@ that can be used to query the -- result of the forked computataion. -- -- > spawn p = do -- > r <- new -- > fork (p >>= put r) -- > return r -- spawn :: NFData a => Par a -> Par (IVar a) spawn p = do r <- new fork (p >>= put r) return r -- | equivalent to @spawn . return@ pval :: NFData a => a -> Par (IVar a) pval a = spawn (return a) -- ----------------------------------------------------------------------------- -- Parallel maps over Traversable data structures -- | Applies the given function to each element of a data structure -- in parallel (fully evaluating the results), and returns a new data -- structure containing the results. -- -- > parMap f xs = mapM (pval . f) xs >>= mapM get -- -- @parMap@ is commonly used for lists, where it has this specialised type: -- -- > parMap :: NFData b => (a -> b) -> [a] -> Par [b] -- parMap :: (Traversable t, NFData b) => (a -> b) -> t a -> Par (t b) parMap f xs = mapM (pval . f) xs >>= mapM get -- | Like 'parMap', but the function is a @Par@ monad operation. -- -- > parMapM f xs = mapM (spawn . f) xs >>= mapM get -- parMapM :: (Traversable t, NFData b) => (a -> Par b) -> t a -> Par (t b) parMapM f xs = mapM (spawn . f) xs >>= mapM get {-# SPECIALISE parMap :: (NFData b) => (a -> b) -> [a] -> Par [b] #-} {-# SPECIALISE parMapM :: (NFData b) => (a -> Par b) -> [a] -> Par [b] #-} -- TODO: Perhaps should introduce a class for the "splittable range" concept. data InclusiveRange = InclusiveRange Int Int -- | Computes a binary map\/reduce over a finite range. The range is -- recursively split into two, the result for each half is computed in -- parallel, and then the two results are combined. When the range -- reaches the threshold size, the remaining elements of the range are -- computed sequentially. -- -- For example, the following is a parallel implementation of -- -- > foldl (+) 0 (map (^2) [1..10^6]) -- -- > parMapReduceRangeThresh 100 (InclusiveRange 1 (10^6)) -- > (\x -> return (x^2)) -- > (\x y -> return (x+y)) -- > 0 -- parMapReduceRangeThresh :: NFData a => Int -- ^ threshold -> InclusiveRange -- ^ range over which to calculate -> (Int -> Par a) -- ^ compute one result -> (a -> a -> Par a) -- ^ combine two results (associative) -> a -- ^ initial result -> Par a parMapReduceRangeThresh threshold (InclusiveRange min max) fn binop init = loop min max where loop min max | max - min <= threshold = let mapred a b = do x <- fn b; result <- a `binop` x return result in foldM mapred init [min..max] | otherwise = do let mid = min + ((max - min) `quot` 2) rght <- spawn $ loop (mid+1) max l <- loop min mid r <- get rght l `binop` r -- How many tasks per process should we aim for. Higher numbers -- improve load balance but put more pressure on the scheduler. auto_partition_factor :: Int auto_partition_factor = 4 -- | \"Auto-partitioning\" version of 'parMapReduceRangeThresh' that chooses the threshold based on -- the size of the range and the number of processors.. parMapReduceRange :: NFData a => InclusiveRange -> (Int -> Par a) -> (a -> a -> Par a) -> a -> Par a parMapReduceRange (InclusiveRange start end) fn binop init = loop (length segs) segs where segs = splitInclusiveRange (auto_partition_factor * numCapabilities) (start,end) loop 1 [(st,en)] = let mapred a b = do x <- fn b; result <- a `binop` x return result in foldM mapred init [st..en] loop n segs = let half = n `quot` 2 (left,right) = splitAt half segs in do l <- spawn$ loop half left r <- loop (n-half) right l' <- get l l' `binop` r -- TODO: A version that works for any splittable input domain. In this case -- the "threshold" is a predicate on inputs. -- parMapReduceRangeGeneric :: (inp -> Bool) -> (inp -> Maybe (inp,inp)) -> inp -> -- Experimental: -- | Parallel for-loop over an inclusive range. Semantically equivalent -- to -- -- > parFor (InclusiveRange n m) f = forM_ [n..m] f -- -- except that the implementation will split the work into an -- unspecified number of subtasks in an attempt to gain parallelism. -- The exact number of subtasks is chosen at runtime, and is probably -- a small multiple of the available number of processors. -- -- Strictly speaking the semantics of 'parFor' depends on the -- number of processors, and its behaviour is therefore not -- deterministic. However, a good rule of thumb is to not have any -- interdependencies between the elements; if this rule is followed -- then @parFor@ has deterministic semantics. One easy way to follow -- this rule is to only use 'put' or 'put_' in @f@, never 'get'. parFor :: InclusiveRange -> (Int -> Par ()) -> Par () parFor (InclusiveRange start end) body = do let run (x,y) = for_ x (y+1) body range_segments = splitInclusiveRange (4*numCapabilities) (start,end) vars <- M.forM range_segments (\ pr -> spawn_ (run pr)) M.mapM_ get vars return () splitInclusiveRange :: Int -> (Int, Int) -> [(Int, Int)] splitInclusiveRange pieces (start,end) = map largepiece [0..remain-1] ++ map smallpiece [remain..pieces-1] where len = end - start + 1 -- inclusive [start,end] (portion, remain) = len `quotRem` pieces largepiece i = let offset = start + (i * (portion + 1)) in (offset, offset + portion) smallpiece i = let offset = start + (i * portion) + remain in (offset, offset + portion - 1) -- My own forM for numeric ranges (not requiring deforestation optimizations). -- Inclusive start, exclusive end. {-# INLINE for_ #-} for_ :: Monad m => Int -> Int -> (Int -> m ()) -> m () for_ start end _fn | start > end = error "for_: start is greater than end" for_ start end fn = loop start where loop !i | i == end = return () | otherwise = do fn i; loop (i+1) monad-par-0.1.0.3/Control/Monad/Par/0000755000000000000000000000000011673650535015130 5ustar0000000000000000monad-par-0.1.0.3/Control/Monad/Par/OpenList.hs0000644000000000000000000003302311673650534017221 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, CPP, BangPatterns #-} {-# OPTIONS_GHC -fwarn-unused-imports #-} -- -Wall -fno-warn-name-shadowing -- | Some experimental support for 'OpenList's, which are streams in -- the 'Par' monad that support constant-time append. module Control.Monad.Par.OpenList --module Main ( OpenList(), empty, singleton, cons, head, tail, length, close, join, toList, fromList, toLazyList, parMapM, parBuild, parBuildM, openlist_tests, chaintest, async_test, lazy_chaintest -- , main , IList(..), newCell ) where import Control.Monad hiding (join) import Control.DeepSeq import Control.Concurrent.MVar import Control.Monad.Par hiding (parMapM) import Control.Monad.Par.IList import Control.Monad.Par.Internal import Prelude hiding (length,head,tail,drop,take,null) import qualified Prelude as P -- import System.IO.Unsafe import GHC.IO (unsafePerformIO, unsafeDupablePerformIO) import Test.HUnit import Debug.Trace -- ----------------------------------------------------------------------------- -- Open Lists -- IVars at the tail. -- -- These have some of the advantages of imperative lists, such as -- constant time appending, while retaining determinism and having -- O(1) access to the head of the list unlike tree-shaped lists -- (e.g. append-based rather than cons-based). -- An OpenList must be handled functionally. Extending the list as -- an effect will not change its tail pointer. data OpenList a = OpenList (IList a) (IList a) -- This is likewise a pretty meaningless NFData instance: instance NFData a => NFData (OpenList a) where rnf (OpenList hp tp) = rnf hp `seq` rnf tp -- | An empty open list. Supports further extension. empty :: OpenList a empty = OpenList Null Null null :: OpenList a -> Bool null (OpenList Null Null) = True null _ = False -- | A single element open list. singleton :: a -> Par (OpenList a) singleton x = do pv <- new let cell = Cons x pv return (OpenList cell cell) -- TODO/FIXME: Need to decide whether there should be closed and open empty lists!! -- | Terminate a non-empty open list so that it cannot be extended further. close :: NFData a => OpenList a -> Par (OpenList a) close orig@(OpenList Null _) = return orig close orig@(OpenList _ tp) = do put (tl tp) Null; return orig -- This version ignores the tail pointer and seeks out the end of the -- list (at the present time). -- unsafeClose :: NFData a => OpenList a -> Par (OpenList a) -- unsafeClose orig@(OpenList Null _) = return orig -- | Destructive append operation. join :: NFData a => OpenList a -> OpenList a -> Par (OpenList a) join (OpenList Null _) right = return right join left (OpenList Null _) = return left join (OpenList hp1 tp1) (OpenList hp2 tp2) = do put (tl tp1) hp2 return (OpenList hp1 tp2) -- | Head of an OpenList. head :: OpenList a -> a head (OpenList Null _) = error "cannot take head of null OpenList" head (OpenList hp _) = hd hp headCell (OpenList hp _) = OpenList hp hp lastCell (OpenList _ tp) = OpenList tp tp -- | Tail of an OpenList. Beware, if the list contains only one -- element (e.g. the result of tail will be null), it must be CLOSED -- for tail to work. tail :: OpenList a -> Par (OpenList a) -- NOTE: We could fix this limitation by adding a length field to the OpenList. tail (OpenList Null _) = error "cannot take tail of null OpenList" tail (OpenList hp tp) = do nxt <- get (tl hp) case nxt of Null -> return empty _ -> return (OpenList nxt tp) drop :: NFData a => Int -> OpenList a -> Par (OpenList a) drop 0 ls = return ls drop n ls = do tl <- tail ls drop (n-1) tl -- This copies a prefix and makes it open once again irrespective of -- whether the input list is open or closed. take :: NFData a => Int -> OpenList a -> Par (OpenList a) take 0 ls = return empty take n ls = do tl <- tail ls rest <- take (n-1) tl cons (head ls) rest -- Take the length of a closed OpenList. -- length :: OpenList a -> Par Int length (OpenList Null _) = return 0 -- length (OpenList (Cons a _) (Cons b _)) | a == b = return 1 length ls = do t <- tail ls len <- length t return (len+1) -- | Add an element to the front of an OpenList. Works irrespective -- | of whether the input is closed. cons :: NFData a => a -> OpenList a -> Par (OpenList a) -- Careful, consing should not close the openlist: cons car (OpenList Null _) = singleton car cons car (OpenList hp tp) = do cdr <- newFull_ hp return (OpenList (Cons car cdr) tp) newCell x = do pv <-new; return (Cons x pv) -- | Convert a list to an OpenList, open to extension at the tail. fromList :: NFData a => [a] -> Par (OpenList a) fromList [] = return empty fromList (h:t) = -- This function is inefficient and could be replaced with an additional IList data constructor. do head <- newCell h rest <- loop head t return (OpenList head rest) where loop last [] = return last loop last (h:t) = do cell <- newCell h put (tl last) cell loop cell t -- | Convert a CLOSED OpenList to a list. toList :: NFData a => (OpenList a) -> Par [a] -- Note: presently not tail-recursive: toList (OpenList hp _) = loop hp where loop Null = return [] loop (Cons head pv) = do rest <- get pv converted <- loop rest return (head : converted) -- Strict map over closed lists. -- -- parMap for OpenLists does not support a nice divide-and-conquer. -- (Well, it would support the appending if we were willing to scan ahead to find the length.) -- OpenLists are not Traversable... so we can't just use Par.parMap. -- -- TODO: Perhaps this should use a strategy for each element: -- parMapM :: NFData b => (a -> Par b) -> OpenList a -> Par (OpenList b) parMapM _ (OpenList Null _) = return empty -- parMapM fn (OpenList (Cons a _) (Cons b _)) | a == b = fn a >>= singleton parMapM fn ls = do h <- spawn (fn (head ls)) t <- tail ls h' <- get h t2 <- parMapM fn t cons h' t2 -- maybe the following too? -- parMapM_ :: (a -> Par ()) -> OpenList a -> Par () -- | Build an OpenList with a divide-and-conquer parallel strategy. parBuild :: NFData a => InclusiveRange -> (Int -> a) -> Par (OpenList a) parBuild range fn = parMapReduceRange range (singleton . fn) join empty -- | Build an OpenList with a divide-and-conquer parallel strategy, -- allowing nested parallelism in the per-element computation. parBuildM :: NFData a => InclusiveRange -> (Int -> Par a) -> Par (OpenList a) parBuildM range fn = parMapReduceRange range ((>>= singleton) . fn) join empty -- | OpenLists can only be printed properly in the Par monad. @show@ -- on an open list will only give a hint -- what the first and last -- elements of the openlist are. instance Show a => Show (OpenList a) where show (OpenList Null _) = "OpenList []" show (OpenList (Cons fst _) (Cons lst _)) = "OpenList ["++show fst++".."++ show lst ++"]" debugshow (OpenList (Cons h1 _) (Cons h2 _)) = "Cons|Cons|eq/"++show(h1==h2) debugshow (OpenList Null Null) = "Null|Null" debugshow (OpenList Null (Cons _ _)) = error$ "invalid Null|Cons openlist" debugshow (OpenList (Cons _ _) Null) = error$ "invalid Cons|Null openlist" -- Check the length of an openlist from head pointer to tail pointer -- (not including anything present beyond the tail pointer). -- WARNING: ASSUMES UNIQUE ELEMENTS: debuglength :: Eq a => OpenList a -> Par Int debuglength (OpenList Null Null) = return 0 debuglength orig@(OpenList (Cons hp1 tp1) (Cons hp2 tp2)) | hp1 == hp2 = return 1 | otherwise = do rest <- tail orig sum <- debuglength rest return (1 + sum) -- ----------------------------------------------------------------------------- -- Synchronization using native Haskell IVars (e.g. MVars). -- The MList datatype is internal to the module. -- These MVars are only written once: data MList a = MNull | MCons (a, MVar (MList a)) _unsafe_io :: IO a -> Par a _unsafe_io io = let x = unsafePerformIO io in x `seq` return x _unsafe_dupable :: IO a -> Par a _unsafe_dupable io = let x = unsafeDupablePerformIO io in x `seq` return x -- Return a lazy list: mListToList :: MList a -> [a] mListToList MNull = [] mListToList (MCons(hd,tl)) = let rest = unsafeDupablePerformIO$ do tl' <- readMVar tl return (mListToList tl') in (hd : rest) iListToMList :: IList a -> Par (MList a) iListToMList Null = return MNull iListToMList il = do mv <- _unsafe_dupable newEmptyMVar fork $ do t <- get (tl il) r <- iListToMList t _unsafe_io$ putMVar mv r return (MCons (hd il, mv)) -- | Asynchronously convert an OpenList to a lazy list. Returns immediately. toLazyList :: OpenList a -> Par [a] toLazyList (OpenList head _) = iListToMList head >>= return . mListToList -- toLazyList ol = toMList ol >>= return . mListToList -- ----------------------------------------------------------------------------- -- Testing test_ol0 = runPar (cons 'a' empty >>= cons 'b' >>= close >>= tail >>= tail >>= length) test_ol1 :: Int test_ol1 = runPar$ do l :: OpenList Int <- join empty empty length l test_ol2 :: String test_ol2 = show$ runPar$ do ls1 <- fromList [10,11,12] ls2 <- singleton (5::Int) join ls1 ls2 test_ol3 :: [Int] test_ol3 = runPar$ do ol :: OpenList Int <- fromList [1..10] close ol toList ol test_ol4 :: Int test_ol4 = runPar$ do ol <- fromList [1..10] t1 <- tail ol t2 <- tail t1 return (head t2) test_ol5 :: Int test_ol5 = runPar$ fromList ([1..10] :: [Int]) >>= close >>= length test_ol6 :: [Int] test_ol6 = runPar$ do l1 <- fromList [1..10] close l1 l2 <- parMapM (return . (+ 1)) l1 close l2 toList l2 test_ol7 :: [Int] test_ol7 = runPar$ do a <- singleton 1 b <- singleton 2 join a b close b toLazyList a test_ol8 :: [Int] test_ol8 = runPar$ do a <- singleton 1 b <- singleton 2 c <- singleton 3 d <- singleton 4 join c d join a b join b c close d toLazyList a test_ll :: [Int] test_ll = runPar$ do l <- fromList [1..1000] close l toLazyList l chaintest :: Int -> Par (IList Int) chaintest 0 = error "must have chain length >= 1" chaintest len = loop 0 len where loop i 1 = do tl <- if i == len-1 then newFull_ Null else new when (i == len-1) (print_$ " == GOT END: "++show i) return (Cons i tl) loop i n = do let half = n `quot` 2 ifst <- spawn_$ loop i half fork $ do snd <- loop (i+half) half fst <- get ifst lastfst <- dropIList (half-1) fst put (tl lastfst) snd return () get ifst dropIList :: NFData a => Int -> IList a -> Par (IList a) dropIList 0 ls = return ls dropIList n ls = do rest <- get (tl ls) dropIList (n-1) rest -- lazy_chaintest i = chaintest i >>= toLazyList lazy_chaintest :: Int -> Par [Int] lazy_chaintest i = do il <- chaintest i ml <- iListToMList il return (mListToList ml) -- If we create a large, lazy chain, taking just the head should be quick. async_test = do putStrLn "BeginTest" -- let lazy = runParAsync$ lazy_chaintest 1048576 -- let lazy = runParAsync$ lazy_chaintest 32768 let lazy = runParAsync$ lazy_chaintest 1024 -- let lazy = runPar$ lazy_chaintest 1024 putStrLn$ "Resulting list "++ show lazy putStrLn$ "Got head: "++ show (P.take 3 lazy) putStrLn "EndTest" -------------------------------------------------------------------------------- print_ msg = trace msg $ return () dbg0 = debugshow$ runPar$ singleton 'a' >>= close -- This one is an error: err1 = debugshow$ runPar$ singleton 'a' >>= tail >>= close -- But this will work: dbg1 = debugshow$ runPar$ fromList "ab" >>= tail >>= close dbg2 = debugshow$ runPar$ singleton 'a' >>= close >>= tail -- This is invalid: err2 = debugshow$ runPar$ singleton 'a' >>= tail -- TODO: HUnit These. openlist_tests :: Test openlist_tests = TestList [ -- First a few small, unnamed tests: 0 ~=? runPar (length (empty :: OpenList Int)), "a" ~=? runPar (singleton 'a' >>= close >>= toList), 1 ~=? runPar (singleton 'a' >>= close >>= length), 1 ~=? runPar (cons 'b' empty >>= close >>= length), TestLabel "singleton, close" $ "Cons|Cons|eq/True" ~=? dbg0, TestLabel "tail then close - SKETCHY" $ "Cons|Cons|eq/True" ~=? dbg1, TestLabel "close then tail" $ "Null|Null" ~=? dbg2, -- TestLabel "tail no close" $ "" ~=? dbg3, TestLabel "tail of singleton" $ 0 ~=? runPar (singleton 'a' >>= close >>= tail >>= length), TestLabel "tail tail of cons cons" $ 0 ~=? test_ol0, TestLabel "join of two empty's still length zero" $ 0 ~=? test_ol1, TestLabel "test show instance" $ "OpenList [10..5]" ~=? test_ol2, TestLabel "toList" $ [1..10] ~=? test_ol3, TestLabel "head . tail . tail" $ 3 ~=? test_ol4, TestLabel "length . fromList" $ 10 ~=? test_ol5, TestLabel "test parMap" $ [2..11] ~=? test_ol6, TestLabel "test 7" $ [1,2] ~=? test_ol7, TestLabel "test 8" $ [1..4] ~=? test_ol8, TestLabel "test lazy list conversion" $ [1..1000] ~=? test_ll, TestLabel "chaintest" $ [0..511] ~=? runPar (lazy_chaintest 512), TestLabel "asynchronous chaintest" $ [0..511] ~=? runParAsync (lazy_chaintest 512) ] main = async_test monad-par-0.1.0.3/Control/Monad/Par/AList.hs0000644000000000000000000001273511673650534016507 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall -fno-warn-name-shadowing -fwarn-unused-imports #-} -- | This module defines the 'AList' type, a list that supports -- constant-time append, and is therefore ideal for building the -- result of tree-shaped parallel computations. module Control.Monad.Par.AList ( -- * The 'AList' type and operations AList(..), empty, singleton, cons, head, tail, length, null, append, toList, fromList, -- * Operations to build 'AList's in the 'Par' monad parBuildThresh, parBuildThreshM, parBuild, parBuildM, ) where import Control.DeepSeq import Prelude hiding (length,head,tail,null) import qualified Prelude as P import Control.Monad.Par -- | List that support constant-time append (sometimes called -- join-lists). data AList a = ANil | ASing a | Append (AList a) (AList a) | AList [a] instance NFData a => NFData (AList a) where rnf ANil = () rnf (ASing a) = rnf a rnf (Append l r) = rnf l `seq` rnf r rnf (AList l) = rnf l #if 0 data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) instance Traversable Tree traverse f Empty = pure Empty traverse f (Leaf x) = Leaf <$> f x traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r #endif -- TODO: Finish me: -- instance F.Foldable AList where -- foldr fn init al = -- case al of -- ANil -> -- instance Functor AList where -- fmap = undefined -- -- Walk the data structure without introducing any additional data-parallelism. -- instance Traversable AList where -- traverse f al = -- case al of -- ANil -> pure ANil -- ASing x -> ASing <$> f x instance Show a => Show (AList a) where show al = "fromList "++ show (toList al) -- | /O(1)/ Append two 'AList's append :: AList a -> AList a -> AList a append ANil r = r append l ANil = l append l r = Append l r {-# INLINE empty #-} {-# INLINE singleton #-} {-# INLINE fromList #-} -- | /O(1)/ an empty 'AList' empty :: AList a empty = ANil -- | /O(1)/ a singleton 'AList' singleton :: a -> AList a singleton = ASing -- | /O(1)/ convert an ordinary list to an 'AList' fromList :: [a] -> AList a fromList = AList -- | /O(1)/ prepend an element cons :: a -> AList a -> AList a cons x ANil = ASing x cons x al = Append (ASing x) al -- If we tracked length perhaps this could make an effort at balance. -- | /O(n)/ take the head element of an 'AList' -- -- NB. linear-time, because the list might look like this: -- -- > (((... `append` a) `append` b) `append` c) -- head :: AList a -> a head al = case loop al of Just x -> x Nothing -> error "cannot take head of an empty AList" where -- Alas there are an infinite number of representations for null: loop al = case al of Append l r -> case loop l of x@(Just _) -> x Nothing -> loop r ASing x -> Just x AList (h:_) -> Just h AList [] -> Nothing ANil -> Nothing -- | /O(n)/ take the tail element of an 'AList' tail :: AList a -> AList a tail al = case loop al of Just x -> x Nothing -> error "cannot take tail of an empty AList" where loop al = case al of Append l r -> case loop l of (Just x) -> Just (Append x r) Nothing -> loop r ASing _ -> Just ANil AList (_:t) -> Just (AList t) AList [] -> Nothing ANil -> Nothing -- | /O(n)/ find the length of an 'AList' length :: AList a -> Int length ANil = 0 length (ASing _) = 1 length (Append l r) = length l + length r length (AList l) = P.length l -- | /O(n)/ returns 'True' if the 'AList' is empty null :: AList a -> Bool null = (==0) . length -- | /O(n)/ converts an 'AList' to an ordinary list toList :: AList a -> [a] toList a = go a [] where go ANil rest = rest go (ASing a) rest = a : rest go (Append l r) rest = go l $! go r rest go (AList xs) rest = xs ++ rest -- TODO: Provide a strategy for @par@-based maps: appendM :: AList a -> AList a -> Par (AList a) appendM x y = return (append x y) -- | Build a balanced 'AList' in parallel, constructing each element as a -- function of its index. The threshold argument provides control -- over the degree of parallelism. It indicates under what number -- of elements the build process should switch from parallel to -- serial. parBuildThresh :: NFData a => Int -> InclusiveRange -> (Int -> a) -> Par (AList a) parBuildThresh threshold range fn = parMapReduceRangeThresh threshold range (return . singleton . fn) appendM empty -- | Variant of 'parBuildThresh' in which the element-construction function is itself a 'Par' computation. parBuildThreshM :: NFData a => Int -> InclusiveRange -> (Int -> Par a) -> Par (AList a) parBuildThreshM threshold range fn = parMapReduceRangeThresh threshold range ((fmap singleton) . fn) appendM empty -- | \"Auto-partitioning\" version of 'parBuildThresh' that chooses the threshold based on -- the size of the range and the number of processors.. parBuild :: NFData a => InclusiveRange -> (Int -> a) -> Par (AList a) parBuild range fn = parMapReduceRange range (return . singleton . fn) appendM empty -- | like 'parBuild', but the construction function is monadic parBuildM :: NFData a => InclusiveRange -> (Int -> Par a) -> Par (AList a) parBuildM range fn = parMapReduceRange range ((fmap singleton) . fn) appendM empty -- | A parMap over an AList can result in more balanced parallelism than -- the default parMap over Traversable data types. -- parMap :: NFData b => (a -> b) -> AList a -> Par (AList b) monad-par-0.1.0.3/Control/Monad/Par/IList.hs0000644000000000000000000000153211673650534016510 0ustar0000000000000000 -- ILists: lists whose cdr fields are IVars, filled in asynchronously -- via Par computation. -- This module mostly exists as a datatype to use in building other, -- higher-level abstractions. (See OpenList and Stream.) module Control.Monad.Par.IList ( IList(..) ) where import Control.Monad.Par import Control.DeepSeq -- | An 'IList' is the equivalent of a lazy list in the 'Par' monad. -- The tail of the list is an 'IVar', which allows the list to be -- produced and consumed in parallel. data IList a = Null | Cons { hd :: a, tl :: IVar (IList a) } -- | To fully evaluate an 'IList' means to evaluate both the head -- and tail. This does not evaluate the entire spine of the list -- of course, because the tail is an 'IVar'. instance NFData a => NFData (IList a) where -- rnf Null = r0 rnf Null = () rnf (Cons a b) = rnf a `seq` rnf b monad-par-0.1.0.3/Control/Monad/Par/Internal.hs0000644000000000000000000002300711673650534017241 0ustar0000000000000000{-# LANGUAGE RankNTypes, NamedFieldPuns, BangPatterns, ExistentialQuantification, CPP #-} {-# OPTIONS_GHC -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind #-} -- | This module exposes the internals of the @Par@ monad so that you -- can build your own scheduler or other extensions. Do not use this -- module for purposes other than extending the @Par@ monad with new -- functionality. module Control.Monad.Par.Internal ( Trace(..), Sched(..), Par(..), IVar(..), IVarContents(..), sched, runPar, runParAsync, runParAsyncHelper, new, newFull, newFull_, get, put_, put, pollIVar, yield, ) where import Control.Monad as M hiding (mapM, sequence, join) import Prelude hiding (mapM, sequence, head,tail) import Data.IORef import System.IO.Unsafe import Control.Concurrent hiding (yield) import GHC.Conc hiding (yield) import Control.DeepSeq import Control.Applicative -- import Text.Printf -- --------------------------------------------------------------------------- data Trace = forall a . Get (IVar a) (a -> Trace) | forall a . Put (IVar a) a Trace | forall a . New (IVarContents a) (IVar a -> Trace) | Fork Trace Trace | Done | Yield Trace -- | The main scheduler loop. sched :: Bool -> Sched -> Trace -> IO () sched _doSync queue t = loop t where loop t = case t of New a f -> do r <- newIORef a loop (f (IVar r)) Get (IVar v) c -> do e <- readIORef v case e of Full a -> loop (c a) _other -> do r <- atomicModifyIORef v $ \e -> case e of Empty -> (Blocked [c], reschedule queue) Full a -> (Full a, loop (c a)) Blocked cs -> (Blocked (c:cs), reschedule queue) r Put (IVar v) a t -> do cs <- atomicModifyIORef v $ \e -> case e of Empty -> (Full a, []) Full _ -> error "multiple put" Blocked cs -> (Full a, cs) mapM_ (pushWork queue. ($a)) cs loop t Fork child parent -> do pushWork queue child loop parent Done -> if _doSync then reschedule queue -- We could fork an extra thread here to keep numCapabilities workers -- even when the main thread returns to the runPar caller... else do putStrLn " [par] Forking replacement thread..\n" forkIO (reschedule queue); return () -- But even if we don't we are not orphaning any work in this -- threads work-queue because it can be stolen by other threads. -- else return () Yield parent -> do -- Go to the end of the worklist: let Sched { workpool } = queue -- TODO: Perhaps consider Data.Seq here. -- This would also be a chance to steal and work from opposite ends of the queue. atomicModifyIORef workpool $ \ts -> (ts++[parent], ()) reschedule queue -- | Process the next item on the work queue or, failing that, go into -- work-stealing mode. reschedule :: Sched -> IO () reschedule queue@Sched{ workpool } = do e <- atomicModifyIORef workpool $ \ts -> case ts of [] -> ([], Nothing) (t:ts') -> (ts', Just t) case e of Nothing -> steal queue Just t -> sched True queue t -- RRN: Note -- NOT doing random work stealing breaks the traditional -- Cilk time/space bounds if one is running strictly nested (series -- parallel) programs. -- | Attempt to steal work or, failing that, give up and go idle. steal :: Sched -> IO () steal q@Sched{ idle, scheds, no=my_no } = do -- printf "cpu %d stealing\n" my_no go scheds where go [] = do m <- newEmptyMVar r <- atomicModifyIORef idle $ \is -> (m:is, is) if length r == numCapabilities - 1 then do -- printf "cpu %d initiating shutdown\n" my_no mapM_ (\m -> putMVar m True) r else do done <- takeMVar m if done then do -- printf "cpu %d shutting down\n" my_no return () else do -- printf "cpu %d woken up\n" my_no go scheds go (x:xs) | no x == my_no = go xs | otherwise = do r <- atomicModifyIORef (workpool x) $ \ ts -> case ts of [] -> ([], Nothing) (x:xs) -> (xs, Just x) case r of Just t -> do -- printf "cpu %d got work from cpu %d\n" my_no (no x) sched True q t Nothing -> go xs -- | If any worker is idle, wake one up and give it work to do. pushWork :: Sched -> Trace -> IO () pushWork Sched { workpool, idle } t = do atomicModifyIORef workpool $ \ts -> (t:ts, ()) idles <- readIORef idle when (not (null idles)) $ do r <- atomicModifyIORef idle (\is -> case is of [] -> ([], return ()) (i:is) -> (is, putMVar i False)) r -- wake one up data Sched = Sched { no :: {-# UNPACK #-} !Int, workpool :: IORef [Trace], idle :: IORef [MVar Bool], scheds :: [Sched] -- Global list of all per-thread workers. } -- deriving Show newtype Par a = Par { runCont :: (a -> Trace) -> Trace } instance Functor Par where fmap f m = Par $ \c -> runCont m (c . f) instance Monad Par where return a = Par ($ a) m >>= k = Par $ \c -> runCont m $ \a -> runCont (k a) c instance Applicative Par where (<*>) = ap pure = return newtype IVar a = IVar (IORef (IVarContents a)) -- data IVar a = IVar (IORef (IVarContents a)) -- Forcing evaluation of a IVar is fruitless. instance NFData (IVar a) where rnf _ = () -- From outside the Par computation we can peek. But this is nondeterministic. pollIVar :: IVar a -> IO (Maybe a) pollIVar (IVar ref) = do contents <- readIORef ref case contents of Full x -> return (Just x) _ -> return (Nothing) data IVarContents a = Full a | Empty | Blocked [a -> Trace] {-# INLINE runPar_internal #-} runPar_internal :: Bool -> Par a -> a runPar_internal _doSync x = unsafePerformIO $ do workpools <- replicateM numCapabilities $ newIORef [] idle <- newIORef [] let states = [ Sched { no=x, workpool=wp, idle, scheds=states } | (x,wp) <- zip [0..] workpools ] #if __GLASGOW_HASKELL__ >= 701 /* 20110301 */ -- -- We create a thread on each CPU with forkOnIO. The CPU on which -- the current thread is running will host the main thread; the -- other CPUs will host worker threads. -- -- Note: GHC 7.1.20110301 is required for this to work, because that -- is when threadCapability was added. -- (main_cpu, _) <- threadCapability =<< myThreadId #else -- -- Lacking threadCapability, we always pick CPU #0 to run the main -- thread. If the current thread is not running on CPU #0, this -- will require some data to be shipped over the memory bus, and -- hence will be slightly slower than the version above. -- let main_cpu = 0 #endif m <- newEmptyMVar forM_ (zip [0..] states) $ \(cpu,state) -> forkOnIO cpu $ if (cpu /= main_cpu) then reschedule state else do rref <- newIORef Empty sched _doSync state $ runCont (x >>= put_ (IVar rref)) (const Done) readIORef rref >>= putMVar m r <- takeMVar m case r of Full a -> return a _ -> error "no result" runPar :: Par a -> a runPar = runPar_internal True -- | An asynchronous version in which the main thread of control in a -- Par computation can return while forked computations still run in -- the background. runParAsync :: Par a -> a runParAsync = runPar_internal False -- | An alternative version in which the consumer of the result has -- | the option to "help" run the Par computation if results it is -- | interested in are not ready yet. runParAsyncHelper :: Par a -> (a, IO ()) runParAsyncHelper = undefined -- TODO: Finish Me. -- ----------------------------------------------------------------------------- -- | creates a new @IVar@ new :: Par (IVar a) new = Par $ New Empty -- | creates a new @IVar@ that contains a value newFull :: NFData a => a -> Par (IVar a) newFull x = deepseq x (Par $ New (Full x)) -- | creates a new @IVar@ that contains a value (head-strict only) newFull_ :: a -> Par (IVar a) newFull_ !x = Par $ New (Full x) -- | read the value in a @IVar@. The 'get' can only return when the -- value has been written by a prior or parallel @put@ to the same -- @IVar@. get :: IVar a -> Par a get v = Par $ \c -> Get v c -- | like 'put', but only head-strict rather than fully-strict. put_ :: IVar a -> a -> Par () put_ v !a = Par $ \c -> Put v a (c ()) -- | put a value into a @IVar@. Multiple 'put's to the same @IVar@ -- are not allowed, and result in a runtime error. -- -- 'put' fully evaluates its argument, which therefore must be an -- instance of 'NFData'. The idea is that this forces the work to -- happen when we expect it, rather than being passed to the consumer -- of the @IVar@ and performed later, which often results in less -- parallelism than expected. -- -- Sometimes partial strictness is more appropriate: see 'put_'. -- put :: NFData a => IVar a -> a -> Par () put v a = deepseq a (Par $ \c -> Put v a (c ())) -- | Allows other parallel computations to progress. (should not be -- necessary in most cases). yield :: Par () yield = Par $ \c -> Yield (c ()) monad-par-0.1.0.3/Control/Monad/Par/Stream.hs0000644000000000000000000002524111673650535016723 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP #-} {-# OPTIONS_GHC -fno-warn-name-shadowing -fwarn-unused-imports #-} -- -Wall -- A module for stream processing built on top of Control.Monad.Par -- (In the future may want to look into the stream interface used by -- the stream fusion framework.) #define DEBUGSTREAMS module Control.Monad.Par.Stream ( streamMap, streamScan, streamFold , countupWin, generate , runParList, toListSpin , measureRate, measureRateList , browseStream , Stream, Window, WStream -- TEMP: , one_second, commaint ) where import Control.Monad import Control.Monad.Par as P import Control.Monad.Par.IList import Control.DeepSeq --import qualified Data.Array.Unboxed as U import Data.Array.Unboxed as U import Data.Array.CArray as C import Data.Int import Data.Word import Data.List (intersperse) import Data.List.Split (chunk) import Foreign.Storable import System.CPUTime import System.CPUTime.Rdtsc import GHC.Conc as Conc import System.IO import GHC.IO (unsafePerformIO, unsafeDupablePerformIO, unsafeInterleaveIO) import Debug.Trace import Control.Monad.Par.Logging debugflag = True -------------------------------------------------------------------------------- -- Types type Stream a = IVar (IList a) -- A windowed stream passes chunks of stream elements. type WStream a = Stream (Window a) #define CARRAY #ifdef CARRAY type Window a = CArray Int a #else type Window a = U.UArray Int a #endif -------------------------------------------------------------------------------- -- Stream Operators -- | This version applies a function to every element in a stream, -- exposing data parallelism and pipeline parallelism. streamMapDP :: NFData b => (a -> b) -> Stream a -> Par (Stream b) streamMapDP fn instrm = do outstrm <- new fork$ loop instrm outstrm return outstrm where loop instrm outstrm = do ilst <- get instrm case ilst of Null -> put outstrm Null -- End of stream. Cons h t -> do newtl <- new h' <- pval (fn h) -- WARNING: This only makes sense with continuation-stealing.. With child stealing this will go crazy. fork$ loop t newtl h'' <- get h' put outstrm (Cons h'' newtl) -- This version exposes pipeline parallelism but no data parallelism. -- It shouldn't be necessary if fork is sufficiently efficient and if -- work stealing is done right. streamMap :: NFData b => (a -> b) -> Stream a -> Par (Stream b) streamMap fn instrm = do outstrm <- new fork$ loop instrm outstrm return outstrm where loop instrm outstrm = do ilst <- get instrm case ilst of Null -> put outstrm Null -- End of stream. Cons h t -> do newtl <- new put outstrm (Cons (fn h) newtl) loop t newtl -- | Applies a stateful kernel to the stream. Output stream elements match input one-to-one. -- streamScan :: (NFData b, NFData c) => streamScan :: (NFData a, NFData b, NFData c) => -- <- TEMP, don't need NFData a in general. (a -> b -> (a,c)) -> a -> Stream b -> Par (Stream c) streamScan fn initstate instrm = do outstrm <- new fork$ loop initstate instrm outstrm return outstrm where #ifdef DEBUGSTREAMS -- Create a task log for each unique input stream fed to this function: tasklog = unsafeNewTaskSeries (nameFromValue instrm) #endif loop state instrm outstrm = do ilst <- get instrm case ilst of Null -> put outstrm Null -- End of stream. Cons h t -> do newtl <- new let (newstate, outp) = #ifdef DEBUGSTREAMS timePure tasklog$ fn state h #else fn state h #endif put outstrm (Cons outp newtl) loop newstate t newtl -- TODO: streamMapM -- monadic version. Define the non-monadic one in -- terms of it and watch for performance regression. -- TODO: More flexible version that passes an "emit" function to the -- kernel so that it may produce zero output elements or more than one. -- This also enables nested parallelism within the kernel. -- -- streamKernel :: ((c -> Par ()) -> a -> b -> Par ()) -> a -> Stream b -> Par (Stream c) -- -- ALSO: Can have a "concat" operator for streams of lists where -- streamScan . concat rewrites to streamKernel perhaps... -- | Reduce a stream to a single value. This function will not return -- until it reaches the end-of-stream. streamFold :: (a -> b -> a) -> a -> Stream b -> Par a streamFold fn acc instrm = do ilst <- get instrm case ilst of Null -> return acc Cons h t -> streamFold fn (fn acc h) t -- | Generate a stream of the given length by applying the function to each index (starting at zero). -- -- WARNING, this source calls yield, letting other par computations -- run, but there is no backpressure. Thus if the source runs at a -- higher rate than its consumer, buffered stream elements accumulate. generate :: NFData a => Int -> (Int -> a) -> Par (Stream a) -- NOTE: I don't currently know of a good way to do backpressure -- directly in this system... but here are some other options: -- -- (1) we can use timers and look at maximum sustained rate. -- (2) Also, we can use coarse grained global barriers. That is, we -- can produce some number of output elements, wait until quiescence -- of all Par computations, and then produce more. -- (3) We can register computations that should only execute when a -- worker goes idle. This is a simple form of priority scheduling. generate size fn = do outstrm <- new fork$ loop (0::Int) outstrm return outstrm where loop n strm | n == size = do when debugflag (print_$ " [generate] Done. Produced "++ show size++" elements.\n") put strm Null return () loop n strm = do newtl <- new put strm (Cons (fn n) newtl) P.yield -- This is necessary to avoid starving others when there -- aren't enough worker threads to go around. loop (n+1) newtl -- | Create a [windowed] stream of consecutive integers. Generates at -- least the target number of elements windowed into segments of a -- specified size. countupWin :: (Storable a, NFData a, Num a) => Int -> Int -> Par (WStream a) countupWin bufsize target = generate num fn where num = case r of 0 -> q _ -> q+1 (q,r) = quotRem target bufsize fn n = let start = n * bufsize in array (start,start + bufsize-1) [(i, fromIntegral (n + fromIntegral i)) | i <- [start .. start + bufsize-1]] measureRate :: Stream a -> IO () measureRate strm = do lazyls <- toListSpin strm measureRateList lazyls measureRateList :: [a] -> IO () measureRateList lazyls = do t0 <- getTime print_$ " [measureRate] Counting stream rate starting at time: "++ show t0 loop t0 t0 (0::Int64) (0::Int64) lazyls where loop _ _ _ n [] = do print_$ " [measureRate] Hit end of stream after "++show n++" elements." return () loop start time lastN n (h:t) = do time2 <- getTime if time2 - time > one_second then do (print_$ " [measureRate] current rate: "++show (n+1-lastN) ++ " Total elems&time "++ commaint (n+1)++ " " ++commaint (time2-start)) -- print_ (show (n+1)) loop start time2 (n+1) (n+1) t else do loop start time lastN (n+1) t -- | Use the keyboard to interactively browse through stream elements. browseStream :: Show a => Stream a -> IO () browseStream strm = do putStrLn$ "[browseStream] Beginning interactive stream browser, press enter for more elements:" ls <- toListSpin strm loop 0 ls where loop n ls = do putStr$ show n ++ "# " hFlush stdout c <- getChar if c == '\EOT' -- User presses ctrl D to exit. then putStrLn$ "[browseStream] Ctrl-D pressed, exiting." else case ls of [] -> putStrLn$ "[browseStream] Reached end of stream after "++show n++" elements." (h:t) -> do print h loop (n+1) t -------------------------------------------------------------------------------- -- Conversion: -- Convert a stream to a lazy list. Spin wait (with yield) until stream elements are available. toListSpin :: Stream a -> IO [a] toListSpin strm = do x <- pollIVar strm case x of Nothing -> do Conc.yield -- run other GHC threads toListSpin strm -- spin wait Just (ils) -> case ils of Null -> return [] Cons h t -> return (h : unsafePerformIO (unsafeInterleaveIO (toListSpin t))) -- TODO: If it is unavailable we should help run the computation and then try again. -- This version will do runParAsync itself: -- Run a Par computation to produce a stream. Convert that stream to a lazy list. runParList :: Par (Stream a) -> [a] runParList = undefined -- runForList parcomp = loop (runParAsync parcomp) -- where -- loop strm = -- do x <- pollIVar strm -- case x of -- Nothing -> -- -- For now we just spin: -- do yield -- run other GHC threads -- loop strm -- Just (ils) -> -- case ils of -- Null -> return [] -- Cons h t -> return (h : unsafePerformIO (unsafeInterleaveIO (loop t))) -------------------------------------------------------------------------------- -- Helpers and Scrap: print_ msg = trace msg $ return () _unsafe_io :: IO a -> Par a _unsafe_io io = let x = unsafePerformIO io in x `seq` return x _unsafe_dupable :: IO a -> Par a _unsafe_dupable io = let x = unsafeDupablePerformIO io in x `seq` return x -- This version simply busy-waits to stay on the same core: measure_freq2 :: IO Word64 measure_freq2 = do -- let second = 1000 * 1000 * 1000 * 1000 -- picoseconds are annoying let tenth = 100 * 1000 * 1000 * 1000 -- picoseconds are annoying coef = 10 t1 <- rdtsc start <- getCPUTime let loop !n !last = do t2 <- rdtsc when (t2 < last) $ putStrLn$ "WARNING, measure_freq2: COUNTERS WRAPPED "++ show (last,t2) cput <- getCPUTime -- if (cput - start < second) if (cput - start < tenth) then loop (n+1) t2 else return (n,t2) (n,t2) <- loop 0 t1 putStrLn$ " Approx getCPUTime calls per second: "++ commaint (coef * n) when (t2 < t1) $ putStrLn$ "WARNING: rdtsc not monotonically increasing, first "++show t1++" then "++show t2++" on the same OS thread" return$ coef * fromIntegral (t2 - t1) commaint :: Integral a => a -> String commaint n = reverse $ concat $ intersperse "," $ chunk 3 $ reverse (show n) -- Having trouble with this: -- getTime = getCPUTime -- one_second = 1000000000000 -- picoseconds getTime = rdtsc one_second = unsafePerformIO$ measure_freq2 instance NFData (U.UArray a b) where rnf !arr = () instance NFData (C.CArray a b) where rnf !arr = () monad-par-0.1.0.3/examples/0000755000000000000000000000000011673650535013546 5ustar0000000000000000monad-par-0.1.0.3/examples/benchlist.txt0000644000000000000000000000111011673650534016252 0ustar0000000000000000# This is a default set of benchmarks reasonable for a powerful four core machine. parfib monad 36 parfib sparks 36 blackscholes 10000 15000000 cholesky 1000 50 cholesky_matrix1000.dat nbody 13000 # mandel 300 300 4000 mandel 2000 2000 3000000 coins 8 1250 stream/disjoint_working_sets_pipeline monad 4 256 10 10000 stream/disjoint_working_sets_pipeline sparks 4 256 10 10000 partree/partree 600 20 # What should the arguments be here: # minimax/minimax ? ? # These don't match the naming convention at the moment. matmult/matmult 768 0 64 sumeuler/sumeuler 38 8000 100 monad-par-0.1.0.3/examples/benchmark.sh0000755000000000000000000001445411673650534016046 0ustar0000000000000000#!/bin/bash # Runs benchmarks. Simon Marlow has his own setup. This is just temporary. # --------------------------------------------------------------------------- # Usage: [set env vars] ./benchmark.sh # Call it with environment variable SHORTRUN=1 to get a shorter run for # testing rather than benchmarking. # Call it with THREADSETTINGS="1 2 4" to run with # threads = 1, 2, or 4. # Call it with KEEPGOING=1 to keep going after the first error. # Call it with TRIALS=N to control the number of times each benchmark is run. # --------------------------------------------------------------------------- # Settings: # ---------------------------------------- if [ "$THREADSETTINGS" == "" ] then THREADSETTINGS="4" #then THREADSETTINGS="0 1 2 3 4" fi if [ "$GHC" == "" ]; then GHC=ghc; fi # HACK: with all the intermachine syncing and different version control systems I run into permissions problems sometimes. chmod +x ./ntime* ./*.sh # Where to put the timing results: RESULTS=results.dat if [ -e $RESULTS ]; then BAK="$RESULTS".bak.`date +%s` echo "Backing up old results to $BAK" mv $RESULTS $BAK fi # How many times to run a process before taking the best time: if [ "$TRIALS" == "" ]; then TRIALS=1 fi # Determine number of hardware threads on the machine: if [ -d /sys/devices/system/cpu/ ]; # linux then MAXTHREADS=`ls /sys/devices/system/cpu/ | grep "cpu[0123456789]*$" | wc -l` echo "Detected the number of CPUs on the machine to be $MAXTHREADS" elif [ `uname` == "Darwin" ]; then MAXTHREADS=`sysctl -n hw.ncpu` else MAXTHREADS=2 fi GHC_FLAGS="$GHC_FLAGS -O2 -rtsopts" GHC_RTS="$GHC_RTS -qa" # ================================================================================ echo "# TestName Variant NumThreads MinTime MedianTime MaxTime" > $RESULTS echo "# "`date` >> $RESULTS echo "# "`uname -a` >> $RESULTS echo "# "`$GHC -V` >> $RESULTS echo "# " echo "# Running each test for $TRIALS trials." >> $RESULTS echo "# ... with default compiler options: $GHC_FLAGS" >> $RESULTS echo "# ... with default runtime options: $GHC_RTS" >> $RESULTS cnt=0 function check_error() { CODE=$1 MSG=$2 # Error code 143 was a timeout if [ "$CODE" == "143" ] then echo " # Return code $CODE Params: $GHC_FLAGS, RTS $GHC_RTS " | tee -a $RESULTS echo " # Process TIMED OUT!!" | tee -a $RESULTS elif [ "$CODE" != "0" ] then echo " # $MSG" | tee -a $RESULTS echo " # Error code $CODE Params: $GHC_FLAGS, RTS $GHC_RTS " | tee -a $RESULTS echo "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" if [ "$KEEPGOING" == "" ]; then exit $CODE fi fi } function runit() { cnt=$((cnt+1)) echo echo "--------------------------------------------------------------------------------" echo " Running Config $cnt: $test variant threads $NUMTHREADS " echo "--------------------------------------------------------------------------------" echo echo "(In directory `pwd`)" if [ "$NUMTHREADS" != "0" ] && [ "$NUMTHREADS" != "" ] then export RTS=" $GHC_RTS -s -N$NUMTHREADS " export FLAGS=" $GHC_FLAGS -threaded " else export RTS="" export FLAGS=" $GHC_FLAGS " fi CONTAININGDIR=`dirname $test` # We compile the test case using runcnc: if [ -e "$test".hs ]; then FINALARGS="-i../ -i`dirname $test` $FLAGS $test.hs -o $test.exe" echo "Compiling with a single GHC command: " echo " $GHC $FINALARGS" $GHC $FINALARGS check_error $? "ERROR: compilation failed." elif [ -d "$CONTAININGDIR" ] && [ "$CONTAININGDIR" != "." ] && [ -e "$CONTAININGDIR/Makefile" ]; then echo " ** Benchmark appears in a subdirectory with Makefile. Using it." echo " ** WARNING: Can't currently control compiler options for this benchmark!" (cd "$CONTAININGDIR/"; make) else echo "ERROR: File does not exist: $test.hs" exit 1 fi echo "Executing $NTIMES $TRIALS $test.exe $ARGS +RTS $RTS -RTS " if [ "$SHORTRUN" != "" ]; then export HIDEOUTPUT=1; fi # One option woud be dynamic feedback where if the first one # takes a long time we don't bother doing more trials. times=`$NTIMES "$TRIALS" ./$test.exe $ARGS +RTS $RTS -RTS` CODE=$? echo " >>> MIN/MEDIAN/MAX TIMES $times" check_error $CODE "ERROR: run_all_tests this test failed completely: $test.exe" set -- $ARGS if [ "$CODE" == "143" ]; then echo "$test.exe" $1 "$NUMTHREADS" "TIMEOUT TIMEOUT TIMEOUT" >> $RESULTS elif [ "$CODE" != "0" ] ; then echo "$test.exe" $1 "$NUMTHREADS" "ERR ERR ERR" >> $RESULTS else echo "$test.exe" $1 "$NUMTHREADS" "$times" >> $RESULTS fi } echo "Running all tests, for THREADSETTINGS in {$THREADSETTINGS}" echo # Hygiene: make clean echo; echo; #==================================================================================================== function run_benchmark() { set -- $line test=$1; shift if [ "$SHORTRUN" == "" ]; # If we're in SHORTRUN mode we run each executable with no # arguments causing it to go to its default (small) problem size. then ARGS=$* else ARGS= fi echo "================================================================================" echo " Running Test: $test.exe $ARGS " echo "================================================================================" echo "# *** Config [$cnt ..], testing with command/args: $test.exe $ARGS " >> $RESULTS for NUMTHREADS in $THREADSETTINGS; do runit echo >> $RESULTS; done # threads export NUMTHREADS=0 echo >> $RESULTS; echo >> $RESULTS; } # Read $line and do the benchmark with ntimes_binsearch.sh function run_binsearch_benchmark() { NTIMES=./ntimes_binsearch.sh run_benchmark NTIMES=UNSET } # Read $line and do the benchmark with ntimes_minmedmax function run_normal_benchmark() { NTIMES=./ntimes_minmedmax run_benchmark NTIMES=UNSET } #==================================================================================================== if [ "$BENCHLIST" == "" ]; then BENCHLIST="./benchlist.txt" fi echo "Reading benchmarks from $BENCHLIST ..." cat $BENCHLIST | grep -v "\#" | while read line do if [ "$line" == "" ]; then continue; fi echo RUNNING BENCH: $line run_normal_benchmark done echo "Finished with all test configurations." monad-par-0.1.0.3/examples/blackscholes_data.hs0000644000000000000000000032571311673650535017543 0ustar0000000000000000-- #include file of test data inpout params and DerivaGem control reference value -- -- S, K, r, q, vol, T, P/C, Divs, DG RefValue data_init = listArray (0,999) [ ParameterSet { sptprice=42.00, strike=40.00, rate=0.1000, volatility=0.20, otime=0.50, otype=True}, ParameterSet {sptprice=42.00, strike=40.00, rate=0.1000, volatility=0.20, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.15, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.15, otime=1.00, otype=True}, ParameterSet {sptprice=60.00, strike=65.00, rate=0.0800, volatility=0.30, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.10, otime=0.10, otype=True}, ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.10, otime=0.50, otype=True}, ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.10, otime=1.00, otype=True}, ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.10, otime=0.10, otype=True}, ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.10, otime=0.50, otype=True}, ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.10, otime=1.00, otype=True}, ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.10, otime=0.10, otype=True}, ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.10, otime=0.50, otype=True}, ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.10, otime=1.00, otype=True}, ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.25, otime=0.10, otype=True}, ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.25, otime=0.50, otype=True}, ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.25, otime=1.00, otype=True}, ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.25, otime=0.10, otype=True}, ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.25, otime=0.50, otype=True}, ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.25, otime=1.00, otype=True}, ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.25, otime=0.10, otype=True}, ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.25, otime=0.50, otype=True}, ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.25, otime=1.00, otype=True}, ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.50, otime=0.10, otype=True}, ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.50, otime=0.50, otype=True}, ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.50, otime=1.00, otype=True}, ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.50, otime=0.10, otype=True}, ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.50, otime=0.50, otype=True}, ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.50, otime=1.00, otype=True}, ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.50, otime=0.10, otype=True}, ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.50, otime=0.50, otype=True}, ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.50, otime=1.00, otype=True}, ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.10, otime=0.10, otype=False}, ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.10, otime=0.50, otype=False}, ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.10, otime=1.00, otype=False}, ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.10, otime=0.10, otype=False}, ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.10, otime=0.50, otype=False}, ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.10, otime=1.00, otype=False}, ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.10, otime=0.10, otype=False}, ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.10, otime=0.50, otype=False}, ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.10, otime=1.00, otype=False}, ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.25, otime=0.10, otype=False}, ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.25, otime=0.50, otype=False}, ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.25, otime=1.00, otype=False}, ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.25, otime=0.10, otype=False}, ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.25, otime=0.50, otype=False}, ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.25, otime=1.00, otype=False}, ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.25, otime=0.10, otype=False}, ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.10, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.10, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.10, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.25, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.25, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.25, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.25, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.50, otime=0.10, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.50, otime=0.50, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.50, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.05, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.15, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.35, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.40, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.75, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.05, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.15, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.35, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.40, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.75, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.05, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.15, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.35, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.40, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.75, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.05, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.15, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.35, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.40, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.75, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.05, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.15, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.35, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.40, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.75, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.05, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.15, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.35, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.40, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.75, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.05, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.15, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.35, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.40, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.75, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.05, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.15, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.35, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.40, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.75, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.05, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.15, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.35, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.40, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.75, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.05, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.15, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.25, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.35, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.75, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.05, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.15, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.25, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.35, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.75, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.05, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.15, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.25, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.35, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.75, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.05, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.15, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.35, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.75, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.05, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.15, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.35, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.75, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.05, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.15, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.35, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.75, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.05, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.15, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.25, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.35, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.75, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.05, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.15, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.25, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.35, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.75, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.05, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.15, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.25, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.35, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.05, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.15, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.25, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.35, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.40, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.75, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.05, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.15, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.25, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.35, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.40, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.75, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.05, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.15, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.25, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.35, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.40, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.75, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.05, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.15, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.35, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.40, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.75, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.05, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.15, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.35, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.40, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.75, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.05, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.15, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.35, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.40, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.75, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.05, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.15, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.25, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.35, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.40, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.75, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.05, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.15, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.25, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.35, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.40, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.75, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.05, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.15, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.25, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.35, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.40, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.75, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.05, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.15, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.40, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.05, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.15, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.40, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.05, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.15, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.40, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.05, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.15, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.40, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.05, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.15, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.40, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.05, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.15, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.40, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.05, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.15, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.40, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.05, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.15, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.40, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.05, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.15, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.40, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.75, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.25, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.25, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.50, otime=0.10, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.50, otime=0.50, otype=True}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.50, otime=1.00, otype=True}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.10, otime=1.00, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.10, otime=0.10, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.10, otime=0.50, otype=False}, ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.10, otime=1.00, otype=False} ] monad-par-0.1.0.3/examples/blackscholes.hs0000644000000000000000000001176111673650535016545 0ustar0000000000000000{-# LANGUAGE RecordWildCards, CPP, ScopedTypeVariables, FlexibleInstances #-} -- Ported from CnC/C++ program by Ryan Newton -- Then ported again from the Haskell-CnC interface to monad-par. [2011.02.16] -- 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. -- 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.Seq import Control.Monad import Control.DeepSeq import Control.Exception import Control.Monad.Par import Control.Monad.Par.AList import Data.Array import Data.List import qualified Data.Array.Unboxed as U import System.Environment -------------------------------------------------------------------------------- type FpType = Float -- 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 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 -------------------------------------------------------------------------------- -- Scalar code follows: 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) ) -------------------------------------------------------------------------------- computeSegment :: Int -> Int -> U.UArray Int FpType computeSegment granularity t = arr where arr = U.listArray (0, granularity-1) $ Prelude.map fn [0 .. granularity-1] fn i = let ParameterSet { .. } = data_init U.! ((t+i) `mod` size_init) in blkSchlsEqEuroNoDiv sptprice strike rate volatility otime otype 0 -------------------------------------------------------------------------------- -- No need to go deeper here because its unboxed, right? instance NFData (U.UArray Int FpType) where main = do args <- getArgs let (numOptions, granularity) = case args of [] -> (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 numChunks = numOptions `quot` granularity -- results = runPar$ parMap (computeSegment granularity . (* granularity)) [0..numChunks-1] #if 1 results = runPar$ parMap (computeSegment granularity) [0, granularity .. numOptions-1] #else -- Not working right yet [2011.02.18] results = toList$ runPar$ parBuild 1 0 (numChunks-1) (computeSegment granularity . (* granularity)) #endif sum = foldl1' (+) $ map (U.! 0) results putStrLn$ "Final checksum: "++ show sum monad-par-0.1.0.3/examples/cholesky.hs0000644000000000000000000003304111673650535015724 0ustar0000000000000000{- - 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. - -} {-# LANGUAGE ExistentialQuantification , ScopedTypeVariables , BangPatterns , NamedFieldPuns , RecordWildCards , FlexibleInstances , DeriveDataTypeable , TypeSynonymInstances , CPP #-} -- Author: Chih-Ping Chen -- Modified by Ryan Newton. -- This program uses monad-par to do cholesky transformation. -- Description -- ----------- -- Given a symmetric positive definite matrix A, the Cholesky decomposition is -- a lower triangular matrix L such that A=L.L^(T). -- Usage -- ----- -- The command line is: -- cholesky n b filename -- n : input SPD matrix size -- b : block/tile size -- filename: input matrix file name -- Several sample input files are provided. m6.in is a 6x6 matrix (n=6). -- Input_matrix.zip contains the files m50.in, m100.in, m500.in, and m1000.in with -- corresponding 'n' of 50, 100, 500, and 1000. -- e.g. -- cholesky 1000 50 m1000.in 4 -- cholesky v 6 2 m6.in -- The input SPD matrix is read from the file specified. The output will be a -- lower triangular matrix. import Data.Int import qualified Data.List as List import qualified Data.Array.Unboxed as Array import Data.Array.IO import Data.Array.MArray import Debug.Trace import System.Posix.Files import System.Environment import System.IO import System.IO.Unsafe import Data.Map import Data.IORef import qualified Data.ByteString.Char8 as B import Control.DeepSeq import Control.Exception import Data.Time.Clock -- Not in 6.10 import Control.Monad import Control.Monad.Par timeit io = do strt <- getCurrentTime io end <- getCurrentTime return (diffUTCTime end strt) -- The type of the input/output array. type Matrix = Array.UArray (Int, Int) Float instance NFData Matrix -- A matrix is divided into "Tile"s, and carries intermediate results -- of the computation. type Tile = IOUArray (Int, Int) Float -- Tile3D allows us to refer to a IVar associated with a tile. The first -- two dimensions of the index are the coordinates of the tile in the matrix. -- The last dimension is the "generation" dimension. I.e., a (IVar Tile) mapped -- by (i, j, k+1) is the next generation of the (IVar Tile) mapped by (i, j, k). type Tiles3D = Map (Int, Int, Int) (IVar Tile) instance NFData Tile where -- SDM: use the default. All we require is that the IOUArray is evaluated, -- since all its contents are unboxed. -- rnf x = unsafePerformIO $ -- do bounds <- getBounds x -- elems <- getElems x -- _ <- return $ rnf (bounds, elems) -- return () parMap_ :: (a -> Par ()) -> [a] -> Par () parMap_ f xs = mapM (spawn . f) xs >> return () getTileV :: (Int, Int, Int) -> Tiles3D -> IVar Tile getTileV triplet tiles = findWithDefault (error "This can't be happening...") triplet tiles -- This kicks off cholesky factorization on the diagonal tiles. s0Compute :: IVar Tiles3D -> Int -> Int -> Par () s0Compute lkjiv p b = do lkji <- get lkjiv parMap_ (s1Compute lkji p b) [0..p-1] -- This does the cholesky factorization on the a diagonal tile, and -- kicks off triangular system solve on the tiles that are below and -- on the same column as the diagonal tile. s1Compute :: Tiles3D -> Int -> Int -> Int -> Par () s1Compute lkji p b k = do -- Read the tile: aBlock <- get $ getTileV (k, k, k) lkji -- Write an output tile: put (getTileV (k, k, k+1) lkji) (s1Core aBlock b) -- Do triangular solves on the tiles with the same column number parMap_ (s2Compute lkji b) [(k,j) | j <- [k+1..p-1]] where s1Core aBlock b = unsafePerformIO $ do lBlock <- newArray ((0,0), (b-1,b-1)) 0.0 forM_ [0..b-1] (outer aBlock lBlock b) return lBlock outer aBlock lBlock b kb = do base <- readArray aBlock (kb,kb) writeArray lBlock (kb,kb) (sqrt base) forM_ [kb+1 .. b-1] (inner1 aBlock lBlock kb) forM_ [kb+1 .. b-1] (inner2 aBlock lBlock kb b) inner1 aBlock lBlock kb jb = do base1 <- readArray aBlock (jb,kb) base2 <- readArray lBlock (kb,kb) writeArray lBlock (jb,kb) (base1 /base2) inner2 aBlock lBlock kb b jbb = do forM_ [kb+1 .. b-1] (inner3 aBlock lBlock jbb kb) inner3 aBlock lBlock jbb kb ib = do base1 <- readArray aBlock (ib, jbb) base2 <- readArray lBlock (ib, kb) base3 <- readArray lBlock (jbb, kb) writeArray aBlock (ib,jbb) (base1 - base2 * base3) -- This does the triangular system solve on a tile T, and -- kicks off the symmetric rank-k update on the tiles that -- are to the right and on the same row as T. s2Compute :: Tiles3D -> Int -> (Int, Int) -> Par () s2Compute lkji b (k, j) = do aBlock <- get $ getTileV (j,k,k) lkji liBlock <- get $ getTileV (k,k,k+1) lkji put (getTileV (j,k,k+1) lkji) (s2Core aBlock liBlock b) parMap_ (s3Compute lkji b) [(k, j, i) | i <- [k+1..j]] where s2Core aBlock liBlock b = unsafePerformIO $ do loBlock <- newArray ((0,0),(b-1,b-1)) 0.0 forM_ [0..b-1] (outer aBlock liBlock loBlock b) return loBlock outer aBlock liBlock loBlock b kb = do forM_ [0..b-1] (inner1 aBlock liBlock loBlock kb) forM_ [kb+1..b-1] (inner2 aBlock liBlock loBlock b kb) inner1 aBlock liBlock loBlock kb ib = do base1 <- readArray aBlock (ib,kb) base2 <- readArray liBlock (kb,kb) writeArray loBlock (ib,kb) (base1 / base2) inner2 aBlock liBlock loBlock b kb jb = do forM_ [0..b-1] (inner3 aBlock liBlock loBlock kb jb) inner3 aBlock liBlock loBlock kb jb ib = do base1 <- readArray aBlock (ib,jb) base2 <- readArray liBlock (jb,kb) base3 <- readArray loBlock (ib,kb) writeArray aBlock (ib,jb) (base1 - (base2 * base3)) -- This computes the symmetric rank-k update on a tile. s3Compute :: Tiles3D -> Int -> (Int, Int, Int) -> Par () s3Compute lkji b (k,j,i) | i == j = do aBlock <- get $ getTileV (j,i,k) lkji l2Block <- get $ getTileV (j,k,k+1) lkji put (getTileV (j,i,k+1) lkji) (s3Core aBlock l2Block b) -- pval lkji return () where s3Core aBlock l2Block b = unsafePerformIO $ do forM_ [0..b-1] (outer aBlock l2Block b) return aBlock outer aBlock l2Block b jb = do forM_ [0..b-1] (inner1 aBlock l2Block b jb) inner1 aBlock l2Block b jb kb = do base <- readArray l2Block (jb,kb) forM_ [jb..b-1] (inner2 aBlock l2Block jb kb (-base)) inner2 aBlock l2Block jb kb temp ib = do base1 <- readArray aBlock (ib,jb) base2 <- readArray l2Block (ib,kb) writeArray aBlock (ib,jb) (base1 + temp * base2) s3Compute lkji b (k,j,i) | otherwise = do aBlock <- get $ getTileV (j,i,k) lkji l2Block <- get $ getTileV (i,k,k+1) lkji l1Block <- get $ getTileV (j,k,k+1) lkji put (getTileV (j,i,k+1) lkji) (s3Core aBlock l1Block l2Block b) return () where s3Core aBlock l1Block l2Block b = unsafePerformIO $ do forM_ [0..b-1] (outer aBlock l1Block l2Block b) return aBlock outer aBlock l1Block l2Block b jb = do forM_ [0..b-1] (inner1 aBlock l1Block l2Block b jb) inner1 aBlock l1Block l2Block b jb kb = do base <- readArray l2Block (jb,kb) forM_ [0..b-1] (inner2 aBlock l1Block jb kb (-base)) inner2 aBlock l1Block jb kb temp ib = do base1 <- readArray aBlock (ib,jb) base2 <- readArray l1Block (ib,kb) writeArray aBlock (ib,jb) (base1 + temp * base2) -- initLkji initialize the (IVar Tile) map using the input array. initLkji :: Matrix -> Int -> Int -> Int -> Par (IVar Tiles3D) initLkji arrA n p b = let tile i j = unsafePerformIO $ newListArray ((0,0),(b-1,b-1)) (tileList i j) tileList i j = [ arrA Array.! (i * b + ii, j * b + jj) | ii <- [0..b-1], jj <-[0..b-1]] fn c (i, j, k) | k == 0 = do mv <- c m <- get mv tv <- pval $ tile i j pval $ insert (i, j, k) tv m fn c (i, j, k) | otherwise = do mv <- c m <- get mv tv <- new pval $ insert (i, j, k) tv m in foldl fn (pval empty) [(i, j, k) | i <- [0..p-1], j <- [0..i], k <- [0..j+1]] -- composeResult collect the tiles with the final results back into one single matrix. composeResult :: Tiles3D -> Int -> Int -> Int -> Par Matrix composeResult lkji n p b = do assocs <- sequence [ grab i ib j | i <- [0..p-1], ib <- [0..b-1], j <- [0..i]] return $ Array.array ((0,0),(n-1,n-1)) (concat assocs) where grab i ib j = if (i == j) then do matOut <- get $ getTileV (i,j,j+1) lkji compose1 matOut else do matOut <- get $ getTileV (i,j,j+1) lkji compose2 matOut where compose1 matOut = do forM [0..ib] (compose11 matOut) compose11 matOut jb = let elem = unsafePerformIO $ do readArray matOut (ib,jb) in return ((i*b+ib,j*b+jb),elem) compose2 matOut = do forM [0..b-1] (compose11 matOut) {-# INLINE for_ #-} for_ start end fn | start > end = error "for_: start is greater than end" for_ start end fn = loop start where loop !i | i == end = return () | otherwise = do fn i; loop (i+1) run :: Int -> Int -> Matrix -> Matrix run n b arrA = let p = n `div` b in runPar $ do lkjiv <- initLkji arrA n p b _ <- s0Compute lkjiv p b lkji' <- get lkjiv composeResult lkji' n p b main = do ls <- getArgs let (n, b, fname) = case ls of [] -> (6, 2, "cholesky_matrix6.dat") -- To get more data try this: -- wget http://people.csail.mit.edu/newton/haskell-cnc/datasets/cholesky_matrix_data.tbz ["medium"] -> (500, 50, "cholesky_matrix500.dat") ["big"] -> (1000, 50, "cholesky_matrix1000.dat") [a,b,c] -> (read a, read b, c) bool <- fileExist fname let fname' = if bool then fname else "examples/"++fname ref <- newIORef undefined let meaningless_write !val = writeIORef ref val t1 <- getCurrentTime putStrLn "Begin reading from disk..." arrA <- initMatrix n fname' evaluate arrA t2 <- getCurrentTime putStrLn $" ... ArrA read from disk: time " ++ show (diffUTCTime t2 t1) hFlush stdout arrB <- return $ run n b arrA --putStrLn $ show $ [((i,j),arrB Array.! (i,j)) | i <-[0..n-1], j<-[0..i]] putStrLn "Making sure evaluation of arrB is forced..." evaluate arrB --putStrLn $ show $ [((i,j),arrB Array.! (i,j)) | i <-[0..n-1], j<-[0..i]] t3 <- getCurrentTime -- FIXME: Using deepseq here seems to delay the evaluation to the reference of -- t3 <- case deepseq arrB () of _ -> getCurrentTime -- t3 <- arrB `deepseq` getCurrentTime putStrLn$ "Finished: eval time "++ show (diffUTCTime t3 t2) putStrLn$ "SELFTIMED " ++ show ((fromRational $ toRational $ diffUTCTime t3 t2) :: Double) t4 <- getCurrentTime val <- readIORef ref putStrLn$ "Last value: " ++ show (arrB Array.! (n-1, n-1)) t5 <- getCurrentTime putStrLn$ "SELFTIMED' " ++ show ((fromRational $ toRational $ diffUTCTime t5 t4) :: Double) initMatrix :: Int -> [Char] -> IO Matrix initMatrix n fname = do fs <- B.readFile fname return $! Array.listArray ((0,0), (n-1, n-1)) (List.cycle $ List.map (read . B.unpack) (B.words fs)) monad-par-0.1.0.3/examples/cholesky_matrix6.dat0000644000000000000000000000013711673650535017534 0ustar00000000000000004 -2 6 8 6 10 -2 10 3 -4 15 1 6 3 14 11 19 22 8 -4 11 33 2 21 6 15 19 2 62 28 10 1 22 21 28 73 monad-par-0.1.0.3/examples/coins.hs0000644000000000000000000002016011673650535015214 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} import Data.List import System.Environment import Control.Parallel import Control.Parallel.Strategies import Control.Applicative import Control.Monad.Par -- Rough results, GHC 6.13: (val=777) -- V1 (SDM): 2.2s -- V2 (SDM): 2.7s -- V3 (SDM, parallel): 1.0s on 7 cores -- V4 (original): got bored waiting -- V5 (HWL assoc): 5.2s -- V6 (SDM, Int result): 0.9s -- V7 (SDM, parallel): 0.2s on 7 cores ----------------------------------------------------------------------------- -- Version 1: returns results as a list of list of coins payL :: Int -> [(Int,Int)] -> [Int] -> [[Int]] payL 0 coins acc = [acc] payL _ [] acc = [] payL val ((c,q):coins) acc | c > val = payL val coins acc | otherwise = left ++ right where left = payL (val - c) coins' (c:acc) right = payL val coins acc coins' | q == 1 = coins | otherwise = (c,q-1) : coins ----------------------------------------------------------------------------- -- Version 2: uses a custom AList type to avoid repeated appends -- The idea here is that by avoiding the append we might be able to -- parallelise this more easily by just forcing evaluation to WHNF at -- each level. I haven't parallelised this version yet, though (V5 -- below is much easier) --SDM data AList a = ANil | ASing a | Append (AList a) (AList a) lenA :: AList a -> Int lenA ANil = 0 lenA (ASing _) = 1 lenA (Append l r) = lenA l + lenA r append ANil r = r append l ANil = l -- ** append l r = Append l r -- making append less strict (omit ** above) can make the algorithm -- faster in sequential mode, because it runs in constant space. -- However, ** helps parallelism. payA :: Int -> [(Int,Int)] -> [Int] -> AList [Int] payA 0 coins acc = ASing acc payA _ [] acc = ANil payA val ((c,q):coins) acc | c > val = payA val coins acc | otherwise = append left right -- strict in l, maybe strict in r where left = payA (val - c) coins' (c:acc) right = payA val coins acc coins' | q == 1 = coins | otherwise = (c,q-1) : coins ----------------------------------------------------------------------------- -- Version 3: parallel version of V2 payA_par :: Int -> Int -> [(Int,Int)] -> [Int] -> AList [Int] payA_par 0 val coins acc = payA val coins acc payA_par _ 0 coins acc = ASing acc payA_par _ _ [] acc = ANil payA_par depth val ((c,q):coins) acc | c > val = payA_par depth val coins acc | otherwise = res where res = unEval $ pure append <*> rpar left <*> rwhnf right left = payA_par (if q == 1 then (depth-1) else depth) (val - c) coins' (c:acc) right = payA_par (depth-1) val coins acc coins' | q == 1 = coins | otherwise = (c,q-1) : coins ----------------------------------------------------------------------------- -- Version 4: original list-of-list version (very slow) pay :: Int -> Int -> [Int] -> [Int] -> [[Int]] pay _ 0 coins accum = [accum] pay _ val [] _ = [] pay pri val coins accum = res where -- coins' = dropWhile (>val) coins coin_vals = nub coins' res = concat ( map ( \ c -> let new_coins = ((dropWhile (>c) coins')\\[c]) in pay (pri-1) (val-c) new_coins (c:accum) ) coin_vals ) ----------------------------------------------------------------------------- -- Version 5: assoc-list version (by HWL?) -- assoc-list-based version; still multiple list traversals pay1 :: Int -> Int -> [(Int,Int)] -> [(Int,Int)] -> [[(Int,Int)]] pay1 _ 0 coins accum = [accum] pay1 _ val [] _ = [] pay1 pri val coins accum = res where -- coins' = dropWhile ((>val) . fst) coins res = concat ( map ( \ (c,q) -> let -- several traversals new_coins = filter (not . (==0) . snd) $ map (\ x'@(c',q') -> if c==c' then (c',q'-1) else x') $ dropWhile ((>c) . fst) $ coins' new_accum = map (\ x'@(c',q') -> if c==c' then (c',q'+1) else x') accum in pay1 (pri-1) (val-c) new_coins new_accum ) coins' ) ----------------------------------------------------------------------------- -- Version 6: just return the number of results, not the results themselves payN :: Int -> [(Int,Int)] -> Int payN 0 coins = 1 payN _ [] = 0 payN val ((c,q):coins) | c > val = payN val coins | otherwise = left + right where left = payN (val - c) coins' right = payN val coins coins' | q == 1 = coins | otherwise = (c,q-1) : coins ----------------------------------------------------------------------------- -- Version 7: parallel version of payN payN_par :: Int -> Int -> [(Int,Int)] -> Int payN_par 0 val coins = payN val coins payN_par _ 0 coins = 1 payN_par _ _ [] = 0 payN_par depth val ((c,q):coins) | c > val = payN_par depth val coins | otherwise = res where res = right `par` left `pseq` left + right left = payN_par (if q == 1 then (depth-1) else depth) (val - c) coins' right = payN_par (depth-1) val coins coins' | q == 1 = coins | otherwise = (c,q-1) : coins ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- Version 8: monad-par version of payN -- Competitive with Version 7. payN_mp :: Int -> Int -> [(Int,Int)] -> Int payN_mp depth val coins = runPar $ payN_mpM depth val coins payN_mpM :: Int -> Int -> [(Int,Int)] -> Par Int payN_mpM 0 val coins = return $ payN val coins payN_mpM _ 0 coins = return 1 payN_mpM _ _ [] = return 0 payN_mpM depth val ((c,q):coins) | c > val = payN_mpM depth val coins | otherwise = res where res = do lv <- spawn $ left r <- right l <- get lv return (l + r) left = payN_mpM (if q == 1 then (depth-1) else depth) (val - c) coins' right = payN_mpM (depth-1) val coins coins' | q == 1 = coins | otherwise = (c,q-1) : coins ----------------------------------------------------------------------------- -- driver main = do let vals = [250, 100, 25, 10, 5, 1] -- let quants = [1, 3, 2, 5, 7, 12] -- small setup -- let quants = [5, 8, 8, 9, 12, 17] -- std setup let quants = [55, 88, 88, 99, 122, 177] -- large setup let coins = concat (zipWith replicate quants vals) coins1 = zip vals quants [n, arg] <- fmap (fmap read) getArgs case n of -- sequential, list of results 1 -> print $ length $ payL arg coins1 [] -- sequential, append-list of results 2 -> print $ lenA $ payA arg coins1 [] -- parallel, append-list of results 3 -> print $ lenA $ payA_par 4 arg coins1 [] 4 -> print $ length (pay 0 arg coins []) 5 -> print $ length (pay1 0 arg coins1 (map (\(c,q) -> (c,0)) coins1)) 6 -> print $ payN arg coins1 7 -> print $ payN_par 4 arg coins1 8 -> print $ payN_mp 4 arg coins1 monad-par-0.1.0.3/examples/common.mk0000644000000000000000000000057011673650535015371 0ustar0000000000000000 # RRN: allow setting it via the command line. (I don't have a ghc-testing2 ;-). ) ifeq (,$(GHC)) GHC = ghc # GHC = ghc-testing2 # GHC = ghc-stable-nightly2 endif ALLPARSRC= ../Control/Monad/Par.hs ../Control/Monad/Par/AList.hs ../Control/Monad/Par/OpenList.hs \ ../Control/Monad/Par/IList.hs ../Control/Monad/Par/Stream.hs ../Control/Monad/Par/Logging.hs monad-par-0.1.0.3/examples/get_cholesky_data.sh0000755000000000000000000000014311673650535017554 0ustar0000000000000000#!/bin/bash wget http://people.csail.mit.edu/~newton/haskell-cnc/datasets/cholesky_matrix_data.tbz monad-par-0.1.0.3/examples/Makefile0000644000000000000000000000141411673650535015206 0ustar0000000000000000include common.mk BENCHMARKS= queens.hs mandel.hs blackscholes.hs nbody.hs parfib.hs primes.hs \ cholesky.hs parfib.hs coins.hs # binomial_lattice.hs EXES= $(BENCHMARKS:.hs=.exe) OTHEREXES= matmult/matmult.exe minimax/minimax.exe sumeuler/sumeuler.exe \ stream/simple1_measureSrc.exe ALLEXES= $(EXES) $(OTHEREXES) all: $(EXES) (cd sumeuler; $(MAKE)) (cd matmult; $(MAKE)) (cd minimax; $(MAKE)) (cd stream; $(MAKE)) (cd partree; $(MAKE)) %.exe : %.hs $(ALLPARSRC) $(GHC) -O2 --make -i.. $< -o $@ -threaded -rtsopts runtests: ./run_tests.sh $(ALLEXES) clean: rm -f $(ALLEXES) *.o *.hi (cd sumeuler; $(MAKE) clean) (cd matmult; $(MAKE) clean) (cd minimax; $(MAKE) clean) (cd stream; $(MAKE) clean) (cd partree; $(MAKE) clean) monad-par-0.1.0.3/examples/mandel.hs0000644000000000000000000000523611673650535015350 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP #-} import System.Environment import Control.Monad import Control.Seq import Data.Complex import System.IO import Debug.Trace import Control.DeepSeq import Control.Monad.Par import Control.Exception import PortablePixmap import Control.Monad.Par.AList as A mandel :: Int -> Complex Double -> Int mandel max_depth c = loop 0 0 where fn = magnitude loop i !z | i == max_depth = i | fn(z) >= 2.0 = i | otherwise = loop (i+1) (z*z + c) threshold = 1 runMandel :: Double -> Double -> Double -> Double -> Int -> Int -> Int -> Par (AList [Int]) runMandel minX minY maxX maxY winX winY max_depth = do parBuildThreshM threshold (InclusiveRange 0 (winY-1)) $ \y -> do let l = [ mandelStep y x | x <- [0.. winX-1] ] deepseq l (return l) where mandelStep i j = mandel max_depth z where z = ((fromIntegral j * r_scale) / fromIntegral winY + minY) :+ ((fromIntegral i * c_scale) / fromIntegral winX + minX) r_scale = maxY - minY :: Double c_scale = maxX - minX :: Double makeImage :: Integer -> Integer -> Int -> AList [Int] -> PixMap makeImage x y depth ls = createPixmap x y depth (map prettyRGB (concat (toList ls))) where prettyRGB :: Int -> (Int,Int,Int) prettyRGB s = let t = (depth - s) in (s,t,t) simple x y depth = runMandel 0 0 x' y' x y depth where x' = fromIntegral x y' = fromIntegral y -------------------------------------------------------------------------------- -- A meaningless checksum. mandelCheck :: AList [Int] -> Int -> Int -> Int mandelCheck als max_col max_depth = loop 0 als 0 where loop i als !sum | A.null als = sum loop i als !sum = loop (i+1) (A.tail als) (loop2 i 0 (A.head als) sum) loop2 i j [] !sum = sum loop2 i j (h:t) !sum | h == max_depth = loop2 i (j+1) t (sum + i*max_col + j) | otherwise = loop2 i (j+1) t sum main = do args <- getArgs let (x,y,depth) = case args of [] -> -- runPar $ simple 3 3 3 (3,3,3) [x,y,depth] -> -- simple (read x) (read y) (read depth) (read x, read y, read depth) -- [minX,minY,maxX,maxY,winX,winY,depth] -> -- runPar $ -- runMandel (read minX) (read minY) -- (read maxX) (read maxY) -- (read winX) (read winY) (read depth) let ls = runPar$ simple x y depth when (False) $ do hnd <- openFile "mandel_image.ppm" WriteMode hSetBinaryMode hnd True hPrint hnd (makeImage (fromIntegral x) (fromIntegral y) depth ls) hClose hnd putStrLn$ "Spot check: " ++ show (mandelCheck ls y depth) monad-par-0.1.0.3/examples/nbody.hs0000644000000000000000000000762311673650535015225 0ustar0000000000000000{- - Modified from code released with: - Intel Concurrent Collections for Haskell - Copyright (c) 2010, Intel Corporation. -} {-# OPTIONS -fglasgow-exts #-} {-# LANGUAGE ExistentialQuantification , ScopedTypeVariables , BangPatterns , NamedFieldPuns , RecordWildCards , FlexibleInstances , DeriveDataTypeable , MagicHash , CPP #-} -- This is INCOMPATIBLE with CncPure.. -- Author: Chih-Ping Chen -- Ported to Monad-par by Ryan Newton. -- This program uses CnC to calculate the accelerations of the bodies in a 3D system. import Control.Monad.Par import Control.Monad import Data.Int import qualified Data.List as List import qualified Data.Array as A import GHC.Exts import System.Environment type Float3D = (Float, Float, Float) type UFloat3D = (# Float#, Float#, Float# #) -- This step generates the bodies in the system. genVector tag = (tag' * 1.0, tag' * 0.2, tag' * 30.0) where tag' = fromIntegral tag -- We are keeping the idiomatic Haskell version around as well for comparison: -- #define IDIOMATIC_VER -- Only doing the O(N^2) part in parallel: -- This step computes the accelerations of the bodies. compute :: A.Array Int Float3D -> A.Array Int (IVar Float3D) -> Int -> Par () compute vecList accels tag = do let myvector = vecList A.! (tag-1) put (accels A.! tag) (accel myvector vecList) where g = 9.8 multTriple :: Float -> Float3D -> Float3D multTriple c ( x,y,z ) = ( c*x,c*y,c*z ) pairWiseAccel :: Float3D -> Float3D -> Float3D pairWiseAccel (x,y,z) (x',y',z') = let dx = x'-x dy = y'-y dz = z'-z eps = 0.005 -- Performance degredation here: distanceSq = dx*dx + dy*dy + dz*dz + eps factor = 1/sqrt(distanceSq * distanceSq * distanceSq) -- in multTriple factor (dx,dy,dz) in multTriple factor (dx,dy,dz) #ifdef IDIOMATIC_VER sumTriples = foldr (\(x,y,z) (x',y',z') -> (x+x',y+y',z+z')) (0,0,0) accel vector vecList = multTriple g $ sumTriples $ List.map (pairWiseAccel vector) vecList #else -- Making this much less idiomatic to avoid allocation: (strt,end) = A.bounds vecList accel :: Float3D -> (A.Array Int Float3D) -> Float3D accel vector vecList = -- Manually inlining to see if the tuples unbox: let (# sx,sy,sz #) = loop strt 0 0 0 loop !i !ax !ay !az | i == end = (# ax,ay,az #) | otherwise = let ( x,y,z ) = vector ( x',y',z' ) = vecList A.! i (# dx,dy,dz #) = (# x'-x, y'-y, z'-z #) eps = 0.005 distanceSq = dx*dx + dy*dy + dz*dz + eps factor = 1/sqrt(distanceSq * distanceSq * distanceSq) (# px,py,pz #) = (# factor * dx, factor * dy, factor *dz #) in loop (i+1) (ax+px) (ay+py) (az+pz) in ( g*sx, g*sy, g*sz ) #endif run :: Int -> [Float3D] run n = runPar $ do vars <- sequence$ take n $ repeat new -- accels <- A.array (0,n-1) [ (i,) | i <- [0..n-1]] -- Is there a better way to make an array of pvars? let accels = A.array (1,n) (zip [1..n] vars) #ifdef IDIOMATIC_VER let initVecs = List.map genVector [1..n] #else let initVecs = A.array (0,n-1) [ (i, genVector i) | i <- [0..n-1] ] #endif forM_ [1..n] $ \ t -> fork (compute initVecs accels t) sequence (List.map (\i -> get (accels A.! i)) [1..n]) main = do args <- getArgs let accList = case args of [] -> run (3::Int) [s] -> run (read s) putStrLn $ show (foldl (\sum (x,y,z) -> if x>0 then sum+1 else sum) 0 accList) monad-par-0.1.0.3/examples/ntimes0000755000000000000000000001160311673650535014774 0ustar0000000000000000#!/bin/bash # --------------------------------------------------------------------------- # 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. # --------------------------------------------------------------------------- # Usage: ntimes cmd args ... # Takes the best time out of N. # Returns that best time in seconds to stdout. # This script writes a bunch of stuff to stderr, but only one thing to # stdout. The one thing, the "return value" of this process is the # best time in seconds. # Responds to the environment variable HIDEOUTPUT, which, if non-empty # suppresses echoing of the child command's output. # Also responds to NOTIME which turns off the timing. # Time out processes after three minutes. TIMEOUT=1000 # Unfortunately 'tempfile' is not a standard command: function mytempfile { date=`date +"%Y.%m.%d"` secs=`date +"%s"` #index=$(($index+1)) index=$1 file=./runs/"$date"_"$base"_"$CNC_VARIANT"_"$CNC_SCHEDULER"_"$NUMTHREADS"_"$secs"_"$index".log touch $file echo $file } N=$1 shift CMD=$* if [ "$CMD" == "" ]; then echo Usage: "ntimes ..." exit 1 fi base=`basename $1` if [ ! -d "./runs" ]; then mkdir ./runs; fi CAT=/bin/cat # This serves as the log TMP1=`mytempfile 1` echo "Execution log file: " >> /dev/stderr echo " $TMP1" >> /dev/stderr #echo "=================== ASYNCHRONOUS TEST OUTPUT TO FOLLOW ======================" > $TMP1 # if [ "$HIDEOUTPUT" == "" ]; # then (tail -f $TMP1 >> /dev/stderr) & # fi EXITCODE=0 for ((i=1; i <= $N; i++)); do # Stores just this one executable's output: TMP2=`mytempfile 2` # [2009.12.17] I need to get a good cross-platform process time-out system: # HACK: Sometimes I run this on systems WITHOUT a working GHC: if [ -e ./timeout.sh ]; then TIMEOUTRUN="./timeout.sh -t $TIMEOUT" elif [ -e ./timeout ]; # [2010.06.03] --RTS is a hack for working around a problem with +RTS flags: then TIMEOUTRUN="./timeout $TIMEOUT --RTS " else TIMEOUTRUN= fi if [ "$HIDEOUTPUT" == "" ]; then MYOUT=/dev/stderr else MYOUT=/dev/null fi echo | tee -a $TMP2 >> $MYOUT echo "Running trial $i of $N:" | tee -a $TMP2 >> $MYOUT echo "------------------------------------------------------------" | tee -a $TMP2 >> $MYOUT # This is hackish, it depends on the program output not containing # the string "real". (Aside from the timing results.) if [ "$NOTIME" != "" ]; then ($TIMEOUTRUN $CMD) &> /dev/stdout | tee -a $TMP2 >> $MYOUT; CODE=${PIPESTATUS[0]} elif [ `uname` == "Linux" ]; then (/usr/bin/time --format="%e real" $TIMEOUTRUN $CMD) &> /dev/stdout | tee -a $TMP2 >> $MYOUT; CODE=${PIPESTATUS[0]} else (/usr/bin/time $TIMEOUTRUN $CMD) &> /dev/stdout | tee -a $TMP2 >> $MYOUT; CODE=${PIPESTATUS[0]} fi # If there was an error, we don't commit the output to $TMP1: if [ "$CODE" == "0" ]; then echo " Run $i of command succeeded" >> /dev/stderr # SUPERHACK terrain... Here's a special symbol that the script can # use to override the external timing and use internal timing # mechinasms. selftime=`grep SELFTIME $TMP2` if [ "$selftime" != "" ]; then echo " +++ Executable appears self-timed!!:" >> $MYOUT echo "$selftime" >> $MYOUT cat $TMP2 | grep -v "real" | sed 's/SELFTIMED/real/' >> $TMP1 else cat $TMP2 >> $TMP1 fi # [2010.05.11] I used to just give warnings when not ALL of the trials failed: # This was for timing the nondeterministic hashtable hack: #else echo "Warning: run $i of command failed with code $CODE: $CMD" >> /dev/stderr else echo "ERROR run $i of command failed with code $CODE: $CMD" >> /dev/stderr #exit $CODE EXITCODE=$CODE fi rm -f $TMP2 done; # Stores the times: TMP3=`mytempfile 3` # HACK HACK: this assumes the string "real" doesn't occur in the test output. grep real $TMP1 | awk '{ print $1" "$2 }' | sort -n > $TMP3 # Echo the final output to stdout: echo "Final Timings: " > /dev/stderr cat $TMP3 | sed 's/real //' | sed 's/ real//' # Leave behind only $TMP1 rm -f $TMP3 exit $EXITCODE monad-par-0.1.0.3/examples/ntimes_minmedmax0000755000000000000000000000260511673650535017035 0ustar0000000000000000#!/bin/bash # --------------------------------------------------------------------------- # 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. # --------------------------------------------------------------------------- ntimes=`dirname $0`/ntimes times=`$ntimes $*` CODE=$? if [ "$CODE" != "0" ]; then exit $CODE fi lines=`echo $times | xargs -n1 echo | wc -l` half=$((($lines+1)/2)) echo "Median time (of $lines): " >> /dev/stderr #echo "Median time of: $times" >> /dev/stderr MIN=`echo $times | xargs -n1 echo | sort -n | head -n1` MED=`echo $times | xargs -n1 echo | sort -n | head -n$half | tail -n1` MAX=`echo $times | xargs -n1 echo | sort -n | tail -n1` echo $MIN $MED $MAX monad-par-0.1.0.3/examples/parfib.hs0000644000000000000000000000310111673650535015340 0ustar0000000000000000 import Data.Int import System.Environment -- import Control.Monad.Par import Control.Monad.ParElision import GHC.Conc type FibType = Int64 -- sequential version of the code fib :: FibType -> FibType fib 0 = 1 fib 1 = 1 fib x = fib (x-2) + fib (x-1) + 1 -- Basic, non-monadic parallel-fib: parfib0 :: FibType -> FibType parfib0 n | n < 2 = 1 parfib0 n = x `par` y `pseq` (x+y) where x = parfib0 (n-1) y = parfib0 (n-2) parfib1 :: FibType -> Par FibType parfib1 n | n < 2 = return 1 parfib1 n = do xf <- spawn_$ parfib1 (n-1) y <- parfib1 (n-2) x <- get xf return (x+y) main = do args <- getArgs let (version,size) = case args of [] -> ("monad",10) [v,n] -> (v,read n) case version of "monad" -> do putStrLn "Monad-par based version:" print$ runPar$ parfib1 size "sparks" -> do putStrLn "Sparks-based, Non-monadic version:" print$ parfib0 size _ -> error$ "unknown version: "++version {- On 4-core nehalem, 3.33ghz: Non-monadic version, real/user time: fib(40) 4 threads: 1.1s 4.4s fib(42) 4 threads: 2.9s 11.6s 17GB allocated SPARKS: 433784785 (290 converted, 280395620 pruned) Monad-par version: fib(38) non-threaded: 23.3s 23.1s fib(38) 1 thread : 24.7s 24.5s fib(38) 4 threads: 8.2s 31.3s fib(40) 4 threads: 20.6s 78.6s 240GB allocated For comparison, Cilkarts Cilk++: fib(42) 4 threads: 3.029s 23.610s Intel Cilk Plus: fib(42) 4 threads: 4.212s 16.770s -}monad-par-0.1.0.3/examples/plot_scaling.hs0000755000000000000000000003026611673650535016572 0ustar0000000000000000#!/usr/bin/env runhaskell {-# LANGUAGE NamedFieldPuns #-} -- This script generates gnuplot plots. -- Give it a .dat file as input... (or it will try to open results.dat) import Text.PrettyPrint.HughesPJClass import Text.Regex import Data.List import Data.Function import Control.Monad import System import System.IO import System.FilePath import System.Environment import HSH import Data.Array (listArray, ) import Data.Monoid (mappend, ) import Debug.Trace linewidth = "5.0" -- Schedulers that we don't care to graph right now. -- This happens BEFORE rename --scheduler_MASK = [5,6,99,10] scheduler_MASK = [] -- Ok, gunplot line type 6 is YELLOW... that's not to smart: line_types = [0..5] ++ [7..] round_2digits :: Double -> Double round_2digits n = (fromIntegral $round (n * 100)) / 100 --x11 = terminal Terminal.X11.cons --x11 = terminal cons --x11 = terminal Graphics.Gnuplot.Terminal.X11.cons --x11 = terminal X11.cons -- Split parse [a,b,c,d,e,f] = Entry { name = a, variant = b, sched = "trace", threads = read c, tmin = read d, tmed = read e, tmax = read f, normfactor = 1.0 } --parse [a,b,c,d,e,f,g,h,i] = -- trace ("Got line with norm factor: "++ show [a,b,c,d,e,f,g,h,i]) -- (parse [a,b,c,d,e,f,g,h]) { normfactor = read i } parse other = error$ "Cannot parse, wrong number of fields, "++ show (length other) ++" expected 8 or 9: "++ show other -------------------------------------------------------------------------------- -- Let's take a particular interpretation of Enum for pairs: instance (Enum t1, Enum t2) => Enum (t1,t2) where succ (a,b) = (succ a, succ b) pred (a,b) = (pred a, pred b) toEnum n = (toEnum n, toEnum n) fromEnum (a,b) = case (fromEnum a, fromEnum b) of (x,y) | x == y -> x (x,y) -> error$ "fromEnum of pair: nonmatching numbers: " ++ show x ++" and "++ show y -- Removes single blanks and separates lines into groups based on double blanks. sepDoubleBlanks :: [String] -> [[String]] sepDoubleBlanks ls = loop [] ls where loop acc [] = [reverse acc] loop acc ("":"":t) = reverse acc : loop [] (stripLeadingBlanks t) loop acc ("":t) = loop acc t loop acc (h :t) = loop (h:acc) t stripLeadingBlanks [] = [] stripLeadingBlanks ("":t) = stripLeadingBlanks t stripLeadingBlanks ls = ls remComments :: String -> [String] -> [String] remComments commentchars ls = filter (pred . stripLeadingWhitespace) ls where pred str = not (take (length commentchars) str == commentchars) stripLeadingWhitespace [] = [] stripLeadingWhitespace (' ':t) = stripLeadingWhitespace t stripLeadingWhitespace ls = ls -------------------------------------------------------------------------------- -- Here's the schema for the data from my timing tests: data Entry = Entry { name :: String, variant :: String, sched :: String, threads :: Int, tmin :: Double, tmed :: Double, tmax :: Double, normfactor :: Double } deriving Show instance Pretty Entry where --pPrint x = pPrint$ show x pPrint Entry { name, sched, variant, threads, tmin, tmed, tmax, normfactor } = pPrint ("ENTRY", name, sched, variant, threads, (tmin, tmed, tmax), normfactor ) -- pPrint ("ENTRY", name, variant, sched, threads, tmin, tmed, tmax, normfactor) groupSort fn = (groupBy ((==) `on` fn)) . (sortBy (compare `on` fn)) -- Add three more levels of list nesting to organize the data: --organize_data :: [Entry] -> [[[[Entry]]]] organize_data :: [Entry] -> [[[[Entry]]]] organize_data = (map (map (groupSort sched))) . (map (groupSort variant)) . (groupSort name) newtype Mystr = Mystr String instance Show Mystr where show (Mystr s) = s {- -- I ended up giving up on using the gnuplot package on hackage: -- mypath :: Graph2D.T --Plot2D.T --plot_benchmark :: [[[Entry]]] -> IO () --plot_benchmark :: [[[Entry]]] -> Plot2D.T plot_benchmark [io, pure] = --Plot.plot (X11.title "foobar" X11.cons) $ Plot.plot X11.cons $ Frame.cons (Opts.title ("Benchmark: " ++ benchname ++ " normalized to time " ++ show basetime) $ Opts.deflt) plots where benchname = name $ head $ head io plots = foldl1 mappend (map persched io ++ map persched pure) basetime = foldl1 min $ map tmed $ filter ((== 0) . threads) $ (concat io ++ concat pure) persched :: [Entry] -> Plot2D.T persched dat = let schd = sched$ head dat var = variant$ head dat mins = map tmin dat meds = map tmed dat maxs = map tmax dat --zip4 = map$ \ a b c d -> (a,b,c,d) zip4 s1 s2 s3 s4 = map (\ ((a,b), (c,d)) -> (a,b,c,d)) (zip (zip s1 s2) (zip s3 s4)) pairs = zip4 (map (fromIntegral . threads) dat) (map (basetime / ) meds) (map (basetime / ) mins) (map (basetime / ) maxs) quads = map (\ (a,b,c,d) -> Mystr (show a ++" "++ show b ++" "++ show d ++" "++ show c)) pairs in fmap (Graph2D.lineSpec $ LineSpec.title (var ++"/"++ show schd) $ LineSpec.lineWidth 3.0 $ LineSpec.pointSize 3.0 $ LineSpec.deflt) $ fmap (Graph2D.typ Graph2D.linesPoints) $ --Plot2D.path pairs --Plot2D.path (map ( \ (a,b,c,d) -> (a,b)) pairs) --fmap (Graph2D.typ Graph2D.errorBars) $ Plot2D.list quads -} -- Name, Scheduler, Threads, BestTime, Speedup data Best = Best (String, String, String, Int, Double, Double) -- Plot a single benchmark as a gnuplot script: plot_benchmark2 root [io, pure] = do action $ filter goodSched (io ++ pure) return$ Best (benchname, bestvariant, bestsched, bestthreads, best, basetime / best) where benchname = name $ head $ head io -- What was the best single-threaded execution time across variants/schedulers: goodSched [] = error "Empty block of data entries..." goodSched (h:t) = not $ (sched h) `elem` scheduler_MASK cat = concat io ++ concat pure threads0 = filter ((== 0) . threads) cat threads1 = filter ((== 1) . threads) cat map_normalized_time = map (\x -> tmed x / normfactor x) times0 = map_normalized_time threads0 times1 = map_normalized_time threads1 basetime = if not$ null times0 then foldl1 min times0 else if not$ null times1 then foldl1 min times1 else error$ "\nFor benchmark "++ show benchname ++ " could not find either 1-thread or 0-thread run.\n" ++ --"ALL entries: "++ show (pPrint cat) ++"\n" "\nALL entries threads: "++ show (map threads cat) best = foldl1 min $ map_normalized_time cat Just best_index = elemIndex best $ map_normalized_time cat bestsched = sched$ cat !! best_index bestvariant = variant$ cat !! best_index bestthreads = threads$ cat !! best_index (filebase,_) = break (== '.') $ basename benchname -- If all normfactors are the default 1.0 we print a different message: --let is_norm = not$ all (== 1.0) $ map normfactor ponits norms = map normfactor (concat io ++ concat pure) default_norms = all (== 1.0) $ norms max_norm = foldl1 max norms scrub '_' = ' ' scrub x = x -- scrub [] = [] -- scrub ('_':t) = "\\_"++ scrub t -- scrub (h:t) = h : scrub t action lines = do let scriptfile = root ++ filebase ++ ".gp" putStrLn$ " Dumping gnuplot script to: "++ scriptfile putStrLn$ " NORM FACTORS "++ show norms runIO$ echo "set terminal postscript enhanced color\n" -|- appendTo scriptfile runIO$ echo ("set output \""++filebase++".eps\"\n") -|- appendTo scriptfile runIO$ echo ("set title \"Benchmark: "++ map scrub filebase ++ ", speedup relative to serial time " ++ show (round_2digits $ basetime * max_norm) ++" seconds "++ -- "for input size " ++ show (round_2digits max_norm) (if default_norms then "" else "for input size " ++ show (round max_norm)) --if is_norm then "normalized to work unit" --if default_norms then "" else " per unit benchmark input" ++"\"\n") -|- appendTo scriptfile runIO$ echo ("set xlabel \"Number of Threads\"\n") -|- appendTo scriptfile runIO$ echo ("set ylabel \"Parallel Speedup\"\n") -|- appendTo scriptfile runIO$ echo ("set xrange [1:]\n") -|- appendTo scriptfile runIO$ echo ("set key left top\n") -|- appendTo scriptfile runIO$ echo ("plot \\\n") -|- appendTo scriptfile -- In this loop lets do the errorbars: forM_ (zip [1..] lines) $ \(i,points) -> do let datfile = root ++ filebase ++ show i ++".dat" runIO$ echo (" \""++ basename datfile ++"\" using 1:2:3:4 with errorbars lt "++ show (line_types !! i) ++" title \"\", \\\n") -|- appendTo scriptfile -- Now a second loop for the lines themselves and to dump the actual data to the .dat file: forM_ (zip [1..] lines) $ \(i,points) -> do let datfile = root ++ filebase ++ show i ++".dat" let schd = sched$ head points -- should be the same across all point let var = variant$ head points -- should be the same across all point let nickname = var ++"/"++ schd runIO$ echo ("# Data for variant "++ nickname ++"\n") -|- appendTo datfile forM_ points $ \x -> do -- Here we print a line of output: runIO$ echo (show (fromIntegral (threads x)) ++" "++ show (basetime / (tmed x / normfactor x)) ++" "++ show (basetime / (tmax x / normfactor x)) ++" "++ show (basetime / (tmin x / normfactor x)) ++" \n") -|- appendTo datfile let comma = if i == length lines then "" else ",\\" runIO$ echo (" \""++ basename datfile ++ "\" using 1:2 with lines linewidth "++linewidth++" lt "++ show (line_types !! i) ++" title \""++nickname++"\" "++comma++"\n") -|- appendTo scriptfile --putStrLn$ "Finally, running gnuplot..." --runIO$ "(cd "++root++"; gnuplot "++basename scriptfile++")" --runIO$ "(cd "++root++"; ps2pdf "++ filebase ++".eps )" --plot_benchmark2 root ls = putStrLn$ "plot_benchmark2: Unexpected input, list len: "++ show (length ls) plot_benchmark2 root [io] = plot_benchmark2 root [io,[]] isMatch rg str = case matchRegex rg str of { Nothing -> False; _ -> True } main = do args <- getArgs let file = case args of [f] -> f [] -> "results.dat" dat <- run$ catFrom [file] -|- remComments "#" let parsed = map (parse . filter (not . (== "")) . splitRegex (mkRegex "[ \t]+")) (filter (not . isMatch (mkRegex "ERR")) $ filter (not . isMatch (mkRegex "TIMEOUT")) $ filter (not . null) dat) let organized = organize_data$ -- filter ((`elem` ["io","pure"]) . variant) parsed parsed putStrLn$ "Parsed "++show (length parsed)++" lines containing data." print organized let root = "./" ++ dropExtension file ++ "_graphs/" -- For hygiene, completely anhilate output directory: system$ "rm -rf " ++root ++"/" system$ "mkdir -p "++root bests <- forM organized $ \ perbenchmark -> do best <- plot_benchmark2 root perbenchmark forM_ perbenchmark $ \ pervariant -> forM_ pervariant $ \ persched -> do let mins = map tmin persched let pairs = (zip (map (fromIntegral . threads) persched) mins) --putStrLn$ show pairs --plot Graphics.Gnuplot.Terminal.X11.cons (path pairs) --System.exitWith ExitSuccess --plot x11 (path pairs) return () return best putStrLn$ "Now generating final plot files...\n\n" let summarize hnd = do hPutStrLn hnd $ "# Benchmark, scheduler, best #threads, best median time, max parallel speedup: " hPutStrLn hnd $ "# Summary for " ++ file let pads n s = take (n - length s) $ repeat ' ' let pad n x = " " ++ (pads n (show x)) forM_ bests $ \ (Best(name, variant, sched, threads, best, speed)) -> hPutStrLn hnd$ " "++ name++ (pad 25 name) ++ show variant++ (pad 10 variant)++ show sched++ (pad 5 sched) ++ show threads++ (pad 5 threads)++ show best ++ (pad 15 best) ++ show speed hPutStrLn hnd$ "\n\n" putStrLn$ "Done." summarize stdout withFile (dropExtension file `addExtension` "summary") WriteMode $ summarize monad-par-0.1.0.3/examples/PortablePixmap.lhs0000644000000000000000000001020711673650535017205 0ustar0000000000000000 \begin{verbatim} ppm(5) FILE FORMATS ppm(5) NAME ppm - portable pixmap file format DESCRIPTION The portable pixmap format is a lowest common denominator color image file format. The definition is as follows: - A "magic number" for identifying the file type. A ppm file's magic number is the two characters "P3". - Whitespace (blanks, TABs, CRs, LFs). - A width, formatted as ASCII characters in decimal. - Whitespace. - A height, again in ASCII decimal. - Whitespace. - The maximum color-component value, again in ASCII decimal. - Whitespace. - Width * height pixels, each three ASCII decimal values between 0 and the specified maximum value, starting at the top-left corner of the pixmap, proceding in normal English reading order. The three values for each pixel represent red, green, and blue, respectively; a value of 0 means that color is off, and the maximum value means that color is maxxed out. - Characters from a "#" to the next end-of-line are ignored (comments). - No line should be longer than 70 characters. Here is an example of a small pixmap in this format: P3 # feep.ppm 4 4 15 0 0 0 0 0 0 0 0 0 15 0 15 0 0 0 0 15 7 0 0 0 0 0 0 0 0 0 0 0 0 0 15 7 0 0 0 15 0 15 0 0 0 0 0 0 0 0 0 Programs that read this format should be as lenient as pos- sible, accepting anything that looks remotely like a pixmap. There is also a variant on the format, available by setting the RAWBITS option at compile time. This variant is Sun Release 4.1 Last change: 15 September 1990 1 ppm(5) FILE FORMATS ppm(5) different in the following ways: - The "magic number" is "P6" instead of "P3". - The pixel values are stored as plain bytes, instead of ASCII decimal. - Whitespace is not allowed in the pixels area, and only a single character of whitespace (typically a newline) is allowed after the maxval. - The files are smaller and many times faster to read and write. Note that this raw format can only be used for maxvals less than or equal to 255. If you use the ppm library and try to write a file with a larger maxval, it will automatically fall back on the slower but more general plain format. SEE ALSO giftoppm(1), gouldtoppm(1), ilbmtoppm(1), imgtoppm(1), mtvtoppm(1), pcxtoppm(1), pgmtoppm(1), pi1toppm(1), pict- toppm(1), qrttoppm(1), rawtoppm(1), rgb3toppm(1), spctoppm(1), sputoppm(1), tgatoppm(1), ximtoppm(1), xpmtoppm(1), ppmtogif(1), ppmtoicr(1), ppmtoilbm(1), ppmtopcx(1), ppmtopgm(1), ppmtopi1(1), ppmtopict(1), ppmtops(1), ppmtopuzz(1), ppmtorgb3(1), ppmtouil(1), ppmtoxpm(1), ppmhist(1), ppmmake(1), ppmpat(1), ppmquant(1), ppmquantall(1), ppmrelief(1), pnm(5), pgm(5), pbm(5) AUTHOR Copyright (C) 1989, 1991 by Jef Poskanzer. Sun Release 4.1 Last change: 15 September 1990 2 \end{verbatim} \begin{code} module PortablePixmap where data PixMap = Pixmap Integer Integer Int [(Int,Int,Int)] createPixmap::Integer -> Integer -> Int -> [(Int,Int,Int)] -> PixMap createPixmap width height max colours = Pixmap width height max colours instance Show PixMap where showsPrec prec (Pixmap x y z rgbs) = showHeader x y z . showRGB rgbs showHeader::Integer -> Integer -> Int -> ShowS showHeader x y z = showString "P6\n" . showBanner . shows x . showReturn . shows y . showReturn . shows z . showReturn showRGB::[(Int,Int,Int)] -> ShowS showRGB [] = id showRGB ((r,g,b):rest) = showChar (toEnum r) . showChar (toEnum g) . showChar (toEnum b) . showRGB rest showSpace = showChar ' ' showReturn = showChar '\n' showBanner = showString "# Portable pixmap created by Haskell Program :\n" . showString "#\tPortablePixmap.lhs (Jon.Hill 28/5/92)\n" \end{code} monad-par-0.1.0.3/examples/primes.hs0000644000000000000000000000251411673650535015403 0ustar0000000000000000 -- This is a simplistic benchmark but is included just for comparison with Haskell CnC -- Author: Ryan Newton import System.Environment import Control.Monad.Par import Control.Monad.Par.AList as A import Debug.Trace -- First a naive serial test for primality: isPrime :: Int -> Bool isPrime 2 = True isPrime n = (prmlp 3 == n) where prmlp :: Int -> Int prmlp i = if (rem n i) == 0 then i else prmlp (i + 2) ---------------------------------------- -- Next, a CnC program that calls the serial test in parallel. primes :: Int -> Int -> Par (AList Int) primes start end = -- parMapReduceRange (InclusiveRange start end) parMapReduceRangeThresh 100 (InclusiveRange start end) (\n -> if -- TEMP: Need a strided range here: (rem n 2 /= 0) && isPrime n then return$ singleton n else return$ empty) (\ a b -> return (append a b)) empty -- This version never builds up the list, it simply counts: -- countprimes :: Int -> Int -> Par Int -- countprimes start end = main = do args <- getArgs let size = case args of [] -> 1000 -- Should output 168 [n] -> (read n) ls = runPar $ primes 3 size -- putStrLn (show ls) putStrLn (show (1 + A.length ls)) -- Add one to include '2'. return () monad-par-0.1.0.3/examples/queens.hs0000644000000000000000000000145211673650535015404 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} import System.Environment import Control.Monad import Control.Seq import Control.Monad.Par -- import Control.Monad.Par_Strawman nqueens :: Int -> Par [[Int]] nqueens nq = step 0 [] where threshold = 5 step :: Int -> [Int] -> Par [[Int]] step !n b | n >= threshold = return (iterate gen [b] !! (nq - n)) | otherwise = do rs <- parMapM (step (n+1)) (gen [b]) return (concat rs) safe :: Int -> Int -> [Int] -> Bool safe x d [] = True safe x d (q:l) = x /= q && x /= q+d && x /= q-d && safe x (d+1) l gen :: [[Int]] -> [[Int]] gen bs = [ (q:b) | b <- bs, q <- [1..nq], safe q 1 b ] main = do args <- fmap (fmap read) getArgs let n = case args of [] -> 8; [n] -> n print (length (runPar (nqueens n))) monad-par-0.1.0.3/examples/run_tests.sh0000755000000000000000000000046511673650535016140 0ustar0000000000000000#!/bin/bash # set -e # set -o errexit for file in "$@"; do echo Running test $file ./$file &> $file".out" # echo "Return code: $?" code=$? if [ "$code" != 0 ]; then echo echo " ERROR, output was:" cat $file".out" echo echo " ERROR: exit code $code" exit $code fi done monad-par-0.1.0.3/examples/timeout.sh0000755000000000000000000000514211673650535015575 0ustar0000000000000000#!/bin/bash # # The Bash shell script executes a command with a time-out. # Upon time-out expiration SIGTERM (15) is sent to the process. If the signal # is blocked, then the subsequent SIGKILL (9) terminates it. # # Based on the Bash documentation example. # Hello Chet, # please find attached a "little easier" :-) to comprehend # time-out example. If you find it suitable, feel free to include # anywhere: the very same logic as in the original examples/scripts, a # little more transparent implementation to my taste. # # Dmitry V Golovashkin scriptName="${0##*/}" declare -i DEFAULT_TIMEOUT=9 declare -i DEFAULT_INTERVAL=1 declare -i DEFAULT_DELAY=1 # Timeout. declare -i timeout=DEFAULT_TIMEOUT # Interval between checks if the process is still alive. declare -i interval=DEFAULT_INTERVAL # Delay between posting the SIGTERM signal and destroying the process by SIGKILL. declare -i delay=DEFAULT_DELAY function printUsage() { cat < 0)); do sleep $interval kill -0 $$ || exit 0 ((t -= interval)) done # Be nice, post SIGTERM first. # The 'exit 0' below will be executed if any preceeding command fails. kill -s SIGTERM $$ && kill -0 $$ || exit 0 sleep $delay kill -s SIGKILL $$ ) 2> /dev/null & exec "$@" monad-par-0.1.0.3/examples/matmult/0000755000000000000000000000000011673650535015231 5ustar0000000000000000monad-par-0.1.0.3/examples/matmult/ListAux.hs0000644000000000000000000000205611673650535017161 0ustar0000000000000000module ListAux where import Data.List -- splitting into n parts, and its inverse: splitIntoN :: Int -> [a] -> [[a]] splitIntoN n xs = takeIter parts xs where l = length xs parts = zipWith (+) ((replicate (l `mod` n) 1) ++ repeat 0) (replicate n (l `div` n)) takeIter :: [Int] -> [a] -> [[a]] takeIter [] [] = [] takeIter [] _ = error "elements left over" takeIter (t:ts) xs = hs : takeIter ts rest where (hs,rest) = splitAt t xs unSplit :: [[a]] -> [a] unSplit = concat -- splitting into parts of same size. Inverse is concat again. splitAtN :: Int -> [a] -> [[a]] splitAtN n [] = [] splitAtN n xs = ys : splitAtN n zs where (ys,zs) = splitAt n xs ---------------------------------------- -- splitting round-robin until list runs empty, and its inverse: unshuffle :: Int -> [a] -> [[a]] unshuffle n xs = [takeEach n (drop i xs) | i <- [0..n-1]] where takeEach n [] = [] takeEach n (x:xs) = x : takeEach n (drop (n-1) xs) -- inverse to unshuffle shuffle :: [[a]] -> [a] shuffle = concat . transpose monad-par-0.1.0.3/examples/matmult/Makefile0000644000000000000000000000022411673650535016667 0ustar0000000000000000include ../common.mk matmult.exe : $(wildcard *.hs) ../../Control/Monad/Par.hs $(GHC) -O2 -cpp --make -i../.. MatMult.hs -o $@ -threaded -rtsopts monad-par-0.1.0.3/examples/matmult/MatMult.hs0000644000000000000000000001610711673650535017155 0ustar0000000000000000{-# OPTIONS -cpp #-} {-# LANGUAGE BangPatterns #-} {- Matrix multiplication using a torus (gentleman algorithm) -- FR10 -- -} {- RL/JB ParCo2005: eliminate result communication (Maybe-Type) JB PhD2008: adapt for simple PhD skeleton tests JB MSR07/2008: modified to use all available toroid skeletons. JB MSR07/2008: derived a straight-forward GpH program using identical helpers and strategies JB optimised prodEscalar JB for ghc-6.9: replaced Control.Parallel.Strategies by a workaround (reexporting what should work) -} module Main(main) where import System.Environment import Data.List hiding (foldl', foldl1') import ListAux import Control.DeepSeq import Control.Monad.Par ------------------------------------- type Vector = [Int] type Matrix = [Vector] -- main computation, different versions: mult :: Int -> Matrix -> Matrix -> Int -> [[Maybe Matrix]] mult 0 m1 m2 _ = #ifdef OUTPUT [[Just $ multMatricesTr m1 (transpose m2)]] #else rnf (multMatricesTr m1 (transpose m2)) `seq` [[Nothing]] #endif mult v m1 m2 c = results where results :: [[Maybe Matrix]] #ifdef OUTPUT results = [[Just computed]] #else results = (rnf computed `seq` [[Nothing]]) #endif computed = multMatricesTr m1 m2Tr -- strats' = strats ++ repeat undef m2Tr = transpose m2 prMM' :: (Matrix,Matrix) -> Matrix prMM' (c,mt) = [[prVV f c | c <- mt]|f <-c] prVV :: Vector -> Vector -> Int prVV f c = sum (zipWith (*) f c) shiftRight c [] = [] shiftRight c (xs:xss) = (xs2++xs1):shiftRight (c-1) xss where (xs1,xs2) = splitAt c xs shiftDown c xss = transpose (shiftRight c (transpose xss)) join2 :: Matrix -> Matrix -> Matrix join2 xs ys = zipWith (++) xs ys join :: [Matrix] -> Matrix join xss = foldr join2 (repeat []) xss splitIntoClusters :: Int -> Matrix -> [[Matrix]] splitIntoClusters c m | c < 1 = splitIntoClusters 1 m splitIntoClusters c m1 = mss where bh = kPartition (length m1) c bhsplit [] [] = [] bhsplit [] _ = error "some elements left over" bhsplit (t:ts) xs = hs : (bhsplit ts rest) where (hs,rest) = splitAt t xs ms = bhsplit bh m1 -- blocks of rows mss = map (colsplit bh) ms colsplit [] _ = [] colsplit (t:ts) rs | head rs == [] = [] | otherwise = (cab:colsplit ts resto) where (cab,resto) = unzip (map (splitAt t) rs) -- mss = map (repartir (length m1 `div` c)) ms -- repartir c xs -- | head xs == [] = [] -- | otherwise = (cab:repartir c resto) -- where (cab,resto) = unzip (map (splitAt c) xs) -- helper for splitIntoClusters (formerly bresenham) kPartition :: Int -> Int -> [Int] kPartition n k = zipWith (+) ((replicate (n `mod` k) 1) ++ repeat 0) (replicate k (n `div` k)) mult' :: Int -> Int -> ((Matrix,Matrix),[Matrix],[Matrix]) -> (Maybe Matrix,[Matrix],[Matrix]) mult' nc nr ((sm1,sm2),sm1s,sm2s) #ifdef OUTPUT = (Just result,toRight,toDown) #else = (rnf result `seq` Nothing ,toRight,toDown) #endif where toRight = take (nc-1) (sm1:sm1s) toDown = take (nr-1) (sm2':sm2s) sm2' = transpose sm2 sms = zipWith multMatricesTr (sm1:sm1s) (sm2':sm2s) result = foldl1' addMatrices sms -- foldr1: not enough demand?? addMatrices :: Matrix -> Matrix -> Matrix addMatrices m1 m2 = zipWith addVectors m1 m2 where addVectors :: Vector -> Vector -> Vector addVectors v1 v2 = zipWith (+) v1 v2 -- Assumes the second matrix has already been transposed multMatricesTr :: Matrix -> Matrix -> Matrix multMatricesTr m1 m2 = runPar $ parMap (\row -> [prodEscalar2 row col | col <- m2]) m1 -- JB 2008: a lot faster, directly consuming lists, and tail-recursive (optimised with -O2) prodEscalar2JB :: Vector -> Vector -> Int prodEscalar2JB v1 v2 = addProd v1 v2 0 where addProd :: Vector -> Vector -> Int -> Int addProd (v:vs) (w:ws) acc = addProd vs ws (acc + v*w) addProd [] [] n = n addProd _ _ _ = error "addProd: length does not match" -- JB 2008: identical when using ghc-6.8.3, avoids bug in ghc-HEAD. Version suggested by SM prodEscalar2 :: Vector -> Vector -> Int prodEscalar2 v1 v2 = addProd v1 v2 0 addProd :: Vector -> Vector -> Int -> Int addProd (v:vs) (w:ws) !acc = addProd vs ws (acc + v*w) addProd _ _ !n = n prodEscalar :: Vector -> Vector -> Int prodEscalar v1 v2 = sum (zipWith (*) v1 v2) ------- foldl, strict in head element foldl1' :: NFData a => (a->a->a) -> [a] -> a foldl1' f (x:xs) = foldl' f x xs foldl' :: NFData a => (a -> b -> a) -> a -> [b] -> a foldl' f a [] = a foldl' f a (x:xs) = -- whnf, not enough( (foldl' f) $! (f a x)) xs let first = f a x in rnf first `seq` foldl' f first xs usage :: String -> String usage name = "Cannon's algorithm: Usage:\n\t "++ name ++ " \n" ++ "Version selects from " -- ++ show (zip [0..] names) main = do args <- getArgs let l = length args if l == 0 then do n <- getProgName putStrLn (usage n) putStrLn "\n *** defaults: size 100, seq. computation ***" else return () --putStrLn "Cannon's algorithm" let size = if null args then 100 else read (head args) opt = if length args < 2 then 0 else read (args!!1) chunk = if length args < 3 then 1 else read (args!!2) a = "Matrices of size " ++ show size ++ -- " with skeleton " ++ ((names++repeat "UNDEF")!!opt) ++ " using chunk parameter " ++ show chunk ++ "\n" res = mult opt (mA size) (mB size) chunk b = multMatricesTr (mA size) (transpose (mB size)) -- putStrLn a #ifdef OUTPUT putStrLn "Output wanted, checking result for correctness..." let computed = map (map fromJust) res computed' = concat (map join computed) printMat computed' if (b == computed') then putStrLn "Correct!" else do putStrLn "WRONG RESULT! Should be" printMat b #else -- putStrLn "No Output, matrix stays distributed." putStrLn (show res) #endif m1 size = replicate size [1..size] m2 size = listToListList size [1..size*size] mA size = if size <= 4000 then m1 size else listToListList size (concat (take 20 (repeat [1..(size*size `div` 20)]))) mB size = if size <= 4000 then m1 size else listToListList size (concat (take 20 (repeat [0,2.. ((size*size) `div` 20)-2]))) listToListList c m | length m <= c = [m] | otherwise = c1 : listToListList c resto where (c1,resto) = splitAt c m printMat :: Matrix -> IO () printMat m = putStrLn ("Matrix: " ++ (show (length (head m))) ++ " x " ++ (show $ length m) ++ "\n" ++ (showMat m)) -- instance Show a => Show (Matrix a) where showMat m_ = "<<" ++ unlines (map (concatMap (\ x -> show x ++ " ")) m_) ++ ">>" fromJust :: Maybe a -> a fromJust (Just x) = x fromJust Nothing = error "fromJust" monad-par-0.1.0.3/examples/matmult/matmult.stdout0000644000000000000000000000001411673650535020153 0ustar0000000000000000[[Nothing]] monad-par-0.1.0.3/examples/minimax/0000755000000000000000000000000011673650535015210 5ustar0000000000000000monad-par-0.1.0.3/examples/minimax/Board.hs0000644000000000000000000000613111673650535016574 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} module Board where import Wins import Data.List import Control.Parallel import Control.Parallel.Strategies import Control.DeepSeq boardDim = 4 type Board = [Row] type Row = [Piece] data Piece = X | O | Empty deriving (Eq,Show) isEmpty Empty = True isEmpty _ = False showBoard :: Board -> String showBoard board = intercalate "\n--------\n" (map showRow board) ++ "\n" where showRow r = intercalate "|" (map showPiece r) showPiece :: Piece -> String showPiece X = "X" showPiece O = "O" showPiece Empty = " " placePiece :: Piece -> Board -> (Int,Int) -> Board placePiece new board pos = [[ if (x,y) == pos then new else old | (x,old) <- zip [1..] row ] | (y,row) <- zip [1..] board ] empty :: (Int,Int) -> Board -> Bool empty (x,y) board = isEmpty ((board !! (y-1)) !! (x-1)) fullBoard b = all (not.isEmpty) (concat b) newPositions :: Piece -> Board -> [Board] newPositions piece board = -- [ placePiece piece board (x,y) | (x,y) <- empties board ] goRows piece id board goRows p rowsL [] = [] goRows p rowsL (row:rowsR) = goRow p rowsL id row rowsR ++ goRows p (rowsL . (row:)) rowsR goRow p rowsL psL [] rowsR = [] goRow p rowsL psL (Empty:psR) rowsR = (rowsL $ (psL $ (p:psR)) : rowsR) : goRow p rowsL (psL . (Empty:)) psR rowsR goRow p rowsL psL (p':psR) rowsR = goRow p rowsL (psL . (p':)) psR rowsR empties board = [ (x,y) | (y,row) <- zip [1..] board, (x,Empty) <- zip [1..] row ] initialBoard :: Board initialBoard = replicate boardDim (replicate boardDim Empty) data Evaluation = OWin | Score {-# UNPACK #-}!Int | XWin -- higher scores denote a board in X's favour deriving (Show,Eq) instance NFData Evaluation where rnf x = x `seq` () maxE :: Evaluation -> Evaluation -> Evaluation maxE XWin _ = XWin maxE _ XWin = XWin maxE b OWin = b maxE OWin b = b maxE a@(Score x) b@(Score y) | x>y = a | otherwise = b minE :: Evaluation -> Evaluation -> Evaluation minE OWin _ = OWin minE _ OWin = OWin minE b XWin = b minE XWin b = b minE a@(Score x) b@(Score y) | x Evaluation static board = interpret 0 (score board) interpret :: Int -> [Evaluation] -> Evaluation interpret x [] = (Score x) interpret x (Score y:l) = interpret (x+y) l interpret x (XWin:l) = XWin interpret x (OWin:l) = OWin scorePiece X = 1 scorePiece O = -1 scorePiece Empty = 0 scoreString !n [] = n scoreString !n (X:ps) = scoreString (n+1) ps scoreString !n (O:ps) = scoreString (n-1) ps scoreString !n (Empty:ps) = scoreString n ps score :: Board -> [Evaluation] score board = [ eval (scoreString 0 row) | row <- board ] ++ [ eval (scoreString 0 col) | col <- transpose board ] ++ [ eval (scoreString 0 (zipWith (!!) board [0..])), eval (scoreString 0 (zipWith (!!) board [boardDim-1,boardDim-2 ..])) ] {- #if 0 -- This looks very much like a zipWith f to me map2 :: (a -> b -> c) -> [a] -> [b] -> [c] map2 f [] x = [] map2 f x [] = [] map2 f (x:xs) (y:ys) = f x y:map2 f xs ys #endif -} monad-par-0.1.0.3/examples/minimax/Game.hs0000644000000000000000000000413311673650535016416 0ustar0000000000000000-- Time-stamp: <2011-02-12 21:11:31 simonmar> ----------------------------------------------------------------------------- module Game where import Board import Tree import Control.Parallel import Control.Parallel.Strategies hiding (parMap) import Debug.Trace import Control.Monad.Par type Player = Evaluation -> Evaluation -> Evaluation type Move = (Board,Evaluation) alternate :: Int -> Piece -> Player -> Player -> Board -> [Move] alternate _ _ _ _ b | fullBoard b = [] alternate _ _ _ _ b | static b == XWin = [] alternate _ _ _ _ b | static b == OWin = [] alternate depth player f g board = move : alternate depth opponent g f board' where move@(board',eval) = best f possibles scores scores = runPar $ parMapM (bestMove depth opponent g f) possibles possibles = newPositions player board opponent = opposite player opposite :: Piece -> Piece opposite X = O opposite O = X best :: Player -> [Board] -> [Evaluation] -> Move best f (b:bs) (s:ss) = best' b s bs ss where best' b s [] [] = (b,s) best' b s (b':bs) (s':ss) | s==(f s s') = best' b s bs ss | otherwise = best' b' s' bs ss showMove :: Move -> String showMove (b,e) = show e ++ "\n" ++ showBoard b bestMove :: Int -> Piece -> Player -> Player -> Board -> Par Evaluation bestMove depth p f g board = do let tree = cropTree $ mapTree static $ prune depth $ searchTree p $ board parMise 2 f g tree cropTree :: (Tree Evaluation) -> (Tree Evaluation) cropTree (Branch a []) = (Branch a []) cropTree (Branch (Score x) l) = Branch (Score x) (map cropTree l) cropTree (Branch x l) = Branch x [] searchTree :: Piece -> Board -> (Tree Board) searchTree p board = repTree (newPositions p) (newPositions (opposite p)) board mise :: Player -> Player -> (Tree Evaluation) -> Evaluation mise f g (Branch a []) = a mise f g (Branch _ l) = foldr f (g OWin XWin) (map (mise g f) l) parMise :: Int -> Player -> Player -> (Tree Evaluation) -> Par Evaluation parMise 0 f g t = return (mise f g t) parMise n f g (Branch a []) = return a parMise n f g (Branch _ l) = do es <- parMapM (parMise (n-1) g f) l return (foldr f (g OWin XWin) es) monad-par-0.1.0.3/examples/minimax/Main.hs0000644000000000000000000000070611673650535016433 0ustar0000000000000000-- Time-stamp: <2009-05-06 13:54:34 simonmar> ----------------------------------------------------------------------------- module Main where import System.Environment import Prog import Board import System.Random main = do args <- getArgs let [n, depth] = case args of [n, depth] -> [read n, read depth] _ -> [10,10] setStdGen (mkStdGen 99999) b <- randomBoard n putStrLn $ showBoard b putStrLn $ solve depth b monad-par-0.1.0.3/examples/minimax/Makefile0000644000000000000000000000022111673650535016643 0ustar0000000000000000include ../common.mk minimax.exe : $(wildcard *.hs) ../../Control/Monad/Par.hs $(GHC) -O2 -cpp --make -i../.. Main.hs -o $@ -threaded -rtsopts monad-par-0.1.0.3/examples/minimax/minimax.stdout0000644000000000000000000000020111673650535020107 0ustar0000000000000000 |X| | -------- | | | -------- |O| | -------- O| | |X Score 2 X|X| | -------- | | | -------- |O| | -------- O| | |X monad-par-0.1.0.3/examples/minimax/Prog.hs0000644000000000000000000000234411673650535016456 0ustar0000000000000000-- Time-stamp: <2009-05-06 13:55:20 simonmar> ----------------------------------------------------------------------------- module Prog(prog,randomBoard,solve) where import Board import Wins import Game import Tree import System.Random import Data.List -- First arg decaffinates game prog :: Int -> String prog decaf = showMove (head game) --"OXO\n" ++ --concat (map showMove game) where game = if decaf == 0 then error "Decaffination error\n" else alternate decaf X maxE minE testBoard -- X to play: find the best move solve :: Int -> Board -> String solve depth board = unlines . map showMove . take 1 . alternate depth X maxE minE $ board testBoard = [[Empty,O,Empty,Empty],[Empty,X,Empty,Empty],[Empty,Empty,Empty,Empty],[Empty,Empty,Empty,Empty]] randomBoard :: Int -> IO Board randomBoard moves = do g <- newStdGen let (g1,g2) = split g xs = randomRs (1,boardDim) g1 ys = randomRs (1,boardDim) g2 let play 0 _ _ board = board play n (pos:poss) (p:ps) board | not (empty pos board) = play n poss (p:ps) board | otherwise = play (n-1) poss ps (placePiece p board pos) return $ play moves (zip xs ys) (cycle [X,O]) initialBoard monad-par-0.1.0.3/examples/minimax/Tree.hs0000644000000000000000000000163211673650535016445 0ustar0000000000000000{-# LANGUAGE CPP #-} module Tree where import Control.Parallel import Control.Parallel.Strategies data Tree a = Branch a [Tree a] deriving Show repTree :: (a->[a]) -> (a->[a])-> a -> (Tree a) repTree f g a = Branch a (map (repTree g f) (f a)) #define SEQ #ifndef SEQ mapTree :: (a -> b) -> Tree a -> Tree b mapTree f (Branch a l) = fa `par` Branch fa (map (mapTree f) l `using` myParList) where fa = f a #else {- SEQ -} mapTree :: (a -> b) -> (Tree a) -> (Tree b) mapTree f (Branch a l) = Branch (f a) (map (mapTree f) l) #endif myParList [] = () myParList (x:xs) = x `par` myParList xs mySeqList [] = () mySeqList (x:xs) = x `seq` mySeqList xs parTree :: Int -> Tree a -> () parTree 0 (Branch a xs) = () parTree n (Branch a xs) = a `par` mySeqList (map (parTree (n-1)) xs) prune :: Int -> (Tree a) -> (Tree a) prune 0 (Branch a l) = Branch a [] prune n (Branch a l) = Branch a (map (prune (n-1)) l) monad-par-0.1.0.3/examples/minimax/Wins.hs0000644000000000000000000000107611673650535016470 0ustar0000000000000000module Wins where type Win = [[Int]] wins :: [Win] wins = [win1,win2,win3,win4,win5,win6,win7,win8] win1,win2,win3,win4,win5,win6,win7,win8 :: Win win1 = [[1,1,1], [0,0,0], [0,0,0]] win2 = [[0,0,0], [1,1,1], [0,0,0]] win3 = [[0,0,0], [0,0,0], [1,1,1]] win4 = [[1,0,0], [1,0,0], [1,0,0]] win5 = [[0,1,0], [0,1,0], [0,1,0]] win6 = [[0,0,1], [0,0,1], [0,0,1]] win7 = [[1,0,0], [0,1,0], [0,0,1]] win8 = [[0,0,1], [0,1,0], [1,0,0]] monad-par-0.1.0.3/examples/partree/0000755000000000000000000000000011673650535015210 5ustar0000000000000000monad-par-0.1.0.3/examples/partree/Makefile0000644000000000000000000000022411673650535016646 0ustar0000000000000000include ../common.mk partree.exe : $(wildcard *.hs) ../../Control/Monad/Par.hs $(GHC) -O2 -cpp --make -i../.. partree.hs -o $@ -threaded -rtsopts monad-par-0.1.0.3/examples/partree/partree.hs0000644000000000000000000000213211673650535017204 0ustar0000000000000000-- -*- haskell -*- -- partree -- parallel map over a tree ----------------------------------------------------------------------------- module Main where import System.Environment(getArgs) import Control.Parallel import Tree main = do [arg1,arg2] <- getArgs let n = read arg1 :: Int -- size of tree in nodes c = read arg2 :: Int -- work per node res = partree c n putStrLn ("partree " ++ unwords [arg1,arg2] ++ " = " ++ show res) -- worker function to be mapped over the tree; heavily allocating! bar :: Int -> Int -> Int bar c n = tree_fold (\x y -> (x+y) `quot` 2) 0 t where forest = [ let l = take n (iterate (+i) i) in list2tree l | i <- [1..c + n `mod` 15] ] t = foldl1 (^:) forest -- generate a tree with n nodes; -- then map and fold 2 functions over it partree :: Int -> Int -> Int partree c n = (force_tree t) `seq` (tree_fold max 0 t) where t = par_tree_map (bar c) (list2tree [1..n]) monad-par-0.1.0.3/examples/partree/Tree.hs0000644000000000000000000001051611673650535016446 0ustar0000000000000000-- -*- haskell -*- -- -- ADT of a binary tree (values only in leaves). -- Parallel functions use par and seq directly. -- --------------------------------------------------------------------------- module Tree(Tree, list2tree, tree2list, (^:), tree_map, tree_fold, depth, create_forest, force_tree, par_tree_map) where import Control.Parallel import Control.Parallel.Strategies import Control.Monad.Par infixl 2 ^: data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Eq, Read, Show) tree_map :: (Integral a, Integral b) => (a -> b) -> Tree a -> Tree b tree_map f (Leaf x) = Leaf (f x) tree_map f (Node left right) = Node (tree_map f left) (tree_map f right) par_tree_map :: (Integral a, Integral b) => (a -> b) -> Tree a -> Tree b par_tree_map f t = runPar $ par_tree_map' f t par_tree_map' :: (Integral a, Integral b) => (a -> b) -> Tree a -> Par (Tree b) par_tree_map' f (Leaf x) = return $ Leaf (f x) par_tree_map' f (Node left right) = do l' <- spawn_ $ par_tree_map' f left r <- par_tree_map' f right l <- get l' return (Node l r) -- force evaluation of tree (could use Strategies module instead!) force_tree :: (Integral a) => Tree a -> () force_tree t@(Leaf x) = x `seq` () force_tree t@(Node left right) = (force_tree left) `seq` (force_tree right) `seq` () -- just would you'd expect tree_fold :: (Integral a) => (a -> a -> a) -> a -> Tree a -> a tree_fold o z (Leaf x) = z `o` x tree_fold o z (Node left right) = tree_fold o z' right where z' = tree_fold o z left list2tree :: (Integral a) => [a] -> Tree a list2tree [] = error "list2tree: empty list" list2tree [x] = Leaf x list2tree l = Node (list2tree left) (list2tree right) where (left,right) = splitAt ((length l) `div` 2 ) l tree2list :: (Integral a) => Tree a -> [a] tree2list (Leaf x) = [x] tree2list (Node left right) = tree2list left ++ tree2list right -- combine 2 trees (^:) :: (Integral a) => Tree a -> Tree a -> Tree a t1 ^: t2 = Node t1 t2 depth :: Tree a -> Int depth (Leaf _) = 0 depth (Node left right) = max (depth left) (depth right) + 1 -- The following functions are useful for heavily heap allocating test fcts create_forest :: (Integral a) => Tree a -> [Tree a] create_forest (Leaf x) = [ (Leaf y) | y <- [2..x], gcd x y == 1 ] create_forest (Node left right) = [ (Node left' right') | left' <- create_forest left, right' <- create_forest right] {- On a Harpertown Windows machine with 4 cores (8 threads), using Haskell Platform 2011.2.0.0. Note the CPU utilization rates (elapsed time * num_of_threads/CPU time) range between 70% and 77% when -N > 1. Compare that with Strategies, which has a higher CPU utilization rate (> 95%) and a smaller user time for -N > 1. E:\cchen15\icfp\partree-mp>timeit partree.exe 1000 10 +RTS -N1 partree 1000 10 = 23712 Fri Mar 18 13:56:45 2011 Cmd: partree.exe 1000 10 +RTS -N1 Elapsed: 4.898 sec User 4.867 sec System 0.016 sec Total CPU 4.883 sec Peak WorkingSet Size: 7229440 Peak Pagefile Usage: 5836800 Page Fault Count: 1806 Peak Paged Pool usage: 85688 Peak NonPaged Pool usage: 5568 E:\cchen15\icfp\partree-mp>timeit partree.exe 1000 10 +RTS -N2 partree 1000 10 = 23712 Fri Mar 18 13:56:54 2011 Cmd: partree.exe 1000 10 +RTS -N2 Elapsed: 9.313 sec User 12.605 sec System 1.841 sec Total CPU 14.446 sec Peak WorkingSet Size: 12619776 Peak Pagefile Usage: 10133504 Page Fault Count: 3122 Peak Paged Pool usage: 85688 Peak NonPaged Pool usage: 6048 E:\cchen15\icfp\partree-mp>timeit partree.exe 1000 10 +RTS -N4 partree 1000 10 = 23712 Fri Mar 18 13:57:07 2011 Cmd: partree.exe 1000 10 +RTS -N4 Elapsed: 9.968 sec User 22.761 sec System 5.756 sec Total CPU 28.517 sec Peak WorkingSet Size: 13414400 Peak Pagefile Usage: 11677696 Page Fault Count: 3317 Peak Paged Pool usage: 85688 Peak NonPaged Pool usage: 6720 E:\cchen15\icfp\partree-mp>timeit partree.exe 1000 10 +RTS -N8 partree 1000 10 = 23712 Fri Mar 18 13:57:25 2011 Cmd: partree.exe 1000 10 +RTS -N8 Elapsed: 9.843 sec User 46.239 sec System 11.029 sec Total CPU 57.268 sec Peak WorkingSet Size: 14729216 Peak Pagefile Usage: 15175680 Page Fault Count: 3637 Peak Paged Pool usage: 85688 Peak NonPaged Pool usage: 7968 -}monad-par-0.1.0.3/examples/stream/0000755000000000000000000000000011673650535015041 5ustar0000000000000000monad-par-0.1.0.3/examples/stream/DEVLOG.txt0000644000000000000000000001351311673650535016565 0ustar0000000000000000 Notes on development of monad-par streaming framework and benchmarks. --------------------------------------------------------------------- [2011.03.19] Right now I'm seeing a weird behavior where when run -threaded it prints many of the messages before "new"' in the filter stage, but it doesn't print the messages after "put" in that same stage. This system allows self-stealing, correct? [2011.03.19] Quick measurements on wasp: --------------------------- Throughput of just countupWindowed + measureRate ... 2 threads is 8600 * 1024 = 8,806,400 = 8.8mHz. * With -N4 it uses ~234% CPU and gets sligthly confused, lowering throughput to 5800-6100 windows/sec from 8600 * It actually does work (e.g. doesn't deadlock) to run it with -N1 because there's only one kernel. The throughput is much more variable. From 4800-8500 win/sec. GC time is tiny in this case, 0.5%. --------------------------- Throughput of a single amap (+100) kernel = * Gets stuck waiting for first kernel -N1 as expected (and fills memory). * on -N2 it gets a rate of between 7937 and 8200 wins/sec but then it gets stuck after about 10 seconds. I don't fully understand this. The two threads should be enough for the two kernels right? Currently Par.hs forks a "replacement thread" to continue working on the queue when runParAsync returns. Therefore there should be enough haskell threads, even if there are only two Par scheduler threads. Those two par workers should be preemptable by the measureRate thread.... * on -N3 it works, and gives 6200-7100 wins/sec throughput. Uses ~245% CPU. Presumably the two par worker threads are hammering away and the measureRate one is less busy. But if I leave it running for a while it grew up to 79% (of 16gb) mem usage. Strange, -s claims the following. How can max resdency be so low!? 2,993,287,338,808 bytes allocated in the heap 17,134,304,736 bytes copied during GC 3,744,408 bytes maximum residency (152145 sample(s)) 1,870,240 bytes maximum slop 14 MB total memory in use (3 MB lost due to fragmentation) Generation 0: 4961153 collections, 4961152 parallel, 696.02s, 63.29s elapsed Generation 1: 152145 collections, 152145 parallel, 115.00s, 22.66s elapsed Parallel GC work balance: 1.08 (2102121164 / 1946757116, ideal 3) MUT time (elapsed) GC time (elapsed) Task 0 (worker) : 0.02s ( 0.00s) 0.00s ( 0.00s) Task 1 (worker) : 1927.40s (742.55s) 0.00s ( 0.00s) Task 2 (worker) : 1927.40s (742.55s) 0.00s ( 0.00s) Task 3 (worker) : 1928.34s (743.40s) 0.00s ( 0.00s) Task 4 (worker) : 1928.34s (743.40s) 0.00s ( 0.00s) Task 5 (bound) : 0.00s ( 0.00s) 0.11s ( 0.02s) Task 6 (worker) : 1928.34s (743.40s) 0.00s ( 0.00s) Task 7 (worker) : 1117.43s (743.40s) 810.91s ( 85.93s) SPARKS: 0 (0 converted, 0 pruned) INIT time 0.00s ( 0.00s elapsed) MUT time 1117.32s (743.40s elapsed) GC time 811.02s ( 85.95s elapsed) EXIT time 0.00s ( 0.01s elapsed) Total time 1928.34s (829.36s elapsed) %GC time 42.1% (10.4% elapsed) Alloc rate 2,678,988,417 bytes per MUT second Productivity 57.9% of total user, 134.7% of total elapsed gc_alloc_block_sync: 6092257 whitehole_spin: 0 gen[0].sync_large_objects: 190255 gen[1].sync_large_objects: 267 Oh, maybe because of the CArray's all the real storage is outside haskell's heap. There must be a memory leak in streamMap. Trying to fix it: (1) Factored out 'loop'. I need to try to ensure that no closure holds onto the original head of the stream. Wow! That lowered throughput a lot (-N3) and drove cpu usage up! 3500 wins/sec declining to 300. And it still leaks. The key difference seems to be passing the extra "fn" argument to loop. (2) Hmm... I went back to what I *thought* was the previous form above (that leaked). But now it's getting the good >6000 throughput and doesn't seem to be leaking. It gives memory back to the system and goes up and down in mem footprint. But now it uses 300% cpu. The only difference I can see is that I changed the module export decl. How could this matter if compiling into an executable? Nevertheless maybe this helps it inline.... Now I can run it for 10 min with minimal memory usage. -qa seems to help the variance on -N4, i.e. with more workers than kernels. --------------------------- Throughput of a single FFT kernel. * Oops, maybe this accounts for the difference above between leaking/non-leaking. The FFT version maintains a high >7000 wins/sec throughput. But it leaks memory. Maybe it's not really doing the FFT and is leaking suspensions? * Nope... I tried forcing the FFT by inspecting one element of the output. Still leaks. Well, the answer is simple. It just can't keep up with a source that has no backpressure. To confirm this hypothesis, I ran it with -N1 (with the new yielding source operator). NOPE, it still leaks. [2011.03.20] {Added disjoint_working_sets_pipeline} Ok, first try. Not only has this not demonstrated the benefit of pipeline parallelism, right now it isn't showing much of a speedup at all. Right now I'm running with default parameters (4 256 10 20000) Running with "-N4 -qa" I see large variance. Between 1.0 and 3.3 seconds. Seeing the same without -qa: Running without no extra runtime flags (no -qa): nothreads: 2.18s 1thread: 2.3s 4threads: 1-3 seconds. The big difference is running with N>1 it can spend a lot of time in GC (e.g. 84%!!). But I need to stop running on wasp for actual parallel speedup measurements -- I seem to have problems using wasp for this purpose. monad-par-0.1.0.3/examples/stream/disjoint_working_sets_pipeline.hs0000644000000000000000000002175611673650535023716 0ustar0000000000000000{-# LANGUAGE BangPatterns, ScopedTypeVariables, CPP #-} {-# OPTIONS_GHC -fwarn-unused-imports #-} -- The goal of this benchmark is to demonstrate kernels that have private -- state which has to be read from memory on each invocation. Further, -- the state forms the majority of the working set -- it's larger than -- the streaming input. -- In theory this means that keeping a kernel on one core and -- exploiting pipeline parallelism is better than following the data -- through the stream graph in a depth first traversal. --module Main(main) where module Main where import Control.Monad as C import Control.Monad.Par import Control.Monad.Par.Stream as S import Control.Monad.Par.OpenList import Control.DeepSeq import Control.Exception import Control.Parallel.Strategies as Strat -- import Data.Array.Unboxed as U import Data.Complex import Data.Int import Data.Word import Data.List (intersperse) import Data.List.Split (chunk) import Prelude as P import System.Environment import System.Exit import System.CPUTime import System.CPUTime.Rdtsc import GHC.Conc as Conc import GHC.IO (unsafePerformIO, unsafeDupablePerformIO, unsafeInterleaveIO) import Debug.Trace import Control.Monad.Par.Logging import qualified Data.Vector.Unboxed as UV import Data.Vector.Unboxed hiding ((++)) -- Performs some (presently meaningless) computation on a state & a -- window (stream element) to compute a new state and new window. -- -- Assumes statesize is a multiple of bufsize: statefulKern :: Vector Double -> Vector Double -> (Vector Double, Vector Double) statefulKern state buf = (newstate, newelem) where -- We could probably test the memory behavior we're interested in -- better with inplace update here... but for now, this: newstate = UV.map (\d -> d/sum + 2) state newelem = UV.map (+sum) buf sum = P.sum partialSums partialSums = [ sumslice (cutslice n) | n <- [0..factor-1] ] cutslice n = UV.slice (n*blen) blen state sumslice slce = UV.sum (UV.zipWith (+) buf slce) factor = slen `quot` blen slen = UV.length state blen = UV.length buf -------------------------------------------------------------------------------- monadpar_version (_,numfilters, bufsize, statecoef, numwins) = do putStrLn$ "Running monad-par version." let statesize = bufsize * statecoef results <- evaluate $ runPar$ do strm1 :: Stream (UV.Vector Double) <- S.generate numwins (\n -> UV.replicate bufsize 0) -- Make a pipeline of numfilters stages: let initstate = UV.generate statesize fromIntegral pipe_end <- C.foldM (\s _ -> streamScan statefulKern initstate s) strm1 [1..numfilters] sums <- streamMap UV.sum pipe_end #if 0 return sums -- This is tricky, but two different consumers shouldn't prevent -- garbage collection. ls <- toListSpin results -- Just (Cons h _) <- pollIVar results putStrLn$ "Sum of first window: " ++ show (P.head ls) forkIO$ measureRateList ls putStrLn$ "Final sum = "++ show (P.sum ls) #else streamFold (+) 0 sums putStrLn$ "Final sum = "++ show results #endif -------------------------------------------------------------------------------- sparks_version (_,numfilters, bufsize, statecoef, numwins) = do putStrLn$ "Running sparks version." -- Here we represent the stream as a plain list. let statesize = bufsize * statecoef strm1 :: [UV.Vector Double] = P.replicate numwins $ UV.replicate bufsize 0 initstate = UV.generate statesize fromIntegral applyKern = scan statefulKern initstate -- This one has the problem that it fully evaluates the stream for the -- first kernel before moving on to the second: -- strm_last = (parRepeatFun numfilters applyKern) strm1 pipe_end = applyNKernels statefulKern numfilters initstate strm1 sums = P.map UV.sum pipe_end -- #define SERIAL #ifndef SERIAL `using` (Strat.parBuffer numCapabilities rwhnf) #endif putStrLn$ "Sum of first window: "++ show (P.head sums) measureRateList (sums) -- measureRateList (strm_last) -- measureRateList (forceList strm_last) putStrLn$ "Final Sum = " ++ show (P.sum sums) -- Make sure the cars of a list are evaluated before following each cdr: forceList [] = [] forceList (h:t) = rnf h `seq` forceList t -- A slightly different version of Data.List.scanl scan :: (a -> b -> (a,c)) -> a -> [b] -> [c] scan f q [] = [] scan f q (h:t) = h' : scan f q t where (q',h') = f q h type StatefulKernel s a b = s -> a -> (s,b) -- applyNKernels _ _ _ [] = [] applyNKernels :: NFData a => StatefulKernel s a a -> Int -> s -> [a] -> [a] applyNKernels _ 0 _ ls = ls applyNKernels kern n init ls = applyNKernels kern (n-1) init (loop init ls) where loop st [] = [] loop st (h:t) = let (st', x) = kern st h in #ifndef SERIAL rnf x `par` #endif x : loop st' t -- Compose two stateful kernels in parallel. composeStatefulKernels :: (NFData b, NFData s1) => StatefulKernel s1 a b -> StatefulKernel s2 b c -> StatefulKernel (s1,s2) a c -- composeStatefulKernels (f1,f2) (s1,s2) x = composeStatefulKernels f1 f2 (s1,s2) x = rnf pr1 `par` (newstate, snd pr2) where pr1 = f1 s1 x pr2 = f2 s2 (snd pr1) newstate = (fst pr1, fst pr2) parRepeatFun n f = -- P.foldr (.) id (P.replicate n f) P.foldr (.|| rdeepseq) id (P.replicate n f) -------------------------------------------------------------------------------- -- Main script default_version = "monad" default_numfilters = 4 default_bufsize = 256 default_statecoef = 10 -- in MULTIPLES of bufsize default_numwins = 10 * 1000 main = do args <- getArgs arg_tup@(version,_,_,_,_) <- case args of [] -> return (default_version, default_numfilters, default_bufsize, default_statecoef, default_numwins) [a,b,c,d,e] -> return (a, read b, read c, read d, read e) _ -> do putStrLn$ "ERROR: Invalid arguments, must take 0 or 5 args." putStrLn$ " Expected args: (version='monad'|'sparks' #filters, bufsize, stateSizeMultiplier, #bufsToProcess)" putStrLn$ " Received args: "++ show args exitFailure putStrLn$ "numCapabilities: "++ show numCapabilities putStrLn$ " Frequency in measurable ticks: "++ commaint one_second ++ "\n" case version of "monad" -> monadpar_version arg_tup "sparks" -> sparks_version arg_tup _ -> error$ "unknown version: "++version putStrLn$ "Finally, dumping all logs:" printAllLogs -- It is not necessary to evaluate every element in the case of an unboxed vector. instance NFData a => NFData (UV.Vector a) where rnf !vec = () print_ msg = trace msg $ return () -- work pop 1 peek N push 1 -- float->float filter -- firFilter n coefs = -- { -- float sum = 0; -- for (int i = 0; i < N; i++) -- sum += peek(i) * COEFF[N-1-i]; -- pop(); -- push(sum); -- } -- } {- Here's what cachegrind says (on 4 core nehalem): $ valgrind --tool=cachegrind ./stream/disjoint_working_sets_pipeline monad 4 768 10 1000 +RTS -N4 ..... [measureRate] current rate: 58 Total elems&time 916 181,988,055,721 [measureRate] Hit end of stream after 1000 elements. Final sum = 1.560518243231086e22 ==21202== ==21202== I refs: 7,111,462,273 ==21202== I1 misses: 374,190 ==21202== L2i misses: 298,364 ==21202== I1 miss rate: 0.00% ==21202== L2i miss rate: 0.00% ==21202== ==21202== D refs: 3,882,935,974 (3,542,949,529 rd + 339,986,445 wr) ==21202== D1 misses: 14,606,684 ( 9,824,455 rd + 4,782,229 wr) ==21202== L2d misses: 6,774,479 ( 2,088,565 rd + 4,685,914 wr) ==21202== D1 miss rate: 0.3% ( 0.2% + 1.4% ) ==21202== L2d miss rate: 0.1% ( 0.0% + 1.3% ) ==21202== ==21202== L2 refs: 14,980,874 ( 10,198,645 rd + 4,782,229 wr) ==21202== L2 misses: 7,072,843 ( 2,386,929 rd + 4,685,914 wr) ==21202== L2 miss rate: 0.0% ( 0.0% + 1.3% ) Sparks version: Final Sum = 1.560518243231086e22 ==21226== ==21226== I refs: 5,898,314,238 ==21226== I1 misses: 291,271 ==21226== L2i misses: 246,518 ==21226== I1 miss rate: 0.00% ==21226== L2i miss rate: 0.00% ==21226== ==21226== D refs: 3,264,359,909 (3,206,394,437 rd + 57,965,472 wr) ==21226== D1 misses: 16,003,068 ( 10,905,138 rd + 5,097,930 wr) ==21226== L2d misses: 9,177,043 ( 4,207,106 rd + 4,969,937 wr) ==21226== D1 miss rate: 0.4% ( 0.3% + 8.7% ) ==21226== L2d miss rate: 0.2% ( 0.1% + 8.5% ) ==21226== ==21226== L2 refs: 16,294,339 ( 11,196,409 rd + 5,097,930 wr) ==21226== L2 misses: 9,423,561 ( 4,453,624 rd + 4,969,937 wr) ==21226== L2 miss rate: 0.1% ( 0.0% + 8.5% ) -} monad-par-0.1.0.3/examples/stream/fft_pipeline.hs0000644000000000000000000000323711673650535020046 0ustar0000000000000000{-# OPTIONS_GHC -fwarn-unused-imports #-} module Main(main) where import Control.Monad.Par import Control.Monad.Par.Stream as S import Control.Exception import Data.Complex import GHC.Conc as Conc import Debug.Trace import Math.FFT (dft) type Elt = Complex Double fft_kern :: Window Elt -> Window Elt fft_kern arr = dft arr -- -- TEMP, evaluate one element to make sure the fft really gets called: -- -- trace ("One elt sample: "++ show (arr!10)) $ -- case arr2 ! 10 of _ -> arr2 -- where arr2 = dft arr -------------------------------------------------------------------------------- -- Main script -- target = maxBound target = 10 * 1000 * 1000 bufsize = 1024 main = do putStrLn$ "numCapabilities: "++ show numCapabilities putStrLn$ " Frequency in measurable ticks: "++ commaint one_second ++ "\n" putStrLn$ "Performing FFT of "++ commaint target ++" numbers windowed into buffers of size "++ show bufsize ++"\n" results <- evaluate $ runParAsync$ do strm1 <- countupWin bufsize target :: Par (WStream Elt) print_$ "\n Next, applying FFT filter... " strm2 <- streamMap fft_kern strm1 -- Make a pipeline of 10 stages: -- strm2 <- foldl (\ s _ -> streamMap kern0) strm1 [1..10] print_$ "\n Stream graph constructed, returning from Par computation... " return strm2 measureRate results putStrLn$ "End of stream reached. All done." print_ msg = trace msg $ return () -- work pop 1 peek N push 1 -- float->float filter -- firFilter n coefs = -- { -- float sum = 0; -- for (int i = 0; i < N; i++) -- sum += peek(i) * COEFF[N-1-i]; -- pop(); -- push(sum); -- } -- } {- Notes: -} monad-par-0.1.0.3/examples/stream/Makefile0000644000000000000000000000132111673650535016476 0ustar0000000000000000include ../common.mk SRC= simple1_measureSrc.hs \ disjoint_working_sets_pipeline.hs \ fft_pipeline.hs EXES= $(SRC:.hs=.exe) NOTHREAD= $(SRC:.hs=.nothread.exe) # Par source code with relative paths updated for this deeper directory: RELPARSRC= $(subst ../,../../,$(ALLPARSRC)) all: $(EXES) %.exe : %.hs $(RELPARSRC) $(GHC) -O2 --make -i../../ $< -o $@ -threaded -rtsopts #------------------------------------------------------------ # Build the non-threaded versions. nothread: $(NOTHREAD) %.nothread.exe: %.hs $(RELPARSRC) $(GHC) -O2 --make -i../../ $< -o $@ -rtsopts #------------------------------------------------------------ runtests: ../run_tests.sh $(EXES) clean: rm -f $(EXES) *.o *.hi monad-par-0.1.0.3/examples/stream/simple1_measureSrc.hs0000644000000000000000000000155011673650535021141 0ustar0000000000000000{-# OPTIONS_GHC -fwarn-unused-imports #-} module Main(main) where import Control.Monad import Control.Monad.Par import Control.Monad.Par.Stream as S import Control.Monad.Par.OpenList import Control.DeepSeq import Control.Exception -- import Data.Array.Unboxed as U import Data.Array.CArray as C import Data.Complex import Data.Int import Data.Word import Data.List (intersperse) import Data.List.Split (chunk) import System.CPUTime import System.CPUTime.Rdtsc import GHC.Conc as Conc import GHC.IO (unsafePerformIO, unsafeDupablePerformIO, unsafeInterleaveIO) import Debug.Trace -------------------------------------------------------------------------------- -- Main script main = do -- Generate 20 million elements: let s = countupWin 1024 (20 * 1000 * 1000) :: Par (WStream Int) measureRate $ runParAsync s putStrLn$ "Done with 5 million elements." monad-par-0.1.0.3/examples/sumeuler/0000755000000000000000000000000011673650535015407 5ustar0000000000000000monad-par-0.1.0.3/examples/sumeuler/ListAux.hs0000644000000000000000000000205611673650535017337 0ustar0000000000000000module ListAux where import Data.List -- splitting into n parts, and its inverse: splitIntoN :: Int -> [a] -> [[a]] splitIntoN n xs = takeIter parts xs where l = length xs parts = zipWith (+) ((replicate (l `mod` n) 1) ++ repeat 0) (replicate n (l `div` n)) takeIter :: [Int] -> [a] -> [[a]] takeIter [] [] = [] takeIter [] _ = error "elements left over" takeIter (t:ts) xs = hs : takeIter ts rest where (hs,rest) = splitAt t xs unSplit :: [[a]] -> [a] unSplit = concat -- splitting into parts of same size. Inverse is concat again. splitAtN :: Int -> [a] -> [[a]] splitAtN n [] = [] splitAtN n xs = ys : splitAtN n zs where (ys,zs) = splitAt n xs ---------------------------------------- -- splitting round-robin until list runs empty, and its inverse: unshuffle :: Int -> [a] -> [[a]] unshuffle n xs = [takeEach n (drop i xs) | i <- [0..n-1]] where takeEach n [] = [] takeEach n (x:xs) = x : takeEach n (drop (n-1) xs) -- inverse to unshuffle shuffle :: [[a]] -> [a] shuffle = concat . transpose monad-par-0.1.0.3/examples/sumeuler/Makefile0000644000000000000000000000026411673650535017051 0ustar0000000000000000include ../common.mk sumeuler.exe : $(wildcard *.hs) ../../Control/Monad/Par.hs $(GHC) -O2 -cpp --make -i../.. SumEuler.hs -o $@ -threaded -rtsopts clean: rm -f *.exe *.hi *.o monad-par-0.1.0.3/examples/sumeuler/SumEuler.hs0000644000000000000000000002407311673650535017512 0ustar0000000000000000{-# OPTIONS -Wall #-} -- -- Euler totient function (strategic version). -- Orig taken from "Research Directions in Parallel Functional Programming", -- Chapter "Performance Monitoring", Nathan Charles and Colin Runciman. -- -- (c) 2001 Hans-Wolfgang Loidl -- -- modifications by Jost Berthold, 07/2008: -- ported to current GHC = hierarchical libraries -- removed some dead (unused) code -- simplified/secured usage -- included a reference computation (using prime numbers) -- tested best version (JFP_Final) against two "equivalents" using -- strategies -- --------------------------------------------------------------------------- module Main where import System.Environment (getArgs) import Control.Monad.Par import Control.Monad (when) import ListAux -- split/join functions, put in new module import SumEulerPrimes --------------------------------------------------------------------------- -- Generic clustering routines -- Classes -- maybe: class (Functor c) => MMonad c where { ... mmap = fmap } class MMonad c where munit :: a -> c a mjoin :: c (c a) -> c a mmap :: (a -> b) -> c a -> c b class (MMonad c) => MMonadPlus c where mzero :: c a mplus :: c a -> c a -> c a class (MMonad c) => Cluster c where cluster :: Int -> c a -> c (c a) decluster :: c (c a) -> c a lift :: (c a -> b) -> (c (c a) -> (c b)) -- default defs --cluster = ??? decluster = mjoin lift = mmap -- Instances instance MMonad [] where munit x = [x] mjoin = concat mmap = map instance Cluster [] where cluster = splitAtN --------------------------------------------------------------------------- usage :: String usage = "Usage: version size chunksize" ++"\nFor versions see source code." main :: IO () main = do args <- getArgs let lenArgs = length args when (lenArgs < 3) (putStrLn (usage ++ "\n(using defaults: 38,5000,100)")) let argDef :: Read a => Int -> a -> a argDef m defVal | m < lenArgs = read (args!!m) | otherwise = defVal x, n, c :: Int x = argDef 0 38 -- which sumEuler to use n = argDef 1 5000 -- size of the interval c = argDef 2 100 -- chunksize -- parallel computation (res, _str) = case x of _ -> (sumEuler_monadpar c n, "monad-par version") #if 0 ------------------ -- BEST VERSION: 38 -> (sumEulerJFP_Final c n, "JFP_Final paper version (splitAtN)") -- VERSIONS TO TEST ADDITIONALLY: -- 48 -> (sumEulerS8 c n, "parallel w/ parChunkFoldMap strategy") -- 58 -> (sumEulerS8' c n, "parallel w/ parChunkFold'Map strategy") 8 -> (sumEulerJFP c n, "JFP paper version (splitAtN)") ------------------ 0 -> (sumEuler_seq n, "sequential") 1 -> (sumEulerS1 n, "parallel w/ parList strategy") -- not bad: 2 -> (sumEulerS2 c n, "parallel w/ parListChunk") 3 -> (sumEulerChunk c n,"parallel w/ chunkify") 4 -> (sumEulerShuffle c n,"parallel w/ shuffle") 5 -> (sumEulerCluster c n,"parallel w/ generic clustering") -- not bad: 6 -> (sumEulerS6 c n, "parallel w/ parListChunk over reversed list") -- 7 -> (sumEulerS7 c n, "parallel w/ parChunkFoldMap strategy") 18 -> (sumEulerJFP1 c n, "JFP1 paper version (splitIntoChunks)") 28 -> (sumEulerJFP0 c n, "JFP0 paper version (explicit list comprh)") -- 9 -> (sumEulerStepList c n, "parallel w/ seqStepList for strategic shuffling") _ -> error "undefined version." #endif putStrLn ("sumEuler [" ++ show base ++ ".." ++ show (base+n) ++ "] = " ++ show res) -- reference implementation (which is rather fast) let expected = sumPhi n when False $ putStrLn ("Expected result: " ++ show expected) --------------------------------------------------------------------------- -- main computation function in many variants -- HERE: best versions in contrast #if 0 sumEulerJFP :: Int -> Int -> Int sumEulerJFP c n = sum (map (sum . map euler) (splitAtN c (mkList n)) `using` parList rdeepseq) sumEulerJFP_Final :: Int -> Int -> Int sumEulerJFP_Final c n = sum ([(sum . map euler) x | x <- splitAtN c [n,n-1..0]] `using` parList rdeepseq) #endif sumEuler_monadpar :: Int -> Int -> Int sumEuler_monadpar c n = runPar $ -- sum `fmap` parMap (sum . map euler) (splitAtN c [n,n-1..0]) sum `fmap` parMap euler [n,n-1..0] -- -- using a fold-of-map strategy w/ folding inside a chunk -- sumEulerS8 :: Int -> Int -> Int -- sumEulerS8 c n = parChunkFoldMap c rnf (+) euler (mkList n) -- -- -- using a fold-of-map strategy w/ STRICT LEFT-folding inside a chunk -- sumEulerS8' :: Int -> Int -> Int -- sumEulerS8' c n = parChunkFoldMap' c rnf (+) euler (mkList n) -- -- -- parallel fold-of-map with chunking over fold and map -- parChunkFoldMap :: (NFData b) => Int -> Strategy b -> -- (b -> b -> b) -> (a -> b) -> [a] -> b -- parChunkFoldMap c s f g xs = foldl1 f (map (foldl1 f . map g) -- (splitAtN c xs) -- `using` parList s) -- -- -- parallel fold-of-map with chunking over fold and map -- parChunkFoldMap' :: (NFData b) => Int -> Strategy b -> -- (b -> b -> b) -> (a -> b) -> [a] -> b -- parChunkFoldMap' c s f g xs = foldl1' f (map (foldl1' f . map g) -- (splitAtN c xs) -- `using` parList s) #if 0 ----------------------------------------------------------------------- -- OTHER VARIANTS -- strategic function application sumEulerS1 :: Int -> Int sumEulerS1 n = sum ( map euler (mkList n) `using` parList rdeepseq ) -- NUKED: -- sumEulerS1 c n = sum $|| (parListChunk c rnf) $ map euler $ mkList $ n -- naive parallel version w/ parList sumEulerS2 :: Int -> Int -> Int sumEulerS2 c n = sum ( map euler (mkList n) `using` parListChunk c rdeepseq ) -- using a parallel fold over a chunkified list sumEulerS6 :: Int -> Int -> Int sumEulerS6 c n = sum (map (sum . map euler) (splitAtN c (mkList n)) `using` parList rdeepseq) -- -- using a fold-of-map strategy over a chunkified list -- sumEulerS7 :: Int -> Int -> Int -- sumEulerS7 c n = parFoldChunkMap c rnf (+) euler (mkList n) -- explicit restructuring sumEulerChunk :: Int -> Int -> Int sumEulerChunk c n = sum (parMap rdeepseq ( \ xs -> sum (map euler xs)) (splitAtN c (mkList n))) -- using generic clustering functions sumEulerCluster :: Int -> Int -> Int sumEulerCluster c n = sum ((lift worker) (cluster c (mkList n)) `using` parList rdeepseq) where worker = sum . map euler -- using a shuffling to improve load balance sumEulerShuffle :: Int -> Int -> Int sumEulerShuffle c n = sum ((map worker) (unshuffle (noFromSize c n) (mkList n)) `using` parList rdeepseq) where worker = sum . map euler noFromSize :: Int -> Int -> Int noFromSize c n | n `mod` c == 0 = n `div` c | otherwise = n `div` c + 1 -- -- Evaluates every n-th element in the list starting with the first elem -- seqStepList :: Int -> Strategy a -> Strategy [a] -- seqStepList _ _strat [] = () -- seqStepList n strat (x:xs) = strat x `pseq` (seqStepList n strat (drop (n-1) xs)) -- -- seqStepList' :: Int -> Strategy a -> Strategy [a] -- -- seqStepList' _ strat [] = () -- seqStepList' n strat xs = parList (\ i -> seqStepList n strat (drop i xs)) [0..n-1] -- -- sumEulerStepList :: Int -> Int -> Int -- sumEulerStepList c n = sum ( map euler (mkList n) -- `using` -- seqStepList' n' rnf ) -- where --worker = sum . map euler -- n' = if n `mod` c == 0 then n `div` c else (n `div` c)+1 -- --------------------------------------------------------------------------- -- Variants of the code for the JFP paper -- --------------------------------------------------------------------------- sumEulerJFP0 :: Int -> Int -> Int sumEulerJFP0 c n = sum ([ (sum . map euler) [ c*i+j | j <- [0..c-1], c*i+j<=n ] | i <- [0..(n+c-1) `div` c - 1] ] `using` parList rdeepseq) sumEulerJFP1 :: Int -> Int -> Int sumEulerJFP1 c n = sum (map (sum . map euler) (splitIntoChunks c n) `using` parList rdeepseq) #endif splitIntoChunks :: Int -> Int -> [[Int]] splitIntoChunks c n = [ [ c*i+j | j <- [0..c-1], c*i+j<=n ] | i <- [0..(n+c-1) `div` c - 1] ] -- boring sequential version sumEuler_seq :: Int -> Int sumEuler_seq = sum . map euler . mkList --------------------------------------------------------------------------- -- smallest input for euler base :: Int base = 0 -- produce a list of input values mkList :: Int -> [Int] mkList = reverse . enumFromTo base . (+ base) -- random numbers -- mkList seed n = take n (randoms seed) --------------------------------------------------------------------------- -- main fct euler :: Int -> Int euler n = length (filter (relprime n) [1..(n-1)]) --------------------------------------------------------------------------- -- orig code from Nathan {- euler :: Int -> Int euler n = let relPrimes = let numbers = [1..(n-1)] in numbers `par` (filter (relprime n) numbers) in (spine relPrimes) `par` (length relPrimes) -} --------------------------------------------------------------------------- -- aux fcts hcf :: Int -> Int -> Int hcf x 0 = x hcf x y = hcf y (rem x y) relprime :: Int -> Int -> Bool relprime x y = hcf x y == 1 monad-par-0.1.0.3/examples/sumeuler/SumEulerPrimes.hs0000644000000000000000000000204211673650535020662 0ustar0000000000000000module SumEulerPrimes where import Data.List sumPhi n = sum (map phiOpt [1..n]) phiOpt :: Int -> Int phiOpt 1 = 0 phiOpt n = foldl (*) 1 [ (p-1)*p^(k-1) | (p,k) <- primefactors n ] -- factorise n to a list of (prime, multiplicity) primefactors :: Int -> [(Int,Int)] primefactors n | n <= 1 = [] | otherwise = primeList (primesIn primes n) -- gather identical primes in the list primeList :: [Int] -> [(Int,Int)] primeList ps = [ (x, length (filter (==x) ps)) | x <- nub ps ] -- brute-force factorisation, using precomputed prime list primesIn :: [Int] -> Int -> [Int] primesIn [] _ = error "no primes left!" primesIn ps@(p:rest) n | p > n = [] | n `mod` p == 0 = p:primesIn ps (n `div` p) | otherwise = primesIn rest n -- prime numbers, by sieve of Eratosthenes primes :: [Int] primes = sieve [2..] sieve :: [Int] -> [Int] sieve [] = [] sieve (x:xs) = x: (sieve (filter (not . multiple) xs)) where multiple y = rem y x == 0 monad-par-0.1.0.3/tests/0000755000000000000000000000000011673650535013072 5ustar0000000000000000monad-par-0.1.0.3/tests/AListTest.hs0000644000000000000000000000165311673650535015307 0ustar0000000000000000 import Control.Monad.Par.AList -------------------------------------------------------------------------------- -- Testing -- For testing: bintree 0 x = x bintree n x = Append sub sub where sub = bintree (n-1) x showDbg ANil = "_" showDbg (ASing x) = show x showDbg (Append l r) = "("++showDbg l++" | "++showDbg r++")" showDbg (AList l) = show l alist_tests :: Test alist_tests = TestList [ 8 ~=? (length$ tail$ tail$ fromList [1..10]) , 1 ~=? (length$ tail$tail$ cons 1$ cons 2$ cons 3 empty) , 253 ~=? (length$ tail$tail$tail$ bintree 8 $ singleton 'a') , 0 ~=? (length$ bintree 8 $ empty) , "((1 | 1) | (1 | 1))" ~=? (showDbg$ bintree 2 $ singleton 1) , "((_ | 1) | (1 | 1))" ~=? (showDbg$ tail$ bintree 2 $ singleton 1) , "(_ | (1 | 1))" ~=? (showDbg$ tail$tail$ bintree 2 $ singleton 1) ] t = runTestTT alist_tests -- TODO: Quickcheck. monad-par-0.1.0.3/tests/Test.hs0000644000000000000000000000344611673650535014354 0ustar0000000000000000module Main where import Test.HUnit -- ----------------------------------------------------------------------------- -- Testing _test :: IO () _test = do print ((runPar $ return 3) :: Int) print (runPar $ do r <- new; put r (3 :: Int); get r) print (runPar $ do r <- new; fork (put r (3::Int)); get r) print ((runPar $ do r <- new; get r) :: Int) _test2 :: Int _test2 = runPar $ do [a,b,c,d] <- sequence [new,new,new,new] fork $ do x <- get a; put b (x+1) fork $ do x <- get a; put c (x+2) fork $ do x <- get b; y <- get c; put d (x+y) fork $ do put a 3 get d _test3 :: Int _test3 = runPar $ do a <- new put a (3::Int) both (return 1) (return 2) -- is there a standard lib thing for this? _test_pmrr1 :: Int _test_pmrr1 = runPar$ parMapReduceRangeThresh 1 (InclusiveRange 1 100) (return) (return `bincomp` (+)) 0 where bincomp unary bin a b = unary (bin a b) _unsafeio :: IO a -> Par a _unsafeio io = let x = unsafePerformIO io in x `seq` return x _print :: String -> Par () _print = _unsafeio . putStrLn _waste_time :: Int -> Double _waste_time n = loop n 1.00111 where loop 0 !x = x loop !n !x | x > 100.0 = loop (n-1) (x / 2) loop !n !x = loop (n-1) (x + x * 0.5011) _async_test1 = do -- A D B C E putStrLn "A" evaluate$ runPar $ do fork $ do _print "B" _print$ "C "++ show (_waste_time 300000000) _print "D" putStrLn$ "E" _async_test2 = do -- A D E or A D B E but no C putStrLn "A" evaluate$ runParAsync $ do fork $ do _print "B" _print$ "C "++ show (_waste_time 300000000) _print "D" putStrLn$ "E" -- TODO: add the async_tests above to the test list. _par_tests :: Test _par_tests = TestList []