containers-0.6.0.1: benchmarks/Sequence.hs
module Main where
import Control.Applicative
import Control.DeepSeq (rnf)
import Control.Exception (evaluate)
import Control.Monad.Trans.State.Strict
import Criterion.Main (bench, bgroup, defaultMain, nf)
import Data.Foldable (foldl', foldr')
import qualified Data.Sequence as S
import qualified Data.Foldable
import Data.Traversable (traverse)
import System.Random (mkStdGen, randoms)
main = do
let s10 = S.fromList [1..10] :: S.Seq Int
s100 = S.fromList [1..100] :: S.Seq Int
s1000 = S.fromList [1..1000] :: S.Seq Int
s10000 = S.fromList [1..10000] :: S.Seq Int
evaluate $ rnf [s10, s100, s1000, s10000]
let g = mkStdGen 1
let rlist n = map (`mod` (n+1)) (take 10000 (randoms g)) :: [Int]
r10 = rlist 10
r100 = rlist 100
r1000 = rlist 1000
r10000 = rlist 10000
evaluate $ rnf [r10, r100, r1000, r10000]
let rs10 = S.fromList r10
rs100 = S.fromList r100
rs1000 = S.fromList r1000
rs10000 = S.fromList r10000
evaluate $ rnf [rs10, rs100, rs1000, rs10000]
let u10 = S.replicate 10 () :: S.Seq ()
u100 = S.replicate 100 () :: S.Seq ()
u1000 = S.replicate 1000 () :: S.Seq ()
u10000 = S.replicate 10000 () :: S.Seq ()
evaluate $ rnf [u10, u100, u1000, u10000]
defaultMain
[ bgroup "splitAt/append"
[ bench "10" $ nf (shuffle r10) s10
, bench "100" $ nf (shuffle r100) s100
, bench "1000" $ nf (shuffle r1000) s1000
]
, bgroup "fromList"
[ bench "10" $ nf S.fromList [(0 :: Int)..9]
, bench "100" $ nf S.fromList [(0 :: Int)..99]
, bench "1000" $ nf S.fromList [(0 :: Int)..999]
, bench "10000" $ nf S.fromList [(0 :: Int)..9999]
, bench "100000" $ nf S.fromList [(0 :: Int)..99999]
]
, bgroup "partition"
[ bench "10" $ nf (S.partition even) s10
, bench "100" $ nf (S.partition even) s100
, bench "1000" $ nf (S.partition even) s1000
, bench "10000" $ nf (S.partition even) s10000
]
, bgroup "foldl'"
[ bench "10" $ nf (foldl' (+) 0) s10
, bench "100" $ nf (foldl' (+) 0) s100
, bench "1000" $ nf (foldl' (+) 0) s1000
, bench "10000" $ nf (foldl' (+) 0) s10000
]
, bgroup "foldr'"
[ bench "10" $ nf (foldr' (+) 0) s10
, bench "100" $ nf (foldr' (+) 0) s100
, bench "1000" $ nf (foldr' (+) 0) s1000
, bench "10000" $ nf (foldr' (+) 0) s10000
]
, bgroup "update"
[ bench "10" $ nf (updatePoints r10 10) s10
, bench "100" $ nf (updatePoints r100 10) s100
, bench "1000" $ nf (updatePoints r1000 10) s1000
]
, bgroup "adjust"
[ bench "10" $ nf (adjustPoints r10 (+10)) s10
, bench "100" $ nf (adjustPoints r100 (+10)) s100
, bench "1000" $ nf (adjustPoints r1000 (+10)) s1000
]
, bgroup "deleteAt"
[ bench "10" $ nf (deleteAtPoints r10) s10
, bench "100" $ nf (deleteAtPoints r100) s100
, bench "1000" $ nf (deleteAtPoints r1000) s1000
]
, bgroup "insertAt"
[ bench "10" $ nf (insertAtPoints r10 10) s10
, bench "100" $ nf (insertAtPoints r100 10) s100
, bench "1000" $ nf (insertAtPoints r1000 10) s1000
]
, bgroup "traverseWithIndex/State"
[ bench "10" $ nf multiplyDown s10
, bench "100" $ nf multiplyDown s100
, bench "1000" $ nf multiplyDown s1000
]
, bgroup "traverse/State"
[ bench "10" $ nf multiplyUp s10
, bench "100" $ nf multiplyUp s100
, bench "1000" $ nf multiplyUp s1000
]
, bgroup "replicateA/State"
[ bench "10" $ nf stateReplicate 10
, bench "100" $ nf stateReplicate 100
, bench "1000" $ nf stateReplicate 1000
]
, bgroup "zip"
[ bench "ix10000/5000" $ nf (\(xs,ys) -> S.zip xs ys `S.index` 5000) (s10000, u10000)
, bench "nf100" $ nf (uncurry S.zip) (s100, u100)
, bench "nf10000" $ nf (uncurry S.zip) (s10000, u10000)
]
, bgroup "fromFunction"
[ bench "ix10000/5000" $ nf (\s -> S.fromFunction s (+1) `S.index` (s `div` 2)) 10000
, bench "nf10" $ nf (\s -> S.fromFunction s (+1)) 10
, bench "nf100" $ nf (\s -> S.fromFunction s (+1)) 100
, bench "nf1000" $ nf (\s -> S.fromFunction s (+1)) 1000
, bench "nf10000" $ nf (\s -> S.fromFunction s (+1)) 10000
]
, bgroup "<*>"
[ bench "ix500/1000^2" $
nf (\s -> ((+) <$> s <*> s) `S.index` (S.length s `div` 2)) (S.fromFunction 1000 (+1))
, bench "ix500000/1000^2" $
nf (\s -> ((+) <$> s <*> s) `S.index` (S.length s * S.length s `div` 2)) (S.fromFunction 1000 (+1))
, bench "ixBIG" $
nf (\s -> ((+) <$> s <*> s) `S.index` (S.length s * S.length s `div` 2))
(S.fromFunction (floor (sqrt $ fromIntegral (maxBound::Int))-10) (+1))
, bench "nf100/2500/rep" $
nf (\(s,t) -> (,) <$> replicate s () <*> replicate t ()) (100,2500)
, bench "nf100/2500/ff" $
nf (\(s,t) -> (,) <$> S.fromFunction s (+1) <*> S.fromFunction t (*2)) (100,2500)
, bench "nf500/500/rep" $
nf (\(s,t) -> (,) <$> replicate s () <*> replicate t ()) (500,500)
, bench "nf500/500/ff" $
nf (\(s,t) -> (,) <$> S.fromFunction s (+1) <*> S.fromFunction t (*2)) (500,500)
, bench "nf2500/100/rep" $
nf (\(s,t) -> (,) <$> replicate s () <*> replicate t ()) (2500,100)
, bench "nf2500/100/ff" $
nf (\(s,t) -> (,) <$> S.fromFunction s (+1) <*> S.fromFunction t (*2)) (2500,100)
]
, bgroup "sort"
[ bgroup "already sorted"
[ bench "10" $ nf S.sort s10
, bench "100" $ nf S.sort s100
, bench "1000" $ nf S.sort s1000
, bench "10000" $ nf S.sort s10000]
, bgroup "random"
[ bench "10" $ nf S.sort rs10
, bench "100" $ nf S.sort rs100
, bench "1000" $ nf S.sort rs1000
, bench "10000" $ nf S.sort rs10000]
]
, bgroup "unstableSort"
[ bgroup "already sorted"
[ bench "10" $ nf S.unstableSort s10
, bench "100" $ nf S.unstableSort s100
, bench "1000" $ nf S.unstableSort s1000
, bench "10000" $ nf S.unstableSort s10000]
, bgroup "random"
[ bench "10" $ nf S.unstableSort rs10
, bench "100" $ nf S.unstableSort rs100
, bench "1000" $ nf S.unstableSort rs1000
, bench "10000" $ nf S.unstableSort rs10000]
]
, bgroup "unstableSortOn"
[ bgroup "already sorted"
[ bench "10" $ nf (S.unstableSortOn id) s10
, bench "100" $ nf (S.unstableSortOn id) s100
, bench "1000" $ nf (S.unstableSortOn id) s1000
, bench "10000" $ nf (S.unstableSortOn id) s10000]
, bgroup "random"
[ bench "10" $ nf (S.unstableSortOn id) rs10
, bench "100" $ nf (S.unstableSortOn id) rs100
, bench "1000" $ nf (S.unstableSortOn id) rs1000
, bench "10000" $ nf (S.unstableSortOn id) rs10000]
]
]
{-
-- This is around 4.6 times as slow as insertAt
fakeInsertAt :: Int -> a -> S.Seq a -> S.Seq a
fakeInsertAt i x xs = case S.splitAt i xs of
(before, after) -> before S.>< x S.<| after
-}
adjustPoints :: [Int] -> (a -> a) -> S.Seq a -> S.Seq a
adjustPoints points f xs =
foldl' (\acc k -> S.adjust f k acc) xs points
insertAtPoints :: [Int] -> a -> S.Seq a -> S.Seq a
insertAtPoints points x xs =
foldl' (\acc k -> S.insertAt k x acc) xs points
updatePoints :: [Int] -> a -> S.Seq a -> S.Seq a
updatePoints points x xs =
foldl' (\acc k -> S.update k x acc) xs points
{-
-- For comparison. Using the old implementation of update,
-- which this simulates, can cause thunks to build up in the leaves.
fakeupdatePoints :: [Int] -> a -> S.Seq a -> S.Seq a
fakeupdatePoints points x xs =
foldl' (\acc k -> S.adjust (const x) k acc) xs points
-}
deleteAtPoints :: [Int] -> S.Seq a -> S.Seq a
deleteAtPoints points xs =
foldl' (\acc k -> S.deleteAt k acc) xs points
{-
fakedeleteAtPoints :: [Int] -> S.Seq a -> S.Seq a
fakedeleteAtPoints points xs =
foldl' (\acc k -> fakeDeleteAt k acc) xs points
-- For comparison with deleteAt. deleteAt is several
-- times faster for long sequences.
fakeDeleteAt :: Int -> S.Seq a -> S.Seq a
fakeDeleteAt i xs
| 0 < i && i < S.length xs = case S.splitAt i xs of
(before, after) -> before S.>< S.drop 1 after
| otherwise = xs
-}
-- splitAt+append: repeatedly cut the sequence at a random point
-- and rejoin the pieces in the opposite order.
-- Finally getting the middle element forces the whole spine.
shuffle :: [Int] -> S.Seq Int -> Int
shuffle ps s = case S.viewl (S.drop (S.length s `div` 2) (foldl' cut s ps)) of
x S.:< _ -> x
where cut xs p = let (front, back) = S.splitAt p xs in back S.>< front
stateReplicate :: Int -> S.Seq Char
stateReplicate n = flip evalState 0 . S.replicateA n $ do
old <- get
if old > (10 :: Int) then put 0 else put (old + 1)
return $ toEnum old
multiplyUp :: S.Seq Int -> S.Seq Int
multiplyUp = flip evalState 0 . traverse go where
go x = do
s <- get
put (s + 1)
return (s * x)
multiplyDown :: S.Seq Int -> S.Seq Int
multiplyDown = flip evalState 0 . S.traverseWithIndex go where
go i x = do
s <- get
put (s - 1)
return (s * i * x)