1module Main where
2
3import Criterion.Main
4import Criterion.Main.Options
5import Options.Applicative
6
7import Algo.ListRank  (listRank)
8import Algo.Rootfix   (rootfix)
9import Algo.Leaffix   (leaffix)
10import Algo.AwShCC    (awshcc)
11import Algo.HybCC     (hybcc)
12import Algo.Quickhull (quickhull)
13import Algo.Spectral  ( spectral )
14import Algo.Tridiag   ( tridiag )
15
16import TestData.ParenTree ( parenTree )
17import TestData.Graph     ( randomGraph )
18import TestData.Random    ( randomVector )
19
20import Data.Vector.Unboxed ( Vector )
21
22import System.Environment
23import Data.Word
24
25import Data.Word
26
27data BenchArgs = BenchArgs
28  { seed      :: Word32
29  , size      :: Int
30  , otherArgs :: Mode
31  }
32
33defaultSize :: Int
34defaultSize = 2000000
35
36defaultSeed :: Word32
37defaultSeed = 42
38
39parseBenchArgs :: Parser BenchArgs
40parseBenchArgs = BenchArgs
41  <$> option auto
42      (  long "seed"
43      <> metavar "NUM"
44      <> value defaultSeed
45      <> help "A value with which to initialize the PRNG" )
46  <*> option auto
47      (  long "size"
48      <> metavar "NUM"
49      <> value defaultSize
50      <> help "A value to use as the default entries in data structures. Benchmarks are broken for very small numbers." )
51  <*> parseWith defaultConfig
52
53main :: IO ()
54main = do
55  args <- execParser $ describeWith parseBenchArgs
56
57  let useSeed = seed args
58  let useSize = size args
59
60  let (lparens, rparens) = parenTree useSize
61  let (nodes, edges1, edges2) = randomGraph useSeed useSize
62  lparens `seq` rparens `seq`
63    nodes `seq` edges1 `seq` edges2 `seq` return ()
64
65  as <- randomVector useSeed useSize :: IO (Vector Double)
66  bs <- randomVector useSeed useSize :: IO (Vector Double)
67  cs <- randomVector useSeed useSize :: IO (Vector Double)
68  ds <- randomVector useSeed useSize :: IO (Vector Double)
69  sp <- randomVector useSeed (floor $ sqrt $ fromIntegral useSize)
70                          :: IO (Vector Double)
71  as `seq` bs `seq` cs `seq` ds `seq` sp `seq` return ()
72  putStrLn "foo"
73  runMode (otherArgs args)
74                [ bench "listRank"  $ whnf listRank useSize
75                , bench "rootfix"   $ whnf rootfix (lparens, rparens)
76                , bench "leaffix"   $ whnf leaffix (lparens, rparens)
77                , bench "awshcc"    $ whnf awshcc (nodes, edges1, edges2)
78                , bench "hybcc"     $ whnf hybcc  (nodes, edges1, edges2)
79                , bench "quickhull" $ whnf quickhull (as,bs)
80                , bench "spectral"  $ whnf spectral sp
81                , bench "tridiag"   $ whnf tridiag (as,bs,cs,ds)
82                ]
83