1{-
2  This program should generally be run using `cabal bench` or
3  `stack bench`. To use `stack bench`, edit stack.yaml to include
4
5  extra-deps:
6  - microbench-0.1
7
8  To run benchmarks manually, install microbench from
9  http://hackage.haskell.org/cgi-bin/hackage-scripts/package/microbench
10
11  then run
12
13  % ghc -O --make benchmark
14  % ./benchmark
15  [1 of 1] Compiling Main             ( benchmark.hs, benchmark.o )
16  Linking benchmark ...
17  * insNode into AVL tree: ..................
18    8.877ns per iteration / 112655.53 per second.
19  * insNode into PATRICIA tree: .....................
20    1.788ns per iteration / 559342.86 per second.
21  * insEdge into AVL tree: ...........
22    2833.029ns per iteration / 352.98 per second.
23  * insEdge into PATRICIA tree: ...................
24    4.625ns per iteration / 216224.60 per second.
25  * gmap on AVL tree: ................
26    32.754ns per iteration / 30530.57 per second.
27  * gmap on PATRICIA tree: .....................
28    1.623ns per iteration / 616056.37 per second.
29  * nmap on AVL tree: ................
30    35.455ns per iteration / 28204.95 per second.
31  * nmap on PATRICIA tree: .....................
32    1.713ns per iteration / 583758.06 per second.
33  * emap on AVL tree: ...........
34    4416.303ns per iteration / 226.43 per second.
35  * emap on PATRICIA tree: ...................
36    4.532ns per iteration / 220663.09 per second.
37-}
38
39{-# LANGUAGE ScopedTypeVariables #-}
40
41module Main (main) where
42
43import           Control.DeepSeq
44import           Data.Graph.Inductive.Graph
45import qualified Data.Graph.Inductive.PatriciaTree as Patricia
46import           Data.Graph.Inductive.Proxy
47import qualified Data.Graph.Inductive.Tree         as AVL
48import           Microbench
49
50main :: IO ()
51main = do microbench "insNode into AVL tree" insNodeAVL
52          microbench "insNode into PATRICIA tree" insNodePatricia
53
54          microbench "buildFull into AVL tree 100" (buildFullAVL 100)
55          microbench "buildFull into AVL tree 500" (buildFullAVL 500)
56          microbench "buildFull into AVL tree 1000" (buildFullAVL 1000)
57
58          microbench "buildFull into PATRICIA tree 100" (buildFullPatricia 100)
59          microbench "buildFull into PATRICIA tree 500" (buildFullPatricia 500)
60          microbench "buildFull into PATRICIA tree 1000" (buildFullPatricia 1000)
61
62          microbench "insEdge into AVL tree" insEdgeAVL
63          microbench "insEdge into PATRICIA tree" insEdgePatricia
64
65          microbench "gmap on AVL tree" gmapAVL
66          microbench "gmap on PATRICIA tree" gmapPatricia
67
68          microbench "nmap on AVL tree" nmapAVL
69          microbench "nmap on PATRICIA tree" nmapPatricia
70
71          microbench "emap on AVL tree" emapAVL
72          microbench "emap on PATRICIA tree" emapPatricia
73
74buildFullAVL :: Int -> Int -> ()
75buildFullAVL = buildFull (Proxy :: TreeP)
76
77insNodeAVL :: Int -> AVL.UGr
78insNodeAVL = insNodes' empty
79
80buildFullPatricia :: Int -> Int -> ()
81buildFullPatricia = buildFull (Proxy :: PatriciaTreeP)
82
83insNodePatricia :: Int -> Patricia.UGr
84insNodePatricia = insNodes' empty
85
86buildFull :: forall gr . (DynGraph gr, NFData (gr Int ()))
87             => GraphProxy gr -> Int -> Int -> ()
88buildFull _ sz ntimes = rnf [buildFull' i (empty :: gr Int ()) 0 sz | i <- [0..ntimes-1]]
89
90buildFull' :: DynGraph gr => a -> gr a () -> Int -> Int -> gr a ()
91buildFull' a g n limit
92  | n == limit = empty
93  | otherwise = ([((), k) | k <- [0..n-1]],n,a,[((),k) | k <- [0..n-1]]) & buildFull' a g (n + 1) limit
94
95
96{-# INLINE insNodes' #-}
97insNodes' :: DynGraph gr => gr () b -> Int -> gr () b
98insNodes' g 0 = g
99insNodes' g n = let [v] = newNodes 1 g
100                    g'  = insNode (v, ()) g
101                in
102                  insNodes' g' (n - 1)
103
104
105insEdgeAVL :: Int -> AVL.UGr
106insEdgeAVL n = insEdges' (insNodeAVL n) n
107
108
109insEdgePatricia :: Int -> Patricia.UGr
110insEdgePatricia n = insEdges' (insNodePatricia n) n
111
112
113{-# INLINE insEdges' #-}
114insEdges' :: DynGraph gr => gr a () -> Int -> gr a ()
115insEdges' g 0 = g
116insEdges' g n = let n' = n - 1
117                    g' = insEdge (0, n', ()) g
118                in
119                  insEdges' g' n'
120
121
122gmapAVL :: Int -> AVL.Gr Int ()
123gmapAVL n
124    = let g  = insNodeAVL n
125          g' = gmap f g
126          f (ps, v, _, ss) = (ps, v, v, ss)
127      in
128        g'
129
130
131gmapPatricia :: Int -> Patricia.Gr Int ()
132gmapPatricia n
133    = let g  = insNodePatricia n
134          g' = gmap f g
135          f (ps, v, _, ss) = (ps, v, v, ss)
136      in
137        g'
138
139
140nmapAVL :: Int -> AVL.Gr Int ()
141nmapAVL n
142    = let g   = insNodeAVL n
143          g'  = nmap f g
144          f _ = n
145      in
146        g'
147
148
149nmapPatricia :: Int -> Patricia.Gr Int ()
150nmapPatricia n
151    = let g   = insNodePatricia n
152          g'  = nmap f g
153          f _ = n
154      in
155        g'
156
157
158emapAVL :: Int -> AVL.Gr () Int
159emapAVL n
160    = let g   = insEdgeAVL n
161          g'  = emap f g
162          f _ = n
163      in
164        g'
165
166
167emapPatricia :: Int -> Patricia.Gr () Int
168emapPatricia n
169    = let g   = insEdgePatricia n
170          g'  = emap f g
171          f _ = n
172      in
173        g'
174