[commit: packages/containers] changelog-foldtree, cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-408-bugfix_394: Add benchmarks (daa37c8)
git at git.haskell.org
git at git.haskell.org
Mon Apr 17 21:40:01 UTC 2017
- Previous message: [commit: packages/containers] changelog-foldtree,cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-408-bugfix_394: Use bang patterns for Data.Sequence; unbox (ab9562e)
- Next message: [commit: packages/containers] changelog-foldtree, cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-408-bugfix_394: Merge pull request #202 from treeowl/bang-sequences (89069ae)
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
Repository : ssh://git@git.haskell.org/containers
On branches: changelog-foldtree,cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-408-bugfix_394
Link : http://git.haskell.org/packages/containers.git/commitdiff/daa37c845b19c7e23cf6daec2910c75e20890b88
>---------------------------------------------------------------
commit daa37c845b19c7e23cf6daec2910c75e20890b88
Author: David Feuer <David.Feuer at gmail.com>
Date: Mon Apr 25 00:11:42 2016 -0400
Add benchmarks
Add replicateA, traverse, and traverseWithIndex benchmarks.
>---------------------------------------------------------------
daa37c845b19c7e23cf6daec2910c75e20890b88
benchmarks/Sequence.hs | 37 +++++++++++++++++++++++++++++++++++++
1 file changed, 37 insertions(+)
diff --git a/benchmarks/Sequence.hs b/benchmarks/Sequence.hs
index bfb3c2d..ec2e95c 100644
--- a/benchmarks/Sequence.hs
+++ b/benchmarks/Sequence.hs
@@ -4,10 +4,12 @@ module Main where
import Control.Applicative
import Control.DeepSeq
import Control.Exception (evaluate)
+import Control.Monad.Trans.State.Strict
import Criterion.Main
import Data.List (foldl')
import qualified Data.Sequence as S
import qualified Data.Foldable
+import Data.Traversable (traverse)
import System.Random
main = do
@@ -34,6 +36,21 @@ main = do
, bench "100" $ nf (shuffle r100) s100
, bench "1000" $ nf (shuffle r1000) 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)
@@ -76,3 +93,23 @@ 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)
- Previous message: [commit: packages/containers] changelog-foldtree,cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-408-bugfix_394: Use bang patterns for Data.Sequence; unbox (ab9562e)
- Next message: [commit: packages/containers] changelog-foldtree, cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-408-bugfix_394: Merge pull request #202 from treeowl/bang-sequences (89069ae)
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
More information about the ghc-commits
mailing list