Make rigidify non-recursive
[packages/containers.git] / benchmarks / Sequence.hs
1 -- > ghc -DTESTING --make -O2 -fforce-recomp -i.. Sequence.hs
2 module Main where
3
4 import Control.Applicative
5 import Control.DeepSeq
6 import Control.Exception (evaluate)
7 import Criterion.Main
8 import Data.List (foldl')
9 import qualified Data.Sequence as S
10 import qualified Data.Foldable
11 import System.Random
12
13 main = do
14 let s10 = S.fromList [1..10] :: S.Seq Int
15 s100 = S.fromList [1..100] :: S.Seq Int
16 s1000 = S.fromList [1..1000] :: S.Seq Int
17 s10000 = S.fromList [1..10000] :: S.Seq Int
18 evaluate $ rnf [s10, s100, s1000, s10000]
19 let g = mkStdGen 1
20 let rlist n = map (`mod` (n+1)) (take 10000 (randoms g)) :: [Int]
21 r10 = rlist 10
22 r100 = rlist 100
23 r1000 = rlist 1000
24 r10000 = rlist 10000
25 evaluate $ rnf [r10, r100, r1000, r10000]
26 let u10 = S.replicate 10 () :: S.Seq ()
27 u100 = S.replicate 100 () :: S.Seq ()
28 u1000 = S.replicate 1000 () :: S.Seq ()
29 u10000 = S.replicate 10000 () :: S.Seq ()
30 evaluate $ rnf [u10, u100, u1000, u10000]
31 defaultMain
32 [ bgroup "splitAt/append"
33 [ bench "10" $ nf (shuffle r10) s10
34 , bench "100" $ nf (shuffle r100) s100
35 , bench "1000" $ nf (shuffle r1000) s1000
36 ]
37 , bgroup "zip"
38 [ bench "ix10000/5000" $ nf (\(xs,ys) -> S.zip xs ys `S.index` 5000) (s10000, u10000)
39 , bench "nf100" $ nf (uncurry S.zip) (s100, u100)
40 , bench "nf10000" $ nf (uncurry S.zip) (s10000, u10000)
41 ]
42 , bgroup "fromFunction"
43 [ bench "ix10000/5000" $ nf (\s -> S.fromFunction s (+1) `S.index` (s `div` 2)) 10000
44 , bench "nf10" $ nf (\s -> S.fromFunction s (+1)) 10
45 , bench "nf100" $ nf (\s -> S.fromFunction s (+1)) 100
46 , bench "nf1000" $ nf (\s -> S.fromFunction s (+1)) 1000
47 , bench "nf10000" $ nf (\s -> S.fromFunction s (+1)) 10000
48 ]
49 , bgroup "<*>"
50 [ bench "ix500/1000^2" $
51 nf (\s -> ((+) <$> s <*> s) `S.index` (S.length s `div` 2)) (S.fromFunction 1000 (+1))
52 , bench "ix500000/1000^2" $
53 nf (\s -> ((+) <$> s <*> s) `S.index` (S.length s * S.length s `div` 2)) (S.fromFunction 1000 (+1))
54 , bench "ixBIG" $
55 nf (\s -> ((+) <$> s <*> s) `S.index` (S.length s * S.length s `div` 2))
56 (S.fromFunction (floor (sqrt $ fromIntegral (maxBound::Int))-10) (+1))
57 , bench "nf100/2500/rep" $
58 nf (\(s,t) -> (,) <$> replicate s () <*> replicate t ()) (100,2500)
59 , bench "nf100/2500/ff" $
60 nf (\(s,t) -> (,) <$> S.fromFunction s (+1) <*> S.fromFunction t (*2)) (100,2500)
61 , bench "nf500/500/rep" $
62 nf (\(s,t) -> (,) <$> replicate s () <*> replicate t ()) (500,500)
63 , bench "nf500/500/ff" $
64 nf (\(s,t) -> (,) <$> S.fromFunction s (+1) <*> S.fromFunction t (*2)) (500,500)
65 , bench "nf2500/100/rep" $
66 nf (\(s,t) -> (,) <$> replicate s () <*> replicate t ()) (2500,100)
67 , bench "nf2500/100/ff" $
68 nf (\(s,t) -> (,) <$> S.fromFunction s (+1) <*> S.fromFunction t (*2)) (2500,100)
69 ]
70 ]
71
72 -- splitAt+append: repeatedly cut the sequence at a random point
73 -- and rejoin the pieces in the opposite order.
74 -- Finally getting the middle element forces the whole spine.
75 shuffle :: [Int] -> S.Seq Int -> Int
76 shuffle ps s = case S.viewl (S.drop (S.length s `div` 2) (foldl' cut s ps)) of
77 x S.:< _ -> x
78 where cut xs p = let (front, back) = S.splitAt p xs in back S.>< front