git.iko.soy/streamly
on efecb26 help sign in
streamly/benchmark/Streamly/Benchmark/Data/Stream/Expand.hs
563 lines 17 kB history raw
1-- |
2-- Module : Stream.Expand
3-- Copyright : (c) 2018 Composewell Technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
7{-# LANGUAGE CPP #-}
8{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE RankNTypes #-}
11{-# LANGUAGE TupleSections #-}
13#ifdef USE_PRELUDE
14{-# OPTIONS_GHC -Wno-deprecations #-}
15#endif
17#ifdef __HADDOCK_VERSION__
18#undef INSPECTION
19#endif
21#ifdef INSPECTION
22{-# LANGUAGE TemplateHaskell #-}
23{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
24#endif
26module Stream.Expand (benchmarks) where
28#ifdef INSPECTION
29import GHC.Types (SPEC(..))
30import Test.Inspection
32import qualified Streamly.Internal.Data.Stream as D
33#endif
35import qualified Stream.Common as Common
36import qualified Streamly.Internal.Data.Unfold as UF
38#ifdef USE_PRELUDE
39import qualified Streamly.Internal.Data.Stream.IsStream as S
40import qualified Streamly.Internal.Data.Stream.IsStream as StreamK
41import Streamly.Benchmark.Prelude
42 ( sourceFoldMapM, sourceFoldMapWith, sourceFoldMapWithM
43 , sourceFoldMapWithStream, concatFoldableWith, concatForFoldableWith)
44#else
45import qualified Streamly.Internal.Data.Stream as S
46#ifdef USE_STREAMK
47import Streamly.Internal.Data.Stream (Stream)
48import Streamly.Internal.Data.StreamK (StreamK, CrossStreamK)
49import qualified Control.Applicative as AP
50import qualified Streamly.Internal.Data.Fold as Fold
51import qualified Streamly.Internal.Data.StreamK as StreamK
52#else
53import qualified Streamly.Internal.Data.Stream as StreamK
54#endif
55#endif
57import Gauge
58import Stream.Common
59import Streamly.Benchmark.Common
60import Prelude hiding (concatMap)
62-------------------------------------------------------------------------------
63-- Iteration/looping utilities
64-------------------------------------------------------------------------------
66#ifdef USE_STREAMK
67{-# INLINE iterateN #-}
68iterateN :: (Int -> a -> a) -> a -> Int -> a
69iterateN g initial count = f count initial
71 where
73 f (0 :: Int) x = x
74 f i x = f (i - 1) (g i x)
76-- Iterate a transformation over a singleton stream
77{-# INLINE iterateSingleton #-}
78iterateSingleton :: Applicative m =>
79 (Int -> CrossStreamK m Int -> CrossStreamK m Int)
80 -> Int
81 -> Int
82 -> Stream m Int
83iterateSingleton g count n =
84 toStream
85 $ StreamK.unCross
86 $ iterateN g (StreamK.mkCross (StreamK.fromPure n)) count
87#endif
89{-
90-- XXX need to check why this is slower than the explicit recursion above, even
91-- if the above code is written in a foldr like head recursive way. We also
92-- need to try this with foldlM' once #150 is fixed.
93-- However, it is perhaps best to keep the iteration benchmarks independent of
94-- foldrM and any related fusion issues.
95{-# INLINE _iterateSingleton #-}
96_iterateSingleton ::
97 Monad m
98 => (Int -> Stream m Int -> Stream m Int)
99 -> Int
100 -> Int
101 -> Stream m Int
102_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
103-}
105-------------------------------------------------------------------------------
106-- Multi-Stream
107-------------------------------------------------------------------------------
109-------------------------------------------------------------------------------
110-- Appending
111-------------------------------------------------------------------------------
113{-# INLINE serial2 #-}
114serial2 :: Int -> Int -> IO ()
115serial2 count n =
116 drain $ toStream $
117 Common.append
118 (fromStream $ sourceUnfoldrM count n)
119 (fromStream $ sourceUnfoldrM count (n + 1))
121{-# INLINE serial4 #-}
122serial4 :: Int -> Int -> IO ()
123serial4 count n =
124 drain $ toStream $
125 Common.append
126 (Common.append
127 (fromStream $ sourceUnfoldrM count n)
128 (fromStream $ sourceUnfoldrM count (n + 1)))
129 (Common.append
130 (fromStream $ sourceUnfoldrM count (n + 2))
131 (fromStream $ sourceUnfoldrM count (n + 3)))
133o_1_space_joining :: Int -> [Benchmark]
134o_1_space_joining value =
135 [ bgroup "joining"
136 [ benchIOSrc1 "serial (2,x/2)" (serial2 (value `div` 2))
137 , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))
138 ]
139 ]
141-------------------------------------------------------------------------------
142-- Concat Foldable containers
143-------------------------------------------------------------------------------
145#ifdef USE_PRELUDE
146o_1_space_concatFoldable :: Int -> [Benchmark]
147o_1_space_concatFoldable value =
148 [ bgroup "concat-foldable"
149 [ benchIOSrc "foldMapWith (<>) (List)"
150 (sourceFoldMapWith value)
151 , benchIOSrc "foldMapWith (<>) (Stream)"
152 (sourceFoldMapWithStream value)
153 , benchIOSrc "foldMapWithM (<>) (List)"
154 (sourceFoldMapWithM value)
155 , benchIOSrc "S.concatFoldableWith (<>) (List)"
156 (concatFoldableWith value)
157 , benchIOSrc "S.concatForFoldableWith (<>) (List)"
158 (concatForFoldableWith value)
159 , benchIOSrc "foldMapM (List)" (sourceFoldMapM value)
160 ]
161 ]
162#endif
164-------------------------------------------------------------------------------
165-- Concat
166-------------------------------------------------------------------------------
168-- concatMap unfoldrM/unfoldrM
170{-# INLINE concatMap #-}
171concatMap :: Int -> Int -> Int -> IO ()
172concatMap outer inner n =
173 drain $ toStream $ StreamK.concatMap
174 (\_ -> fromStream $ sourceUnfoldrM inner n)
175 (fromStream $ sourceUnfoldrM outer n)
177#ifndef USE_STREAMK
178{-# INLINE concatMapM #-}
179concatMapM :: Int -> Int -> Int -> IO ()
180concatMapM outer inner n =
181 drain $ S.concatMapM
182 (\_ -> return $ sourceUnfoldrM inner n)
183 (sourceUnfoldrM outer n)
185#ifdef INSPECTION
186inspect $ hasNoTypeClasses 'concatMap
187inspect $ 'concatMap `hasNoType` ''SPEC
188#endif
189#endif
191-- concatMap unfoldr/unfoldr
193{-# INLINE concatMapPure #-}
194concatMapPure :: Int -> Int -> Int -> IO ()
195concatMapPure outer inner n =
196 drain $ toStream $ StreamK.concatMap
197 (\_ -> fromStream $ sourceUnfoldr inner n)
198 (fromStream $ sourceUnfoldr outer n)
200#ifdef INSPECTION
201#if __GLASGOW_HASKELL__ >= 906
202inspect $ hasNoTypeClassesExcept 'concatMapPure [''Applicative]
203#else
204inspect $ hasNoTypeClasses 'concatMapPure
205#endif
206inspect $ 'concatMapPure `hasNoType` ''SPEC
207#endif
209-- concatMap replicate/unfoldrM
211{-# INLINE concatMapRepl #-}
212concatMapRepl :: Int -> Int -> Int -> IO ()
213concatMapRepl outer inner n =
214 drain $ toStream $ StreamK.concatMap
215 (fromStream . S.replicate inner) (fromStream $ sourceUnfoldrM outer n)
217#ifdef INSPECTION
218#if __GLASGOW_HASKELL__ >= 906
219inspect $ hasNoTypeClassesExcept 'concatMapRepl [''Applicative]
220#else
221inspect $ hasNoTypeClasses 'concatMapRepl
222#endif
223inspect $ 'concatMapRepl `hasNoType` ''SPEC
224#endif
226-- concatMapWith
228#ifdef USE_STREAMK
229{-# INLINE concatMapWithSerial #-}
230concatMapWithSerial :: Int -> Int -> Int -> IO ()
231concatMapWithSerial = concatStreamsWith Common.append
233#ifdef INSPECTION
234inspect $ hasNoTypeClasses 'concatMapWithSerial
235inspect $ 'concatMapWithSerial `hasNoType` ''SPEC
236#endif
238{-
239{-# INLINE concatMapWithAppend #-}
240concatMapWithAppend :: Int -> Int -> Int -> IO ()
241concatMapWithAppend = concatStreamsWith Common.append2
243#ifdef INSPECTION
244inspect $ hasNoTypeClasses 'concatMapWithAppend
245inspect $ 'concatMapWithAppend `hasNoType` ''SPEC
246#endif
247-}
249-- mergeMapWith
251{-# INLINE mergeMapWithSerial #-}
252mergeMapWithSerial :: Int -> Int -> Int -> IO ()
253mergeMapWithSerial = mergeMapWith Common.append
255{-
256{-# INLINE mergeMapWithAppend #-}
257mergeMapWithAppend :: Int -> Int -> Int -> IO ()
258mergeMapWithAppend = mergeMapWith Common.append2
259-}
260#endif
262-- unfoldMany
264-- unfoldMany replicate/unfoldrM
266{-# INLINE unfoldManyRepl #-}
267unfoldManyRepl :: Int -> Int -> Int -> IO ()
268unfoldManyRepl outer inner n =
269 drain
270 $ S.unfoldMany
271 UF.replicateM
272 (fmap ((inner,) . return) (sourceUnfoldrM outer n))
275#ifdef INSPECTION
276inspect $ hasNoTypeClasses 'unfoldManyRepl
277inspect $ 'unfoldManyRepl `hasNoType` ''D.ConcatMapUState
278inspect $ 'unfoldManyRepl `hasNoType` ''SPEC
279#endif
281o_1_space_concat :: Int -> [Benchmark]
282o_1_space_concat value = sqrtVal `seq`
283 [ bgroup "concat"
284 [ benchIOSrc1 "concatMapPure (n of 1)"
285 (concatMapPure value 1)
286 , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
287 (concatMapPure sqrtVal sqrtVal)
288 , benchIOSrc1 "concatMapPure (1 of n)"
289 (concatMapPure 1 value)
291 , benchIOSrc1 "concatMap (n of 1)"
292 (concatMap value 1)
293 , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
294 (concatMap sqrtVal sqrtVal)
295 , benchIOSrc1 "concatMap (1 of n)"
296 (concatMap 1 value)
298#ifndef USE_STREAMK
299 -- This is for comparison with foldMapWith
300 , benchIOSrc "concatMapId (n of 1) (fromFoldable)"
301 (S.concatMap id . sourceConcatMapId value)
303 , benchIOSrc1 "concatMapM (n of 1)"
304 (concatMapM value 1)
305 , benchIOSrc1 "concatMapM (sqrt n of sqrt n)"
306 (concatMapM sqrtVal sqrtVal)
307 , benchIOSrc1 "concatMapM (1 of n)"
308 (concatMapM 1 value)
309#endif
311#ifdef USE_STREAMK
312 {-
313 -- This is for comparison with foldMapWith
314 , benchIOSrc "concatMapWithId (n of 1) (fromFoldable)"
315 (toStream . S.concatMapWith Common.append id . sourceConcatMapId value)
316 -}
318 , benchIOSrc1 "concatMapWith (n of 1)"
319 (concatMapWithSerial value 1)
320 , benchIOSrc1 "concatMapWith (sqrt n of sqrt n)"
321 (concatMapWithSerial sqrtVal sqrtVal)
322 , benchIOSrc1 "concatMapWith (1 of n)"
323 (concatMapWithSerial 1 value)
325 {-
326 -- quadratic with number of outer streams
327 , benchIOSrc1 "concatMapWithAppend (2 of n/2)"
328 (concatMapWithAppend 2 (value `div` 2))
329 -}
330#endif
332 -- concatMap vs unfoldMany
333 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
334 (concatMapRepl sqrtVal sqrtVal)
335 , benchIOSrc1 "unfoldManyRepl (sqrt n of sqrt n)"
336 (unfoldManyRepl sqrtVal sqrtVal)
337 ]
338 ]
340 where
342 sqrtVal = round $ sqrt (fromIntegral value :: Double)
344#ifdef USE_STREAMK
345o_n_space_merge :: Int -> [Benchmark]
346o_n_space_merge value = sqrtVal `seq`
347 [ bgroup "concat"
348 [
349 -------------------mergeMapWith-----------------
351 -- Use large number of streams to check scalability
353 benchIOSrc1 "mergeMapWithSerial (n of 1)"
354 (mergeMapWithSerial value 1)
355 , benchIOSrc1 "mergeMapWithSerial (sqrtVal of sqrtVal)"
356 (mergeMapWithSerial sqrtVal sqrtVal)
357 , benchIOSrc1 "mergeMapWithSerial (2 of n/2)"
358 (mergeMapWithSerial 2 (value `div` 2))
360 {-
361 , benchIOSrc1 "mergeMapWithAppend (n of 1)"
362 (mergeMapWithAppend value 1)
363 , benchIOSrc1 "mergeMapWithAppend (sqrtVal of sqrtVal)"
364 (mergeMapWithAppend sqrtVal sqrtVal)
365 -}
366 ]
367 ]
369 where
371 sqrtVal = round $ sqrt (fromIntegral value :: Double)
372#endif
374-------------------------------------------------------------------------------
375-- Applicative
376-------------------------------------------------------------------------------
378o_1_space_applicative :: Int -> [Benchmark]
379o_1_space_applicative value =
380 [ bgroup "Applicative"
381 [ benchIO "(*>) (sqrt n x sqrt n)" $ apDiscardFst value
382 , benchIO "(<*) (sqrt n x sqrt n)" $ apDiscardSnd value
383 , benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp value
384 , benchIO "liftA2 (sqrt n x sqrt n)" $ apLiftA2 value
385 ]
386 ]
388#ifdef USE_STREAMK
389o_n_space_applicative :: Int -> [Benchmark]
390o_n_space_applicative value =
391 [ bgroup "iterated"
392 [ benchIOSrc "(*>) (n times)" $
393 iterateSingleton ((*>) . pure) value
394 , benchIOSrc "(<*) (n times)" $
395 iterateSingleton (\x xs -> xs <* pure x) value
396 , benchIOSrc "(<*>) (n times)" $
397 iterateSingleton (\x xs -> pure (+ x) <*> xs) value
398 , benchIOSrc "liftA2 (n times)" $
399 iterateSingleton (AP.liftA2 (+) . pure) value
400 ]
401 ]
402#endif
404-------------------------------------------------------------------------------
405-- Monad
406-------------------------------------------------------------------------------
408o_1_space_monad :: Int -> [Benchmark]
409o_1_space_monad value =
410 [ bgroup "Monad"
411 [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value
412 , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value
413 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllOut)" $
414 filterAllOutM value
415 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllIn)" $
416 filterAllInM value
417 , benchIO "(>>=) (sqrt n x sqrt n) (filterSome)" $
418 filterSome value
419 , benchIO "(>>=) (sqrt n x sqrt n) (breakAfterSome)" $
420 breakAfterSome value
421 , benchIO "(>>=) (cubert n x cubert n x cubert n)" $
422 toNullM3 value
423 ]
424 ]
426#ifdef USE_STREAMK
427-- This is a good benchmark but inefficient way to compute primes. As we see a
428-- new prime we keep appending a division filter for all the future numbers.
429{-# INLINE sieve #-}
430sieve :: Monad m => StreamK m Int -> StreamK m Int
431sieve s = StreamK.concatEffect $ do
432 r <- StreamK.uncons s
433 case r of
434 Just (prime, rest) ->
435 -- XXX Use K.filter or rewrite to K.filter
436 let f = S.filter (\n -> n `mod` prime /= 0)
437 in pure $ prime `StreamK.cons` sieve (fromStream $ f $ toStream rest)
438 Nothing -> pure StreamK.nil
440o_n_space_iterated :: Int -> [Benchmark]
441o_n_space_iterated value =
442 [ bgroup "iterated"
443 [
444 benchIO "concatEffect prime sieve (n/4)"
445 (\n ->
446 S.fold Fold.sum
447 $ toStream
448 $ sieve
449 $ fromStream
450 $ S.enumerateFromTo 2 (value `div` 4 + n))
451 , benchIOSrc "(>>) (n times)" $
452 iterateSingleton ((>>) . pure) value
453 , benchIOSrc "(>>=) (n times)" $
454 iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value
455 ]
456 ]
457#endif
459o_n_space_monad :: Int -> [Benchmark]
460o_n_space_monad value =
461 [ bgroup "Monad"
462 [ benchIO "(>>=) (sqrt n x sqrt n) (toList)" $
463 toListM value
464 , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $
465 toListSome value
466 ]
467 ]
469-------------------------------------------------------------------------------
470-- Joining
471-------------------------------------------------------------------------------
473{-
474toKv :: Int -> (Int, Int)
475toKv p = (p, p)
477{-# INLINE joinWith #-}
478joinWith :: Common.MonadAsync m =>
479 ((Int -> Int -> Bool) -> Stream m Int -> Stream m Int -> Stream m b)
480 -> Int
481 -> Int
482 -> m ()
483joinWith j val i =
484 drain $ j (==) (sourceUnfoldrM val i) (sourceUnfoldrM val (val `div` 2))
486{-# INLINE joinMapWith #-}
487joinMapWith :: Common.MonadAsync m =>
488 (Stream m (Int, Int) -> Stream m (Int, Int) -> Stream m b)
489 -> Int
490 -> Int
491 -> m ()
492joinMapWith j val i =
493 drain
494 $ j
495 (fmap toKv (sourceUnfoldrM val i))
496 (fmap toKv (sourceUnfoldrM val (val `div` 2)))
498o_n_heap_buffering :: Int -> [Benchmark]
499o_n_heap_buffering value =
500 [ bgroup "buffered"
501 [
502 benchIOSrc1 "joinInnerGeneric (sqrtVal)"
503 $ joinWith S.joinInnerGeneric sqrtVal
504 , benchIOSrc1 "joinInner"
505 $ joinMapWith S.joinInner halfVal
506 , benchIOSrc1 "joinLeftGeneric (sqrtVal)"
507 $ joinWith S.joinLeftGeneric sqrtVal
508 , benchIOSrc1 "joinLeft "
509 $ joinMapWith S.joinLeft halfVal
510 , benchIOSrc1 "joinOuterGeneric (sqrtVal)"
511 $ joinWith S.joinOuterGeneric sqrtVal
512 , benchIOSrc1 "joinOuter"
513 $ joinMapWith S.joinOuter halfVal
514 , benchIOSrc1 "filterInStreamGenericBy (sqrtVal)"
515 $ joinWith S.filterInStreamGenericBy sqrtVal
516 , benchIOSrc1 "filterInStreamAscBy"
517 $ joinMapWith (S.filterInStreamAscBy compare) halfVal
518 ]
519 ]
521 where
523 halfVal = value `div` 2
524 sqrtVal = round $ sqrt (fromIntegral value :: Double)
525-}
527-------------------------------------------------------------------------------
528-- Main
529-------------------------------------------------------------------------------
531-- In addition to gauge options, the number of elements in the stream can be
532-- passed using the --stream-size option.
533--
534{-# ANN benchmarks "HLint: ignore" #-}
535benchmarks :: String -> Int -> [Benchmark]
536benchmarks moduleName size =
537 [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
538 [
539 -- multi-stream
540 o_1_space_joining size
541#ifdef USE_PRELUDE
542 , o_1_space_concatFoldable size
543#endif
544 , o_1_space_concat size
545 , o_1_space_applicative size
546 , o_1_space_monad size
547 ]
548 , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
549 [
550 -- multi-stream
551 o_n_space_monad size
552#ifdef USE_STREAMK
553 , o_n_space_merge size
554 , o_n_space_iterated size
555 , o_n_space_applicative size
556#endif
557 ]
558 {-
559 , bgroup (o_n_heap_prefix moduleName) $
560 -- multi-stream
561 o_n_heap_buffering size
562 -}
563 ]