Replace criterion with gauge as the benchmark framework
[packages/containers.git] / benchmarks / Sequence.hs
1 module Main where
2
3 import Control.Applicative
4 import Control.DeepSeq (rnf)
5 import Control.Exception (evaluate)
6 import Control.Monad.Trans.State.Strict
7 import Gauge (bench, bgroup, defaultMain, nf)
8 import Data.Foldable (foldl', foldr')
9 import qualified Data.Sequence as S
10 import qualified Data.Foldable
11 import Data.Traversable (traverse)
12 import System.Random (mkStdGen, randoms)
13
14 main = do
15 let s10 = S.fromList [1..10] :: S.Seq Int
16 s100 = S.fromList [1..100] :: S.Seq Int
17 s1000 = S.fromList [1..1000] :: S.Seq Int
18 s10000 = S.fromList [1..10000] :: S.Seq Int
19 evaluate $ rnf [s10, s100, s1000, s10000]
20 let g = mkStdGen 1
21 let rlist n = map (`mod` (n+1)) (take 10000 (randoms g)) :: [Int]
22 r10 = rlist 10
23 r100 = rlist 100
24 r1000 = rlist 1000
25 r10000 = rlist 10000
26 evaluate $ rnf [r10, r100, r1000, r10000]
27 let rs10 = S.fromList r10
28 rs100 = S.fromList r100
29 rs1000 = S.fromList r1000
30 rs10000 = S.fromList r10000
31 evaluate $ rnf [rs10, rs100, rs1000, rs10000]
32 let u10 = S.replicate 10 () :: S.Seq ()
33 u100 = S.replicate 100 () :: S.Seq ()
34 u1000 = S.replicate 1000 () :: S.Seq ()
35 u10000 = S.replicate 10000 () :: S.Seq ()
36 evaluate $ rnf [u10, u100, u1000, u10000]
37 defaultMain
38 [ bgroup "splitAt/append"
39 [ bench "10" $ nf (shuffle r10) s10
40 , bench "100" $ nf (shuffle r100) s100
41 , bench "1000" $ nf (shuffle r1000) s1000
42 ]
43 , bgroup "fromList"
44 [ bench "10" $ nf S.fromList [(0 :: Int)..9]
45 , bench "100" $ nf S.fromList [(0 :: Int)..99]
46 , bench "1000" $ nf S.fromList [(0 :: Int)..999]
47 , bench "10000" $ nf S.fromList [(0 :: Int)..9999]
48 , bench "100000" $ nf S.fromList [(0 :: Int)..99999]
49 ]
50 , bgroup "partition"
51 [ bench "10" $ nf (S.partition even) s10
52 , bench "100" $ nf (S.partition even) s100
53 , bench "1000" $ nf (S.partition even) s1000
54 , bench "10000" $ nf (S.partition even) s10000
55 ]
56 , bgroup "foldl'"
57 [ bench "10" $ nf (foldl' (+) 0) s10
58 , bench "100" $ nf (foldl' (+) 0) s100
59 , bench "1000" $ nf (foldl' (+) 0) s1000
60 , bench "10000" $ nf (foldl' (+) 0) s10000
61 ]
62 , bgroup "foldr'"
63 [ bench "10" $ nf (foldr' (+) 0) s10
64 , bench "100" $ nf (foldr' (+) 0) s100
65 , bench "1000" $ nf (foldr' (+) 0) s1000
66 , bench "10000" $ nf (foldr' (+) 0) s10000
67 ]
68 , bgroup "update"
69 [ bench "10" $ nf (updatePoints r10 10) s10
70 , bench "100" $ nf (updatePoints r100 10) s100
71 , bench "1000" $ nf (updatePoints r1000 10) s1000
72 ]
73 , bgroup "adjust"
74 [ bench "10" $ nf (adjustPoints r10 (+10)) s10
75 , bench "100" $ nf (adjustPoints r100 (+10)) s100
76 , bench "1000" $ nf (adjustPoints r1000 (+10)) s1000
77 ]
78 , bgroup "deleteAt"
79 [ bench "10" $ nf (deleteAtPoints r10) s10
80 , bench "100" $ nf (deleteAtPoints r100) s100
81 , bench "1000" $ nf (deleteAtPoints r1000) s1000
82 ]
83 , bgroup "insertAt"
84 [ bench "10" $ nf (insertAtPoints r10 10) s10
85 , bench "100" $ nf (insertAtPoints r100 10) s100
86 , bench "1000" $ nf (insertAtPoints r1000 10) s1000
87 ]
88 , bgroup "traverseWithIndex/State"
89 [ bench "10" $ nf multiplyDown s10
90 , bench "100" $ nf multiplyDown s100
91 , bench "1000" $ nf multiplyDown s1000
92 ]
93 , bgroup "traverse/State"
94 [ bench "10" $ nf multiplyUp s10
95 , bench "100" $ nf multiplyUp s100
96 , bench "1000" $ nf multiplyUp s1000
97 ]
98 , bgroup "replicateA/State"
99 [ bench "10" $ nf stateReplicate 10
100 , bench "100" $ nf stateReplicate 100
101 , bench "1000" $ nf stateReplicate 1000
102 ]
103 , bgroup "zip"
104 [ bench "ix10000/5000" $ nf (\(xs,ys) -> S.zip xs ys `S.index` 5000) (s10000, u10000)
105 , bench "nf100" $ nf (uncurry S.zip) (s100, u100)
106 , bench "nf10000" $ nf (uncurry S.zip) (s10000, u10000)
107 ]
108 , bgroup "fromFunction"
109 [ bench "ix10000/5000" $ nf (\s -> S.fromFunction s (+1) `S.index` (s `div` 2)) 10000
110 , bench "nf10" $ nf (\s -> S.fromFunction s (+1)) 10
111 , bench "nf100" $ nf (\s -> S.fromFunction s (+1)) 100
112 , bench "nf1000" $ nf (\s -> S.fromFunction s (+1)) 1000
113 , bench "nf10000" $ nf (\s -> S.fromFunction s (+1)) 10000
114 ]
115 , bgroup "<*>"
116 [ bench "ix500/1000^2" $
117 nf (\s -> ((+) <$> s <*> s) `S.index` (S.length s `div` 2)) (S.fromFunction 1000 (+1))
118 , bench "ix500000/1000^2" $
119 nf (\s -> ((+) <$> s <*> s) `S.index` (S.length s * S.length s `div` 2)) (S.fromFunction 1000 (+1))
120 , bench "ixBIG" $
121 nf (\s -> ((+) <$> s <*> s) `S.index` (S.length s * S.length s `div` 2))
122 (S.fromFunction (floor (sqrt $ fromIntegral (maxBound::Int))-10) (+1))
123 , bench "nf100/2500/rep" $
124 nf (\(s,t) -> (,) <$> replicate s () <*> replicate t ()) (100,2500)
125 , bench "nf100/2500/ff" $
126 nf (\(s,t) -> (,) <$> S.fromFunction s (+1) <*> S.fromFunction t (*2)) (100,2500)
127 , bench "nf500/500/rep" $
128 nf (\(s,t) -> (,) <$> replicate s () <*> replicate t ()) (500,500)
129 , bench "nf500/500/ff" $
130 nf (\(s,t) -> (,) <$> S.fromFunction s (+1) <*> S.fromFunction t (*2)) (500,500)
131 , bench "nf2500/100/rep" $
132 nf (\(s,t) -> (,) <$> replicate s () <*> replicate t ()) (2500,100)
133 , bench "nf2500/100/ff" $
134 nf (\(s,t) -> (,) <$> S.fromFunction s (+1) <*> S.fromFunction t (*2)) (2500,100)
135 ]
136 , bgroup "sort"
137 [ bgroup "already sorted"
138 [ bench "10" $ nf S.sort s10
139 , bench "100" $ nf S.sort s100
140 , bench "1000" $ nf S.sort s1000
141 , bench "10000" $ nf S.sort s10000]
142 , bgroup "random"
143 [ bench "10" $ nf S.sort rs10
144 , bench "100" $ nf S.sort rs100
145 , bench "1000" $ nf S.sort rs1000
146 , bench "10000" $ nf S.sort rs10000]
147 ]
148 , bgroup "unstableSort"
149 [ bgroup "already sorted"
150 [ bench "10" $ nf S.unstableSort s10
151 , bench "100" $ nf S.unstableSort s100
152 , bench "1000" $ nf S.unstableSort s1000
153 , bench "10000" $ nf S.unstableSort s10000]
154 , bgroup "random"
155 [ bench "10" $ nf S.unstableSort rs10
156 , bench "100" $ nf S.unstableSort rs100
157 , bench "1000" $ nf S.unstableSort rs1000
158 , bench "10000" $ nf S.unstableSort rs10000]
159 ]
160 , bgroup "unstableSortOn"
161 [ bgroup "already sorted"
162 [ bench "10" $ nf (S.unstableSortOn id) s10
163 , bench "100" $ nf (S.unstableSortOn id) s100
164 , bench "1000" $ nf (S.unstableSortOn id) s1000
165 , bench "10000" $ nf (S.unstableSortOn id) s10000]
166 , bgroup "random"
167 [ bench "10" $ nf (S.unstableSortOn id) rs10
168 , bench "100" $ nf (S.unstableSortOn id) rs100
169 , bench "1000" $ nf (S.unstableSortOn id) rs1000
170 , bench "10000" $ nf (S.unstableSortOn id) rs10000]
171 ]
172 ]
173
174 {-
175 -- This is around 4.6 times as slow as insertAt
176 fakeInsertAt :: Int -> a -> S.Seq a -> S.Seq a
177 fakeInsertAt i x xs = case S.splitAt i xs of
178 (before, after) -> before S.>< x S.<| after
179 -}
180
181 adjustPoints :: [Int] -> (a -> a) -> S.Seq a -> S.Seq a
182 adjustPoints points f xs =
183 foldl' (\acc k -> S.adjust f k acc) xs points
184
185 insertAtPoints :: [Int] -> a -> S.Seq a -> S.Seq a
186 insertAtPoints points x xs =
187 foldl' (\acc k -> S.insertAt k x acc) xs points
188
189 updatePoints :: [Int] -> a -> S.Seq a -> S.Seq a
190 updatePoints points x xs =
191 foldl' (\acc k -> S.update k x acc) xs points
192
193 {-
194 -- For comparison. Using the old implementation of update,
195 -- which this simulates, can cause thunks to build up in the leaves.
196 fakeupdatePoints :: [Int] -> a -> S.Seq a -> S.Seq a
197 fakeupdatePoints points x xs =
198 foldl' (\acc k -> S.adjust (const x) k acc) xs points
199 -}
200
201 deleteAtPoints :: [Int] -> S.Seq a -> S.Seq a
202 deleteAtPoints points xs =
203 foldl' (\acc k -> S.deleteAt k acc) xs points
204
205 {-
206 fakedeleteAtPoints :: [Int] -> S.Seq a -> S.Seq a
207 fakedeleteAtPoints points xs =
208 foldl' (\acc k -> fakeDeleteAt k acc) xs points
209 -- For comparison with deleteAt. deleteAt is several
210 -- times faster for long sequences.
211 fakeDeleteAt :: Int -> S.Seq a -> S.Seq a
212 fakeDeleteAt i xs
213 | 0 < i && i < S.length xs = case S.splitAt i xs of
214 (before, after) -> before S.>< S.drop 1 after
215 | otherwise = xs
216 -}
217
218 -- splitAt+append: repeatedly cut the sequence at a random point
219 -- and rejoin the pieces in the opposite order.
220 -- Finally getting the middle element forces the whole spine.
221 shuffle :: [Int] -> S.Seq Int -> Int
222 shuffle ps s = case S.viewl (S.drop (S.length s `div` 2) (foldl' cut s ps)) of
223 x S.:< _ -> x
224 where cut xs p = let (front, back) = S.splitAt p xs in back S.>< front
225
226 stateReplicate :: Int -> S.Seq Char
227 stateReplicate n = flip evalState 0 . S.replicateA n $ do
228 old <- get
229 if old > (10 :: Int) then put 0 else put (old + 1)
230 return $ toEnum old
231
232 multiplyUp :: S.Seq Int -> S.Seq Int
233 multiplyUp = flip evalState 0 . traverse go where
234 go x = do
235 s <- get
236 put (s + 1)
237 return (s * x)
238
239 multiplyDown :: S.Seq Int -> S.Seq Int
240 multiplyDown = flip evalState 0 . S.traverseWithIndex go where
241 go i x = do
242 s <- get
243 put (s - 1)
244 return (s * i * x)