git.iko.soy/streamly
on 52b11eb help sign in
streamly/benchmark/StreamKOps.hs
410 lines 12 kB history raw
1-- |
2-- Module : StreamKOps
3-- Copyright : (c) 2018 Harendra Kumar
4--
5-- License : BSD3
6-- Maintainer : streamly@composewell.com
8{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE ScopedTypeVariables #-}
11module StreamKOps where
13import Control.Monad (when)
14import Data.Maybe (isJust)
15import Prelude
16 (Monad, Int, (+), ($), (.), return, even, (>), (<=), div,
17 subtract, undefined, Maybe(..), not, (>>=),
18 maxBound, flip, (<$>), (<*>), round, (/), (**), (<))
19import qualified Prelude as P
20import qualified Data.List as List
22import qualified Streamly.Internal.Data.Stream.StreamK as S
23import qualified Streamly.Internal.Data.Stream.Prelude as SP
24import qualified Streamly.Internal.Data.SVar as S
26value, value2, value3, value16, maxValue :: Int
27value = 100000
28value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
29value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop
30value16 = round (P.fromIntegral value**(1/16::P.Double)) -- triple nested loop
31maxValue = value
33-------------------------------------------------------------------------------
34-- Benchmark ops
35-------------------------------------------------------------------------------
37{-# INLINE toNull #-}
38{-# INLINE uncons #-}
39{-# INLINE nullTail #-}
40{-# INLINE headTail #-}
41{-# INLINE zip #-}
42toNull, uncons, nullTail, headTail, zip
43 :: Monad m
44 => Stream m Int -> m ()
46{-# INLINE toList #-}
47toList :: Monad m => Stream m Int -> m [Int]
48{-# INLINE foldl #-}
49foldl :: Monad m => Stream m Int -> m Int
50{-# INLINE last #-}
51last :: Monad m => Stream m Int -> m (Maybe Int)
53-------------------------------------------------------------------------------
54-- Stream generation and elimination
55-------------------------------------------------------------------------------
57type Stream m a = S.Stream m a
59{-# INLINE sourceUnfoldr #-}
60sourceUnfoldr :: Int -> Stream m Int
61sourceUnfoldr n = S.unfoldr step n
62 where
63 step cnt =
64 if cnt > n + value
65 then Nothing
66 else Just (cnt, cnt + 1)
68{-# INLINE sourceUnfoldrN #-}
69sourceUnfoldrN :: Int -> Int -> Stream m Int
70sourceUnfoldrN m n = S.unfoldr step n
71 where
72 step cnt =
73 if cnt > n + m
74 then Nothing
75 else Just (cnt, cnt + 1)
77{-# INLINE sourceUnfoldrM #-}
78sourceUnfoldrM :: S.MonadAsync m => Int -> Stream m Int
79sourceUnfoldrM n = S.unfoldrM step n
80 where
81 step cnt =
82 if cnt > n + value
83 then return Nothing
84 else return (Just (cnt, cnt + 1))
86{-# INLINE sourceUnfoldrMN #-}
87sourceUnfoldrMN :: S.MonadAsync m => Int -> Int -> Stream m Int
88sourceUnfoldrMN m n = S.unfoldrM step n
89 where
90 step cnt =
91 if cnt > n + m
92 then return Nothing
93 else return (Just (cnt, cnt + 1))
95{-
96{-# INLINE sourceFromEnum #-}
97sourceFromEnum :: Monad m => Int -> Stream m Int
98sourceFromEnum n = S.enumFromStepN n 1 value
99-}
101{-# INLINE sourceFromFoldable #-}
102sourceFromFoldable :: Int -> Stream m Int
103sourceFromFoldable n = S.fromFoldable [n..n+value]
105{-
106{-# INLINE sourceFromFoldableM #-}
107sourceFromFoldableM :: S.MonadAsync m => Int -> Stream m Int
108sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])
109-}
111{-# INLINE sourceFoldMapWith #-}
112sourceFoldMapWith :: Int -> Stream m Int
113sourceFoldMapWith n = SP.foldMapWith S.serial S.yield [n..n+value]
115{-# INLINE sourceFoldMapWithM #-}
116sourceFoldMapWithM :: Monad m => Int -> Stream m Int
117sourceFoldMapWithM n = SP.foldMapWith S.serial (S.yieldM . return) [n..n+value]
119{-# INLINE source #-}
120source :: S.MonadAsync m => Int -> Stream m Int
121source = sourceUnfoldrM
123-------------------------------------------------------------------------------
124-- Elimination
125-------------------------------------------------------------------------------
127{-# INLINE runStream #-}
128runStream :: Monad m => Stream m a -> m ()
129runStream = S.drain
130-- runStream = S.mapM_ (\_ -> return ())
132{-# INLINE mapM_ #-}
133mapM_ :: Monad m => Stream m a -> m ()
134mapM_ = S.mapM_ (\_ -> return ())
136toNull = runStream
137uncons s = do
138 r <- S.uncons s
139 case r of
140 Nothing -> return ()
141 Just (_, t) -> uncons t
143{-# INLINE init #-}
144init :: (Monad m, S.IsStream t) => t m a -> m ()
145init s = do
146 t <- S.init s
147 P.mapM_ S.drain t
149{-# INLINE tail #-}
150tail :: (Monad m, S.IsStream t) => t m a -> m ()
151tail s = S.tail s >>= P.mapM_ tail
153nullTail s = do
154 r <- S.null s
155 when (not r) $ S.tail s >>= P.mapM_ nullTail
157headTail s = do
158 h <- S.head s
159 when (isJust h) $ S.tail s >>= P.mapM_ headTail
161toList = S.toList
162foldl = S.foldl' (+) 0
163last = S.last
165-------------------------------------------------------------------------------
166-- Transformation
167-------------------------------------------------------------------------------
169{-# INLINE transform #-}
170transform :: Monad m => Stream m a -> m ()
171transform = runStream
173{-# INLINE composeN #-}
174composeN
175 :: Monad m
176 => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
177composeN n f =
178 case n of
179 1 -> transform . f
180 2 -> transform . f . f
181 3 -> transform . f . f . f
182 4 -> transform . f . f . f . f
183 _ -> undefined
185{-# INLINE scan #-}
186{-# INLINE map #-}
187{-# INLINE fmap #-}
188{-# INLINE filterEven #-}
189{-# INLINE filterAllOut #-}
190{-# INLINE filterAllIn #-}
191{-# INLINE takeOne #-}
192{-# INLINE takeAll #-}
193{-# INLINE takeWhileTrue #-}
194{-# INLINE dropOne #-}
195{-# INLINE dropAll #-}
196{-# INLINE dropWhileTrue #-}
197{-# INLINE dropWhileFalse #-}
198{-# INLINE foldlS #-}
199{-# INLINE concatMap #-}
200scan, map, fmap, filterEven, filterAllOut,
201 filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropOne,
202 dropWhileTrue, dropWhileFalse, foldlS, concatMap
203 :: Monad m
204 => Int -> Stream m Int -> m ()
206{-# INLINE mapM #-}
207{-# INLINE mapMSerial #-}
208{-# INLINE intersperse #-}
209mapM, mapMSerial, intersperse
210 :: S.MonadAsync m => Int -> Stream m Int -> m ()
212scan n = composeN n $ S.scanl' (+) 0
213map n = composeN n $ P.fmap (+1)
214fmap n = composeN n $ P.fmap (+1)
215mapM n = composeN n $ S.mapM return
216mapMSerial n = composeN n $ S.mapMSerial return
217filterEven n = composeN n $ S.filter even
218filterAllOut n = composeN n $ S.filter (> maxValue)
219filterAllIn n = composeN n $ S.filter (<= maxValue)
220takeOne n = composeN n $ S.take 1
221takeAll n = composeN n $ S.take maxValue
222takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)
223dropOne n = composeN n $ S.drop 1
224dropAll n = composeN n $ S.drop maxValue
225dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)
226dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
227foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
228-- We use a (sqrt n) element stream as source and then concat the same stream
229-- for each element to produce an n element stream.
230concatMap n = composeN n $ (\s -> S.concatMap (\_ -> s) s)
231intersperse n = composeN n $ S.intersperse maxValue
233-------------------------------------------------------------------------------
234-- Iteration
235-------------------------------------------------------------------------------
237iterStreamLen, maxIters :: Int
238iterStreamLen = 10
239maxIters = 10000
241{-# INLINE iterateSource #-}
242iterateSource
243 :: S.MonadAsync m
244 => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
245iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
246 where
247 f (0 :: Int) m = g m
248 f x m = g (f (x P.- 1) m)
250{-# INLINE iterateMapM #-}
251{-# INLINE iterateScan #-}
252{-# INLINE iterateFilterEven #-}
253{-# INLINE iterateTakeAll #-}
254{-# INLINE iterateDropOne #-}
255{-# INLINE iterateDropWhileFalse #-}
256{-# INLINE iterateDropWhileTrue #-}
257iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,
258 iterateDropWhileFalse, iterateDropWhileTrue
259 :: S.MonadAsync m
260 => Int -> Stream m Int
262-- this is quadratic
263iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
264iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue))
265 (maxIters `div` 10)
267iterateMapM = iterateSource (S.mapM return) maxIters
268iterateFilterEven = iterateSource (S.filter even) maxIters
269iterateTakeAll = iterateSource (S.take maxValue) maxIters
270iterateDropOne = iterateSource (S.drop 1) maxIters
271iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
273-------------------------------------------------------------------------------
274-- Zipping and concat
275-------------------------------------------------------------------------------
277zip src = transform $ S.zipWith (,) src src
279{-# INLINE concatMapRepl4xN #-}
280concatMapRepl4xN :: Monad m => Stream m Int -> m ()
281concatMapRepl4xN src = transform $ (S.concatMap (S.replicate 4) src)
283-------------------------------------------------------------------------------
284-- Mixed Composition
285-------------------------------------------------------------------------------
287{-# INLINE scanMap #-}
288{-# INLINE dropMap #-}
289{-# INLINE dropScan #-}
290{-# INLINE takeDrop #-}
291{-# INLINE takeScan #-}
292{-# INLINE takeMap #-}
293{-# INLINE filterDrop #-}
294{-# INLINE filterTake #-}
295{-# INLINE filterScan #-}
296{-# INLINE filterMap #-}
297scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
298 filterTake, filterScan, filterMap
299 :: Monad m => Int -> Stream m Int -> m ()
301scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
302dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
303dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
304takeDrop n = composeN n $ S.drop 1 . S.take maxValue
305takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue
306takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue
307filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
308filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
309filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
310filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
312-------------------------------------------------------------------------------
313-- Nested Composition
314-------------------------------------------------------------------------------
316{-# INLINE toNullApNested #-}
317toNullApNested :: Monad m => Stream m Int -> m ()
318toNullApNested s = runStream $ do
319 (+) <$> s <*> s
321{-# INLINE toNullNested #-}
322toNullNested :: Monad m => Stream m Int -> m ()
323toNullNested s = runStream $ do
324 x <- s
325 y <- s
326 return $ x + y
328{-# INLINE toNullNested3 #-}
329toNullNested3 :: Monad m => Stream m Int -> m ()
330toNullNested3 s = runStream $ do
331 x <- s
332 y <- s
333 z <- s
334 return $ x + y + z
336{-# INLINE filterAllOutNested #-}
337filterAllOutNested
338 :: Monad m
339 => Stream m Int -> m ()
340filterAllOutNested str = runStream $ do
341 x <- str
342 y <- str
343 let s = x + y
344 if s < 0
345 then return s
346 else S.nil
348{-# INLINE filterAllInNested #-}
349filterAllInNested
350 :: Monad m
351 => Stream m Int -> m ()
352filterAllInNested str = runStream $ do
353 x <- str
354 y <- str
355 let s = x + y
356 if s > 0
357 then return s
358 else S.nil
360-------------------------------------------------------------------------------
361-- Nested Composition Pure lists
362-------------------------------------------------------------------------------
364{-# INLINE sourceUnfoldrList #-}
365sourceUnfoldrList :: Int -> Int -> [Int]
366sourceUnfoldrList maxval n = List.unfoldr step n
367 where
368 step cnt =
369 if cnt > n + maxval
370 then Nothing
371 else Just (cnt, cnt + 1)
373{-# INLINE toNullApNestedList #-}
374toNullApNestedList :: [Int] -> [Int]
375toNullApNestedList s = (+) <$> s <*> s
377{-# INLINE toNullNestedList #-}
378toNullNestedList :: [Int] -> [Int]
379toNullNestedList s = do
380 x <- s
381 y <- s
382 return $ x + y
384{-# INLINE toNullNestedList3 #-}
385toNullNestedList3 :: [Int] -> [Int]
386toNullNestedList3 s = do
387 x <- s
388 y <- s
389 z <- s
390 return $ x + y + z
392{-# INLINE filterAllOutNestedList #-}
393filterAllOutNestedList :: [Int] -> [Int]
394filterAllOutNestedList str = do
395 x <- str
396 y <- str
397 let s = x + y
398 if s < 0
399 then return s
400 else []
402{-# INLINE filterAllInNestedList #-}
403filterAllInNestedList :: [Int] -> [Int]
404filterAllInNestedList str = do
405 x <- str
406 y <- str
407 let s = x + y
408 if s > 0
409 then return s
410 else []