9b93fe8e695e6c25ae1a248901795034e8ba3c9f
[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 Criterion.Main (bench, bgroup, defaultMain, nf)
8 import Data.List (foldl')
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 u10 = S.replicate 10 () :: S.Seq ()
28 u100 = S.replicate 100 () :: S.Seq ()
29 u1000 = S.replicate 1000 () :: S.Seq ()
30 u10000 = S.replicate 10000 () :: S.Seq ()
31 evaluate $ rnf [u10, u100, u1000, u10000]
32 defaultMain
33 [ bgroup "splitAt/append"
34 [ bench "10" $ nf (shuffle r10) s10
35 , bench "100" $ nf (shuffle r100) s100
36 , bench "1000" $ nf (shuffle r1000) s1000
37 ]
38 , bgroup "update"
39 [ bench "10" $ nf (updatePoints r10 10) s10
40 , bench "100" $ nf (updatePoints r100 10) s100
41 , bench "1000" $ nf (updatePoints r1000 10) s1000
42 ]
43 , bgroup "adjust"
44 [ bench "10" $ nf (adjustPoints r10 (+10)) s10
45 , bench "100" $ nf (adjustPoints r100 (+10)) s100
46 , bench "1000" $ nf (adjustPoints r1000 (+10)) s1000
47 ]
48 , bgroup "deleteAt"
49 [ bench "10" $ nf (deleteAtPoints r10) s10
50 , bench "100" $ nf (deleteAtPoints r100) s100
51 , bench "1000" $ nf (deleteAtPoints r1000) s1000
52 ]
53 , bgroup "insertAt"
54 [ bench "10" $ nf (insertAtPoints r10 10) s10
55 , bench "100" $ nf (insertAtPoints r100 10) s100
56 , bench "1000" $ nf (insertAtPoints r1000 10) s1000
57 ]
58 , bgroup "traverseWithIndex/State"
59 [ bench "10" $ nf multiplyDown s10
60 , bench "100" $ nf multiplyDown s100
61 , bench "1000" $ nf multiplyDown s1000
62 ]
63 , bgroup "traverse/State"
64 [ bench "10" $ nf multiplyUp s10
65 , bench "100" $ nf multiplyUp s100
66 , bench "1000" $ nf multiplyUp s1000
67 ]
68 , bgroup "replicateA/State"
69 [ bench "10" $ nf stateReplicate 10
70 , bench "100" $ nf stateReplicate 100
71 , bench "1000" $ nf stateReplicate 1000
72 ]
73 , bgroup "zip"
74 [ bench "ix10000/5000" $ nf (\(xs,ys) -> S.zip xs ys `S.index` 5000) (s10000, u10000)
75 , bench "nf100" $ nf (uncurry S.zip) (s100, u100)
76 , bench "nf10000" $ nf (uncurry S.zip) (s10000, u10000)
77 ]
78 , bgroup "fromFunction"
79 [ bench "ix10000/5000" $ nf (\s -> S.fromFunction s (+1) `S.index` (s `div` 2)) 10000
80 , bench "nf10" $ nf (\s -> S.fromFunction s (+1)) 10
81 , bench "nf100" $ nf (\s -> S.fromFunction s (+1)) 100
82 , bench "nf1000" $ nf (\s -> S.fromFunction s (+1)) 1000
83 , bench "nf10000" $ nf (\s -> S.fromFunction s (+1)) 10000
84 ]
85 , bgroup "<*>"
86 [ bench "ix500/1000^2" $
87 nf (\s -> ((+) <$> s <*> s) `S.index` (S.length s `div` 2)) (S.fromFunction 1000 (+1))
88 , bench "ix500000/1000^2" $
89 nf (\s -> ((+) <$> s <*> s) `S.index` (S.length s * S.length s `div` 2)) (S.fromFunction 1000 (+1))
90 , bench "ixBIG" $
91 nf (\s -> ((+) <$> s <*> s) `S.index` (S.length s * S.length s `div` 2))
92 (S.fromFunction (floor (sqrt $ fromIntegral (maxBound::Int))-10) (+1))
93 , bench "nf100/2500/rep" $
94 nf (\(s,t) -> (,) <$> replicate s () <*> replicate t ()) (100,2500)
95 , bench "nf100/2500/ff" $
96 nf (\(s,t) -> (,) <$> S.fromFunction s (+1) <*> S.fromFunction t (*2)) (100,2500)
97 , bench "nf500/500/rep" $
98 nf (\(s,t) -> (,) <$> replicate s () <*> replicate t ()) (500,500)
99 , bench "nf500/500/ff" $
100 nf (\(s,t) -> (,) <$> S.fromFunction s (+1) <*> S.fromFunction t (*2)) (500,500)
101 , bench "nf2500/100/rep" $
102 nf (\(s,t) -> (,) <$> replicate s () <*> replicate t ()) (2500,100)
103 , bench "nf2500/100/ff" $
104 nf (\(s,t) -> (,) <$> S.fromFunction s (+1) <*> S.fromFunction t (*2)) (2500,100)
105 ]
106 ]
107
108 {-
109 -- This is around 4.6 times as slow as insertAt
110 fakeInsertAt :: Int -> a -> S.Seq a -> S.Seq a
111 fakeInsertAt i x xs = case S.splitAt i xs of
112 (before, after) -> before S.>< x S.<| after
113 -}
114
115 adjustPoints :: [Int] -> (a -> a) -> S.Seq a -> S.Seq a
116 adjustPoints points f xs =
117 foldl' (\acc k -> S.adjust f k acc) xs points
118
119 insertAtPoints :: [Int] -> a -> S.Seq a -> S.Seq a
120 insertAtPoints points x xs =
121 foldl' (\acc k -> S.insertAt k x acc) xs points
122
123 updatePoints :: [Int] -> a -> S.Seq a -> S.Seq a
124 updatePoints points x xs =
125 foldl' (\acc k -> S.update k x acc) xs points
126
127 {-
128 -- For comparison. Using the old implementation of update,
129 -- which this simulates, can cause thunks to build up in the leaves.
130 fakeupdatePoints :: [Int] -> a -> S.Seq a -> S.Seq a
131 fakeupdatePoints points x xs =
132 foldl' (\acc k -> S.adjust (const x) k acc) xs points
133 -}
134
135 deleteAtPoints :: [Int] -> S.Seq a -> S.Seq a
136 deleteAtPoints points xs =
137 foldl' (\acc k -> S.deleteAt k acc) xs points
138
139 {-
140 fakedeleteAtPoints :: [Int] -> S.Seq a -> S.Seq a
141 fakedeleteAtPoints points xs =
142 foldl' (\acc k -> fakeDeleteAt k acc) xs points
143
144 -- For comparison with deleteAt. deleteAt is several
145 -- times faster for long sequences.
146 fakeDeleteAt :: Int -> S.Seq a -> S.Seq a
147 fakeDeleteAt i xs
148 | 0 < i && i < S.length xs = case S.splitAt i xs of
149 (before, after) -> before S.>< S.drop 1 after
150 | otherwise = xs
151 -}
152
153 -- splitAt+append: repeatedly cut the sequence at a random point
154 -- and rejoin the pieces in the opposite order.
155 -- Finally getting the middle element forces the whole spine.
156 shuffle :: [Int] -> S.Seq Int -> Int
157 shuffle ps s = case S.viewl (S.drop (S.length s `div` 2) (foldl' cut s ps)) of
158 x S.:< _ -> x
159 where cut xs p = let (front, back) = S.splitAt p xs in back S.>< front
160
161 stateReplicate :: Int -> S.Seq Char
162 stateReplicate n = flip evalState 0 . S.replicateA n $ do
163 old <- get
164 if old > (10 :: Int) then put 0 else put (old + 1)
165 return $ toEnum old
166
167 multiplyUp :: S.Seq Int -> S.Seq Int
168 multiplyUp = flip evalState 0 . traverse go where
169 go x = do
170 s <- get
171 put (s + 1)
172 return (s * x)
173
174 multiplyDown :: S.Seq Int -> S.Seq Int
175 multiplyDown = flip evalState 0 . S.traverseWithIndex go where
176 go i x = do
177 s <- get
178 put (s - 1)
179 return (s * i * x)