streamly-0.7.2: benchmark/Streamly/Benchmark/Data/Fold.hs
-- |
-- Module : Streamly.Benchmark.Data.Fold
-- Copyright : (c) 2018 Composewell
--
-- License : MIT
-- Maintainer : streamly@composewell.com
{-# LANGUAGE FlexibleContexts #-}
module Main (main) where
import Control.DeepSeq (NFData(..))
import Data.Monoid (Last(..))
import System.Random (randomRIO)
import Prelude (IO, Int, Double, String, (>), (<*>), (<$>), (+), ($),
(<=), Monad(..), (==), Maybe(..), (.), fromIntegral,
compare, (>=), concat, seq)
import qualified Streamly as S hiding (runStream)
import qualified Streamly.Prelude as S
import qualified Streamly.Internal.Data.Fold as FL
import qualified Streamly.Internal.Data.Pipe as Pipe
import qualified Streamly.Internal.Data.Sink as Sink
import qualified Streamly.Memory.Array as A
import qualified Streamly.Internal.Memory.Array as IA
import qualified Streamly.Internal.Data.Fold as IFL
import qualified Streamly.Internal.Prelude as IP
import Gauge
import Streamly hiding (runStream)
import Streamly.Benchmark.Common
-- We need a monadic bind here to make sure that the function f does not get
-- completely optimized out by the compiler in some cases.
{-# INLINE sourceUnfoldrM #-}
sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
sourceUnfoldrM value n = S.unfoldrM step n
where
step cnt =
if cnt > n + value
then return Nothing
else return (Just (cnt, cnt + 1))
{-# INLINE source #-}
source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
source = sourceUnfoldrM
-- | Takes a fold method, and uses it with a default source.
{-# INLINE benchIOSink #-}
benchIOSink
:: (IsStream t, NFData b)
=> Int -> String -> (t IO Int -> IO b) -> Benchmark
benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source value
-------------------------------------------------------------------------------
-- Stream folds
-------------------------------------------------------------------------------
o_1_space_serial_folds :: Int -> [Benchmark]
o_1_space_serial_folds value =
[ bgroup
"serially"
[ bgroup
"folds"
[ benchIOSink value "drain" (S.fold FL.drain)
, benchIOSink value "drainN" (S.fold (IFL.drainN value))
, benchIOSink
value
"drainWhileTrue"
(S.fold (IFL.drainWhile $ (<=) (value + 1)))
, benchIOSink
value
"drainWhileFalse"
(S.fold (IFL.drainWhile $ (>=) (value + 1)))
, benchIOSink value "sink" (S.fold $ Sink.toFold Sink.drain)
, benchIOSink value "last" (S.fold FL.last)
, benchIOSink value "lastN.1" (S.fold (IA.lastN 1))
, benchIOSink value "lastN.10" (S.fold (IA.lastN 10))
, benchIOSink value "length" (S.fold FL.length)
, benchIOSink value "sum" (S.fold FL.sum)
, benchIOSink value "product" (S.fold FL.product)
, benchIOSink value "maximumBy" (S.fold (FL.maximumBy compare))
, benchIOSink value "maximum" (S.fold FL.maximum)
, benchIOSink value "minimumBy" (S.fold (FL.minimumBy compare))
, benchIOSink value "minimum" (S.fold FL.minimum)
, benchIOSink
value
"mean"
(\s ->
S.fold
FL.mean
(S.map (fromIntegral :: Int -> Double) s))
, benchIOSink
value
"variance"
(\s ->
S.fold
FL.variance
(S.map (fromIntegral :: Int -> Double) s))
, benchIOSink
value
"stdDev"
(\s ->
S.fold
FL.stdDev
(S.map (fromIntegral :: Int -> Double) s))
, benchIOSink
value
"mconcat"
(S.fold FL.mconcat . (S.map (Last . Just)))
, benchIOSink
value
"foldMap"
(S.fold (FL.foldMap (Last . Just)))
, benchIOSink value "index" (S.fold (FL.index (value + 1)))
, benchIOSink value "head" (S.fold FL.head)
, benchIOSink value "find" (S.fold (FL.find (== (value + 1))))
, benchIOSink
value
"findIndex"
(S.fold (FL.findIndex (== (value + 1))))
, benchIOSink
value
"elemIndex"
(S.fold (FL.elemIndex (value + 1)))
, benchIOSink value "null" (S.fold FL.null)
, benchIOSink value "elem" (S.fold (FL.elem (value + 1)))
, benchIOSink value "notElem" (S.fold (FL.notElem (value + 1)))
, benchIOSink value "all" (S.fold (FL.all (<= (value + 1))))
, benchIOSink value "any" (S.fold (FL.any (> (value + 1))))
, benchIOSink
value
"and"
(\s -> S.fold FL.and (S.map (<= (value + 1)) s))
, benchIOSink
value
"or"
(\s -> S.fold FL.or (S.map (> (value + 1)) s))
]
]
]
o_1_space_serial_foldsTransforms :: Int -> [Benchmark]
o_1_space_serial_foldsTransforms value =
[ bgroup
"serially"
[ bgroup
"folds-transforms"
[ benchIOSink value "drain" (S.fold FL.drain)
, benchIOSink value "lmap" (S.fold (IFL.lmap (+ 1) FL.drain))
, benchIOSink
value
"pipe-mapM"
(S.fold
(IFL.transform
(Pipe.mapM (\x -> return $ x + 1))
FL.drain))
]
]
]
o_1_space_serial_foldsCompositions :: Int -> [Benchmark]
o_1_space_serial_foldsCompositions value =
[ bgroup
"serially"
[ bgroup
"folds-compositions" -- Applicative
[ benchIOSink
value
"all,any"
(S.fold
((,) <$> FL.all (<= (value + 1)) <*>
FL.any (> (value + 1))))
, benchIOSink
value
"sum,length"
(S.fold ((,) <$> FL.sum <*> FL.length))
]
]
]
o_n_heap_serial_folds :: Int -> [Benchmark]
o_n_heap_serial_folds value =
[ bgroup
"serially"
[ bgroup
"foldl"
-- Left folds for building a structure are inherently non-streaming
-- as the structure cannot be lazily consumed until fully built.
[ benchIOSink value "toStream" (S.fold IP.toStream)
, benchIOSink value "toStreamRev" (S.fold IP.toStreamRev)
, benchIOSink value "toList" (S.fold FL.toList)
, benchIOSink value "toListRevF" (S.fold IFL.toListRevF)
-- Converting the stream to an array
, benchIOSink value "lastN.Max" (S.fold (IA.lastN (value + 1)))
, benchIOSink value "writeN" (S.fold (A.writeN value))
]
]
]
-------------------------------------------------------------------------------
-- Driver
-------------------------------------------------------------------------------
main :: IO ()
main = do
(value, cfg, benches) <- parseCLIOpts defaultStreamSize
value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
where
allBenchmarks value =
[ bgroup
"o-1-space"
[ bgroup "fold" $
concat
[ o_1_space_serial_folds value
, o_1_space_serial_foldsTransforms value
, o_1_space_serial_foldsCompositions value
]
]
, bgroup
"o-n-heap"
[bgroup "fold" $ concat [o_n_heap_serial_folds value]]
]