@@ -0,0 +1,210 @@
1+-- |
2+-- Module : Streamly.Benchmark.Data.Fold
3+-- Copyright : (c) 2018 Composewell
4+--
5+-- License : MIT
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE FlexibleContexts #-}
9+
10+module Streamly.Benchmark.Data.Fold
11+ ( o_1_space_serial_folds
12+ , o_1_space_serial_foldsTransforms
13+ , o_1_space_serial_foldsCompositions
14+ , o_n_heap_serial_folds
15+ ) where
16+
17+import Control.DeepSeq (NFData(..))
18+import Data.Monoid (Last(..))
19+
20+import System.Random (randomRIO)
21+import Prelude (IO, Int, Double, String, (>), (<*>), (<$>), (+), ($),
22+ (<=), Monad(..), (==), Maybe(..), (.), fromIntegral,
23+ compare, (>=))
24+
25+import qualified Streamly as S hiding (runStream)
26+import qualified Streamly.Prelude as S
27+import qualified Streamly.Internal.Data.Fold as FL
28+import qualified Streamly.Internal.Data.Pipe as Pipe
29+
30+import qualified Streamly.Internal.Data.Sink as Sink
31+
32+import qualified Streamly.Memory.Array as A
33+import qualified Streamly.Internal.Memory.Array as IA
34+import qualified Streamly.Internal.Data.Fold as IFL
35+import qualified Streamly.Internal.Prelude as IP
36+
37+import Gauge
38+import Streamly hiding (runStream)
39+
40+-- We need a monadic bind here to make sure that the function f does not get
41+-- completely optimized out by the compiler in some cases.
42+
43+{-# INLINE sourceUnfoldrM #-}
44+sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
45+sourceUnfoldrM value n = S.unfoldrM step n
46+ where
47+ step cnt =
48+ if cnt > n + value
49+ then return Nothing
50+ else return (Just (cnt, cnt + 1))
51+
52+{-# INLINE source #-}
53+source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
54+source = sourceUnfoldrM
55+
56+-- | Takes a fold method, and uses it with a default source.
57+{-# INLINE benchIOSink #-}
58+benchIOSink
59+ :: (IsStream t, NFData b)
60+ => Int -> String -> (t IO Int -> IO b) -> Benchmark
61+benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source value
62+
63+-------------------------------------------------------------------------------
64+-- Stream folds
65+-------------------------------------------------------------------------------
66+
67+o_1_space_serial_folds :: Int -> [Benchmark]
68+o_1_space_serial_folds value =
69+ [ bgroup
70+ "serially"
71+ [ bgroup
72+ "folds"
73+ [ benchIOSink value "drain" (S.fold FL.drain)
74+ , benchIOSink value "drainN" (S.fold (IFL.drainN value))
75+ , benchIOSink
76+ value
77+ "drainWhileTrue"
78+ (S.fold (IFL.drainWhile $ (<=) (value + 1)))
79+ , benchIOSink
80+ value
81+ "drainWhileFalse"
82+ (S.fold (IFL.drainWhile $ (>=) (value + 1)))
83+ , benchIOSink value "sink" (S.fold $ Sink.toFold Sink.drain)
84+ , benchIOSink value "last" (S.fold FL.last)
85+ , benchIOSink value "lastN.1" (S.fold (IA.lastN 1))
86+ , benchIOSink value "lastN.10" (S.fold (IA.lastN 10))
87+ , benchIOSink value "length" (S.fold FL.length)
88+ , benchIOSink value "sum" (S.fold FL.sum)
89+ , benchIOSink value "product" (S.fold FL.product)
90+ , benchIOSink value "maximumBy" (S.fold (FL.maximumBy compare))
91+ , benchIOSink value "maximum" (S.fold FL.maximum)
92+ , benchIOSink value "minimumBy" (S.fold (FL.minimumBy compare))
93+ , benchIOSink value "minimum" (S.fold FL.minimum)
94+ , benchIOSink
95+ value
96+ "mean"
97+ (\s ->
98+ S.fold
99+ FL.mean
100+ (S.map (fromIntegral :: Int -> Double) s))
101+ , benchIOSink
102+ value
103+ "variance"
104+ (\s ->
105+ S.fold
106+ FL.variance
107+ (S.map (fromIntegral :: Int -> Double) s))
108+ , benchIOSink
109+ value
110+ "stdDev"
111+ (\s ->
112+ S.fold
113+ FL.stdDev
114+ (S.map (fromIntegral :: Int -> Double) s))
115+ , benchIOSink
116+ value
117+ "mconcat"
118+ (S.fold FL.mconcat . (S.map (Last . Just)))
119+ , benchIOSink
120+ value
121+ "foldMap"
122+ (S.fold (FL.foldMap (Last . Just)))
123+ , benchIOSink value "index" (S.fold (FL.index (value + 1)))
124+ , benchIOSink value "head" (S.fold FL.head)
125+ , benchIOSink value "find" (S.fold (FL.find (== (value + 1))))
126+ , benchIOSink
127+ value
128+ "findIndex"
129+ (S.fold (FL.findIndex (== (value + 1))))
130+ , benchIOSink
131+ value
132+ "elemIndex"
133+ (S.fold (FL.elemIndex (value + 1)))
134+ , benchIOSink value "null" (S.fold FL.null)
135+ , benchIOSink value "elem" (S.fold (FL.elem (value + 1)))
136+ , benchIOSink value "notElem" (S.fold (FL.notElem (value + 1)))
137+ , benchIOSink value "all" (S.fold (FL.all (<= (value + 1))))
138+ , benchIOSink value "any" (S.fold (FL.any (> (value + 1))))
139+ , benchIOSink
140+ value
141+ "and"
142+ (\s -> S.fold FL.and (S.map (<= (value + 1)) s))
143+ , benchIOSink
144+ value
145+ "or"
146+ (\s -> S.fold FL.or (S.map (> (value + 1)) s))
147+ ]
148+ ]
149+ ]
150+
151+
152+o_1_space_serial_foldsTransforms :: Int -> [Benchmark]
153+o_1_space_serial_foldsTransforms value =
154+ [ bgroup
155+ "serially"
156+ [ bgroup
157+ "folds-transforms"
158+ [ benchIOSink value "drain" (S.fold FL.drain)
159+ , benchIOSink value "lmap" (S.fold (IFL.lmap (+ 1) FL.drain))
160+ , benchIOSink
161+ value
162+ "pipe-mapM"
163+ (S.fold
164+ (IFL.transform
165+ (Pipe.mapM (\x -> return $ x + 1))
166+ FL.drain))
167+ ]
168+ ]
169+ ]
170+
171+
172+o_1_space_serial_foldsCompositions :: Int -> [Benchmark]
173+o_1_space_serial_foldsCompositions value =
174+ [ bgroup
175+ "serially"
176+ [ bgroup
177+ "folds-compositions" -- Applicative
178+ [ benchIOSink
179+ value
180+ "all,any"
181+ (S.fold
182+ ((,) <$> FL.all (<= (value + 1)) <*>
183+ FL.any (> (value + 1))))
184+ , benchIOSink
185+ value
186+ "sum,length"
187+ (S.fold ((,) <$> FL.sum <*> FL.length))
188+ ]
189+ ]
190+ ]
191+
192+
193+o_n_heap_serial_folds :: Int -> [Benchmark]
194+o_n_heap_serial_folds value =
195+ [ bgroup
196+ "serially"
197+ [ bgroup
198+ "foldl"
199+ -- Left folds for building a structure are inherently non-streaming
200+ -- as the structure cannot be lazily consumed until fully built.
201+ [ benchIOSink value "toStream" (S.fold IP.toStream)
202+ , benchIOSink value "toStreamRev" (S.fold IP.toStreamRev)
203+ , benchIOSink value "toList" (S.fold FL.toList)
204+ , benchIOSink value "toListRevF" (S.fold IFL.toListRevF)
205+ -- Converting the stream to an array
206+ , benchIOSink value "lastN.Max" (S.fold (IA.lastN (value + 1)))
207+ , benchIOSink value "writeN" (S.fold (A.writeN value))
208+ ]
209+ ]
210+ ]