Document the Semigroup for Map
[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 "sequenceA.mapWithIndex/State"
94 [ bench "10" $ nf multiplyDownMap s10
95 , bench "100" $ nf multiplyDownMap s100
96 , bench "1000" $ nf multiplyDownMap s1000
97 ]
98 , bgroup "traverse/State"
99 [ bench "10" $ nf multiplyUp s10
100 , bench "100" $ nf multiplyUp s100
101 , bench "1000" $ nf multiplyUp s1000
102 ]
103 , bgroup "replicateA/State"
104 [ bench "10" $ nf stateReplicate 10
105 , bench "100" $ nf stateReplicate 100
106 , bench "1000" $ nf stateReplicate 1000
107 ]
108 , bgroup "zip"
109 [ bench "ix10000/5000" $ nf (\(xs,ys) -> S.zip xs ys `S.index` 5000) (s10000, u10000)
110 , bench "nf100" $ nf (uncurry S.zip) (s100, u100)
111 , bench "nf10000" $ nf (uncurry S.zip) (s10000, u10000)
112 ]
113 , bgroup "fromFunction"
114 [ bench "ix10000/5000" $ nf (\s -> S.fromFunction s (+1) `S.index` (s `div` 2)) 10000
115 , bench "nf10" $ nf (\s -> S.fromFunction s (+1)) 10
116 , bench "nf100" $ nf (\s -> S.fromFunction s (+1)) 100
117 , bench "nf1000" $ nf (\s -> S.fromFunction s (+1)) 1000
118 , bench "nf10000" $ nf (\s -> S.fromFunction s (+1)) 10000
119 ]
120 , bgroup "<*>"
121 [ bench "ix500/1000^2" $
122 nf (\s -> ((+) <$> s <*> s) `S.index` (S.length s `div` 2)) (S.fromFunction 1000 (+1))
123 , bench "ix500000/1000^2" $
124 nf (\s -> ((+) <$> s <*> s) `S.index` (S.length s * S.length s `div` 2)) (S.fromFunction 1000 (+1))
125 , bench "ixBIG" $
126 nf (\s -> ((+) <$> s <*> s) `S.index` (S.length s * S.length s `div` 2))
127 (S.fromFunction (floor (sqrt $ fromIntegral (maxBound::Int))-10) (+1))
128 , bench "nf100/2500/rep" $
129 nf (\(s,t) -> (,) <$> replicate s () <*> replicate t ()) (100,2500)
130 , bench "nf100/2500/ff" $
131 nf (\(s,t) -> (,) <$> S.fromFunction s (+1) <*> S.fromFunction t (*2)) (100,2500)
132 , bench "nf500/500/rep" $
133 nf (\(s,t) -> (,) <$> replicate s () <*> replicate t ()) (500,500)
134 , bench "nf500/500/ff" $
135 nf (\(s,t) -> (,) <$> S.fromFunction s (+1) <*> S.fromFunction t (*2)) (500,500)
136 , bench "nf2500/100/rep" $
137 nf (\(s,t) -> (,) <$> replicate s () <*> replicate t ()) (2500,100)
138 , bench "nf2500/100/ff" $
139 nf (\(s,t) -> (,) <$> S.fromFunction s (+1) <*> S.fromFunction t (*2)) (2500,100)
140 ]
141 , bgroup "sort"
142 [ bgroup "already sorted"
143 [ bench "10" $ nf S.sort s10
144 , bench "100" $ nf S.sort s100
145 , bench "1000" $ nf S.sort s1000
146 , bench "10000" $ nf S.sort s10000]
147 , bgroup "random"
148 [ bench "10" $ nf S.sort rs10
149 , bench "100" $ nf S.sort rs100
150 , bench "1000" $ nf S.sort rs1000
151 , bench "10000" $ nf S.sort rs10000]
152 ]
153 , bgroup "unstableSort"
154 [ bgroup "already sorted"
155 [ bench "10" $ nf S.unstableSort s10
156 , bench "100" $ nf S.unstableSort s100
157 , bench "1000" $ nf S.unstableSort s1000
158 , bench "10000" $ nf S.unstableSort s10000]
159 , bgroup "random"
160 [ bench "10" $ nf S.unstableSort rs10
161 , bench "100" $ nf S.unstableSort rs100
162 , bench "1000" $ nf S.unstableSort rs1000
163 , bench "10000" $ nf S.unstableSort rs10000]
164 ]
165 , bgroup "unstableSortOn"
166 [ bgroup "already sorted"
167 [ bench "10" $ nf (S.unstableSortOn id) s10
168 , bench "100" $ nf (S.unstableSortOn id) s100
169 , bench "1000" $ nf (S.unstableSortOn id) s1000
170 , bench "10000" $ nf (S.unstableSortOn id) s10000]
171 , bgroup "random"
172 [ bench "10" $ nf (S.unstableSortOn id) rs10
173 , bench "100" $ nf (S.unstableSortOn id) rs100
174 , bench "1000" $ nf (S.unstableSortOn id) rs1000
175 , bench "10000" $ nf (S.unstableSortOn id) rs10000]
176 ]
177 ]
178
179 {-
180 -- This is around 4.6 times as slow as insertAt
181 fakeInsertAt :: Int -> a -> S.Seq a -> S.Seq a
182 fakeInsertAt i x xs = case S.splitAt i xs of
183 (before, after) -> before S.>< x S.<| after
184 -}
185
186 adjustPoints :: [Int] -> (a -> a) -> S.Seq a -> S.Seq a
187 adjustPoints points f xs =
188 foldl' (\acc k -> S.adjust f k acc) xs points
189
190 insertAtPoints :: [Int] -> a -> S.Seq a -> S.Seq a
191 insertAtPoints points x xs =
192 foldl' (\acc k -> S.insertAt k x acc) xs points
193
194 updatePoints :: [Int] -> a -> S.Seq a -> S.Seq a
195 updatePoints points x xs =
196 foldl' (\acc k -> S.update k x acc) xs points
197
198 {-
199 -- For comparison. Using the old implementation of update,
200 -- which this simulates, can cause thunks to build up in the leaves.
201 fakeupdatePoints :: [Int] -> a -> S.Seq a -> S.Seq a
202 fakeupdatePoints points x xs =
203 foldl' (\acc k -> S.adjust (const x) k acc) xs points
204 -}
205
206 deleteAtPoints :: [Int] -> S.Seq a -> S.Seq a
207 deleteAtPoints points xs =
208 foldl' (\acc k -> S.deleteAt k acc) xs points
209
210 {-
211 fakedeleteAtPoints :: [Int] -> S.Seq a -> S.Seq a
212 fakedeleteAtPoints points xs =
213 foldl' (\acc k -> fakeDeleteAt k acc) xs points
214 -- For comparison with deleteAt. deleteAt is several
215 -- times faster for long sequences.
216 fakeDeleteAt :: Int -> S.Seq a -> S.Seq a
217 fakeDeleteAt i xs
218 | 0 < i && i < S.length xs = case S.splitAt i xs of
219 (before, after) -> before S.>< S.drop 1 after
220 | otherwise = xs
221 -}
222
223 -- splitAt+append: repeatedly cut the sequence at a random point
224 -- and rejoin the pieces in the opposite order.
225 -- Finally getting the middle element forces the whole spine.
226 shuffle :: [Int] -> S.Seq Int -> Int
227 shuffle ps s = case S.viewl (S.drop (S.length s `div` 2) (foldl' cut s ps)) of
228 x S.:< _ -> x
229 where cut xs p = let (front, back) = S.splitAt p xs in back S.>< front
230
231 stateReplicate :: Int -> S.Seq Char
232 stateReplicate n = flip evalState 0 . S.replicateA n $ do
233 old <- get
234 if old > (10 :: Int) then put 0 else put (old + 1)
235 return $ toEnum old
236
237 multiplyUp :: S.Seq Int -> S.Seq Int
238 multiplyUp = flip evalState 0 . traverse go where
239 go x = do
240 s <- get
241 put (s + 1)
242 return (s * x)
243
244 multiplyDown :: S.Seq Int -> S.Seq Int
245 multiplyDown = flip evalState 0 . S.traverseWithIndex go where
246 go i x = do
247 s <- get
248 put (s - 1)
249 return (s * i * x)
250
251 multiplyDownMap :: S.Seq Int -> S.Seq Int
252 multiplyDownMap = flip evalState 0 . sequenceA . S.mapWithIndex go where
253 go i x = do
254 s <- get
255 put (s - 1)
256 return (s * i * x)