git.iko.soy/streamly
on f2011df help sign in
streamly/benchmark/ArrayOps.hs
531 lines 17 kB history raw
1-- |
2-- Module : ArrayOps
3-- Copyright : (c) 2018 Harendra Kumar
4--
5-- License : MIT
6-- Maintainer : streamly@composewell.com
8{-# LANGUAGE CPP #-}
9{-# LANGUAGE FlexibleContexts #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE DeriveAnyClass #-}
12{-# LANGUAGE DeriveGeneric #-}
14module ArrayOps where
16-- import Control.Monad (when)
17import Control.Monad.IO.Class (MonadIO)
18-- import Data.Maybe (fromJust)
19import Prelude (Int, Bool, (+), ($), (==), (>), (.), Maybe(..), undefined)
20import qualified Prelude as P
21#ifdef DEVBUILD
22import qualified Data.Foldable as F
23#endif
24import qualified GHC.Exts as GHC
25-- import Control.DeepSeq (NFData)
26-- import GHC.Generics (Generic)
28import qualified Streamly as S hiding (foldMapWith, runStream)
29import qualified Streamly.Memory.Array as A
30import qualified Streamly.Prelude as S
32value, maxValue :: Int
33#ifdef LINEAR_ASYNC
34value = 10000
35#else
36value = 100000
37#endif
38maxValue = value + 1
40-------------------------------------------------------------------------------
41-- Benchmark ops
42-------------------------------------------------------------------------------
44-------------------------------------------------------------------------------
45-- Stream generation and elimination
46-------------------------------------------------------------------------------
48type Stream = A.Array
50{-# INLINE sourceUnfoldr #-}
51sourceUnfoldr :: MonadIO m => Int -> m (Stream Int)
52sourceUnfoldr n = S.fold (A.writeN value) $ S.unfoldr step n
53 where
54 step cnt =
55 if cnt > n + value
56 then Nothing
57 else (Just (cnt, cnt + 1))
59{-# INLINE sourceIntFromTo #-}
60sourceIntFromTo :: MonadIO m => Int -> m (Stream Int)
61sourceIntFromTo n = S.fold (A.writeN value) $ S.enumerateFromTo n (n + value)
63{-# INLINE sourceIntFromToFromStream #-}
64sourceIntFromToFromStream :: MonadIO m => Int -> m (Stream Int)
65sourceIntFromToFromStream n = S.fold A.write $ S.enumerateFromTo n (n + value)
67sourceIntFromToFromList :: MonadIO m => Int -> m (Stream Int)
68sourceIntFromToFromList n = P.return $ A.fromList $ [n..n + value]
70{-# INLINE sourceFromList #-}
71sourceFromList :: MonadIO m => Int -> m (Stream Int)
72sourceFromList n = S.fold (A.writeN value) $ S.fromList [n..n+value]
74{-# INLINE sourceIsList #-}
75sourceIsList :: Int -> Stream Int
76sourceIsList n = GHC.fromList [n..n+value]
78{-# INLINE sourceIsString #-}
79sourceIsString :: Int -> Stream P.Char
80sourceIsString n = GHC.fromString (P.replicate (n + value) 'a')
82{-
83-------------------------------------------------------------------------------
84-- Elimination
85-------------------------------------------------------------------------------
87{-# INLINE runStream #-}
88runStream :: Monad m => Stream m a -> m ()
89runStream = S.runStream
91{-# INLINE toList #-}
92toList :: Monad m => Stream m Int -> m [Int]
94{-# INLINE head #-}
95{-# INLINE last #-}
96{-# INLINE maximum #-}
97{-# INLINE minimum #-}
98{-# INLINE find #-}
99{-# INLINE findIndex #-}
100{-# INLINE elemIndex #-}
101{-# INLINE foldl1'Reduce #-}
102head, last, minimum, maximum, find, findIndex, elemIndex, foldl1'Reduce
103 :: Monad m => Stream m Int -> m (Maybe Int)
105{-# INLINE minimumBy #-}
106{-# INLINE maximumBy #-}
107minimumBy, maximumBy :: Monad m => Stream m Int -> m (Maybe Int)
109{-# INLINE foldl'Reduce #-}
110{-# INLINE foldl'ReduceMap #-}
111{-# INLINE foldlM'Reduce #-}
112{-# INLINE foldrMReduce #-}
113{-# INLINE length #-}
114{-# INLINE sum #-}
115{-# INLINE product #-}
116foldl'Reduce, foldl'ReduceMap, foldlM'Reduce, foldrMReduce, length, sum, product
117 :: Monad m
118 => Stream m Int -> m Int
120{-# INLINE foldl'Build #-}
121{-# INLINE foldlM'Build #-}
122{-# INLINE foldrMBuild #-}
123foldrMBuild, foldl'Build, foldlM'Build
124 :: Monad m
125 => Stream m Int -> m [Int]
127{-# INLINE all #-}
128{-# INLINE any #-}
129{-# INLINE and #-}
130{-# INLINE or #-}
131{-# INLINE null #-}
132{-# INLINE elem #-}
133{-# INLINE notElem #-}
134null, elem, notElem, all, any, and, or :: Monad m => Stream m Int -> m Bool
136{-# INLINE toNull #-}
137toNull :: Monad m => (t m a -> S.SerialT m a) -> t m a -> m ()
138toNull t = runStream . t
140{-# INLINE uncons #-}
141uncons :: Monad m => Stream m Int -> m ()
142uncons s = do
143 r <- S.uncons s
144 case r of
145 Nothing -> return ()
146 Just (_, t) -> uncons t
148{-# INLINE init #-}
149init :: Monad m => Stream m a -> m ()
150init s = S.init s >>= Prelude.mapM_ S.runStream
152{-# INLINE tail #-}
153tail :: Monad m => Stream m a -> m ()
154tail s = S.tail s >>= Prelude.mapM_ tail
156{-# INLINE nullHeadTail #-}
157nullHeadTail :: Monad m => Stream m Int -> m ()
158nullHeadTail s = do
159 r <- S.null s
160 when (not r) $ do
161 _ <- S.head s
162 S.tail s >>= Prelude.mapM_ nullHeadTail
164{-# INLINE mapM_ #-}
165mapM_ :: Monad m => Stream m Int -> m ()
166mapM_ = S.mapM_ (\_ -> return ())
168toList = S.toList
170{-# INLINE toRevList #-}
171toRevList :: Monad m => Stream m Int -> m [Int]
172toRevList = S.toRevList
174foldrMBuild = S.foldrM (\x xs -> xs >>= return . (x :)) (return [])
175foldl'Build = S.foldl' (flip (:)) []
176foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) []
178foldrMReduce = S.foldrM (\x xs -> xs >>= return . (x +)) (return 0)
179foldl'Reduce = S.foldl' (+) 0
180foldl'ReduceMap = P.fmap (+1) . S.foldl' (+) 0
181foldl1'Reduce = S.foldl1' (+)
182foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) 0
184last = S.last
185null = S.null
186head = S.head
187elem = S.elem maxValue
188notElem = S.notElem maxValue
189length = S.length
190all = S.all (<= maxValue)
191any = S.any (> maxValue)
192and = S.and . S.map (<= maxValue)
193or = S.or . S.map (> maxValue)
194find = S.find (== maxValue)
195findIndex = S.findIndex (== maxValue)
196elemIndex = S.elemIndex maxValue
197maximum = S.maximum
198minimum = S.minimum
199sum = S.sum
200product = S.product
201minimumBy = S.minimumBy compare
202maximumBy = S.maximumBy compare
203-}
205-------------------------------------------------------------------------------
206-- Transformation
207-------------------------------------------------------------------------------
209{-
210{-# INLINE transform #-}
211transform :: Stream a -> Stream a
212transform = P.id
213-}
215{-# INLINE composeN #-}
216composeN :: P.Monad m
217 => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)
218composeN n f x =
219 case n of
220 1 -> f x
221 2 -> f x P.>>= f
222 3 -> f x P.>>= f P.>>= f
223 4 -> f x P.>>= f P.>>= f P.>>= f
224 _ -> undefined
226{-# INLINE scanl' #-}
227{-# INLINE scanl1' #-}
228{-# INLINE map #-}
229{-
230{-# INLINE fmap #-}
231{-# INLINE mapMaybe #-}
232{-# INLINE filterEven #-}
233{-# INLINE filterAllOut #-}
234{-# INLINE filterAllIn #-}
235{-# INLINE takeOne #-}
236{-# INLINE takeAll #-}
237{-# INLINE takeWhileTrue #-}
238{-# INLINE takeWhileMTrue #-}
239{-# INLINE dropOne #-}
240{-# INLINE dropAll #-}
241{-# INLINE dropWhileTrue #-}
242{-# INLINE dropWhileMTrue #-}
243{-# INLINE dropWhileFalse #-}
244{-# INLINE findIndices #-}
245{-# INLINE elemIndices #-}
246{-# INLINE insertBy #-}
247{-# INLINE deleteBy #-}
248{-# INLINE reverse #-}
249{-# INLINE foldrS #-}
250{-# INLINE foldrSMap #-}
251{-# INLINE foldrT #-}
252{-# INLINE foldrTMap #-}
253 -}
254scanl' , scanl1', map{-, fmap, mapMaybe, filterEven, filterAllOut,
255 filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropOne,
256 dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse,
257 findIndices, elemIndices, insertBy, deleteBy, reverse,
258 foldrS, foldrSMap, foldrT, foldrTMap -}
259 :: MonadIO m => Int -> Stream Int -> m (Stream Int)
261{-
262{-# INLINE mapMaybeM #-}
263mapMaybeM :: S.MonadAsync m => Int -> Stream m Int -> m ()
265{-# INLINE mapM #-}
266{-# INLINE map' #-}
267{-# INLINE fmap' #-}
268mapM, map' :: (S.IsStream t, S.MonadAsync m)
269 => (t m Int -> S.SerialT m Int) -> Int -> t m Int -> m ()
271fmap' :: (S.IsStream t, S.MonadAsync m, P.Functor (t m))
272 => (t m Int -> S.SerialT m Int) -> Int -> t m Int -> m ()
274{-# INLINE sequence #-}
275sequence :: (S.IsStream t, S.MonadAsync m)
276 => (t m Int -> S.SerialT m Int) -> t m (m Int) -> m ()
277 -}
279{-# INLINE onArray #-}
280onArray
281 :: MonadIO m => (S.SerialT m Int -> S.SerialT m Int)
282 -> Stream Int
283 -> m (Stream Int)
284onArray f arr = S.fold (A.writeN value) $ f $ (S.unfold A.read arr)
286scanl' n = composeN n $ onArray $ S.scanl' (+) 0
287scanl1' n = composeN n $ onArray $ S.scanl1' (+)
288map n = composeN n $ onArray $ S.map (+1)
289-- map n = composeN n $ A.map (+1)
290{-
291fmap n = composeN n $ Prelude.fmap (+1)
292fmap' t n = composeN' n $ t . Prelude.fmap (+1)
293map' t n = composeN' n $ t . S.map (+1)
294mapM t n = composeN' n $ t . S.mapM return
295mapMaybe n = composeN n $ S.mapMaybe
296 (\x -> if Prelude.odd x then Nothing else Just x)
297mapMaybeM n = composeN n $ S.mapMaybeM
298 (\x -> if Prelude.odd x then return Nothing else return $ Just x)
299sequence t = transform . t . S.sequence
300filterEven n = composeN n $ S.filter even
301filterAllOut n = composeN n $ S.filter (> maxValue)
302filterAllIn n = composeN n $ S.filter (<= maxValue)
303takeOne n = composeN n $ S.take 1
304takeAll n = composeN n $ S.take maxValue
305takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)
306takeWhileMTrue n = composeN n $ S.takeWhileM (return . (<= maxValue))
307dropOne n = composeN n $ S.drop 1
308dropAll n = composeN n $ S.drop maxValue
309dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)
310dropWhileMTrue n = composeN n $ S.dropWhileM (return . (<= maxValue))
311dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)
312findIndices n = composeN n $ S.findIndices (== maxValue)
313elemIndices n = composeN n $ S.elemIndices maxValue
314insertBy n = composeN n $ S.insertBy compare maxValue
315deleteBy n = composeN n $ S.deleteBy (>=) maxValue
316reverse n = composeN n $ S.reverse
317foldrS n = composeN n $ S.foldrS S.cons S.nil
318foldrSMap n = composeN n $ S.foldrS (\x xs -> x + 1 `S.cons` xs) S.nil
319foldrT n = composeN n $ S.foldrT S.cons S.nil
320foldrTMap n = composeN n $ S.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
322-------------------------------------------------------------------------------
323-- Iteration
324-------------------------------------------------------------------------------
326iterStreamLen, maxIters :: Int
327iterStreamLen = 10
328maxIters = 10000
330{-# INLINE iterateSource #-}
331iterateSource
332 :: S.MonadAsync m
333 => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
334iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
335 where
336 f (0 :: Int) m = g m
337 f x m = g (f (x P.- 1) m)
339{-# INLINE iterateMapM #-}
340{-# INLINE iterateScan #-}
341{-# INLINE iterateScanl1 #-}
342{-# INLINE iterateFilterEven #-}
343{-# INLINE iterateTakeAll #-}
344{-# INLINE iterateDropOne #-}
345{-# INLINE iterateDropWhileFalse #-}
346{-# INLINE iterateDropWhileTrue #-}
347iterateMapM, iterateScan, iterateScanl1, iterateFilterEven, iterateTakeAll,
348 iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue
349 :: S.MonadAsync m
350 => Int -> Stream m Int
352-- this is quadratic
353iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
354-- so is this
355iterateScanl1 = iterateSource (S.scanl1' (+)) (maxIters `div` 10)
357iterateMapM = iterateSource (S.mapM return) maxIters
358iterateFilterEven = iterateSource (S.filter even) maxIters
359iterateTakeAll = iterateSource (S.take maxValue) maxIters
360iterateDropOne = iterateSource (S.drop 1) maxIters
361iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue)) maxIters
362iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
364-------------------------------------------------------------------------------
365-- Zipping and concat
366-------------------------------------------------------------------------------
368{-# INLINE zip #-}
369{-# INLINE zipM #-}
370{-# INLINE mergeBy #-}
371zip, zipM, mergeBy :: Monad m => Stream m Int -> m ()
373zip src = do
374 r <- S.tail src
375 let src1 = fromJust r
376 transform (S.zipWith (,) src src1)
377zipM src = do
378 r <- S.tail src
379 let src1 = fromJust r
380 transform (S.zipWithM (curry return) src src1)
382mergeBy src = do
383 r <- S.tail src
384 let src1 = fromJust r
385 transform (S.mergeBy P.compare src src1)
387{-# INLINE isPrefixOf #-}
388{-# INLINE isSubsequenceOf #-}
389isPrefixOf, isSubsequenceOf :: Monad m => Stream m Int -> m Bool
391isPrefixOf src = S.isPrefixOf src src
392isSubsequenceOf src = S.isSubsequenceOf src src
394{-# INLINE stripPrefix #-}
395stripPrefix :: Monad m => Stream m Int -> m ()
396stripPrefix src = do
397 _ <- S.stripPrefix src src
398 return ()
400{-# INLINE zipAsync #-}
401{-# INLINE zipAsyncM #-}
402{-# INLINE zipAsyncAp #-}
403zipAsync, zipAsyncAp, zipAsyncM :: S.MonadAsync m => Stream m Int -> m ()
405zipAsync src = do
406 r <- S.tail src
407 let src1 = fromJust r
408 transform (S.zipAsyncWith (,) src src1)
410zipAsyncM src = do
411 r <- S.tail src
412 let src1 = fromJust r
413 transform (S.zipAsyncWithM (curry return) src src1)
415zipAsyncAp src = do
416 r <- S.tail src
417 let src1 = fromJust r
418 transform (S.zipAsyncly $ (,) <$> S.serially src
419 <*> S.serially src1)
421{-# INLINE eqBy #-}
422eqBy :: (Monad m, P.Eq a) => Stream m a -> m P.Bool
423eqBy src = S.eqBy (==) src src
425{-# INLINE cmpBy #-}
426cmpBy :: (Monad m, P.Ord a) => Stream m a -> m P.Ordering
427cmpBy src = S.cmpBy P.compare src src
429concatStreamLen, maxNested :: Int
430concatStreamLen = 1
431maxNested = 100000
433{-# INLINE concatMap #-}
434concatMap :: S.MonadAsync m => Int -> Stream m Int
435concatMap n = S.concatMap (\_ -> sourceUnfoldrMN maxNested n)
436 (sourceUnfoldrMN concatStreamLen n)
438-------------------------------------------------------------------------------
439-- Mixed Composition
440-------------------------------------------------------------------------------
442{-# INLINE scanMap #-}
443{-# INLINE dropMap #-}
444{-# INLINE dropScan #-}
445{-# INLINE takeDrop #-}
446{-# INLINE takeScan #-}
447{-# INLINE takeMap #-}
448{-# INLINE filterDrop #-}
449{-# INLINE filterTake #-}
450{-# INLINE filterScan #-}
451{-# INLINE filterScanl1 #-}
452{-# INLINE filterMap #-}
453scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
454 filterTake, filterScan, filterScanl1, filterMap
455 :: Monad m => Int -> Stream m Int -> m ()
457scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
458dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
459dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
460takeDrop n = composeN n $ S.drop 1 . S.take maxValue
461takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue
462takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue
463filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
464filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
465filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
466filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
467filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
469data Pair a b = Pair !a !b deriving (Generic, NFData)
471{-# INLINE sumProductFold #-}
472sumProductFold :: Monad m => Stream m Int -> m (Int, Int)
473sumProductFold = S.foldl' (\(s,p) x -> (s + x, p P.* x)) (0,1)
475{-# INLINE sumProductScan #-}
476sumProductScan :: Monad m => Stream m Int -> m (Pair Int Int)
477sumProductScan = S.foldl' (\(Pair _ p) (s0,x) -> Pair s0 (p P.* x)) (Pair 0 1)
478 . S.scanl' (\(s,_) x -> (s + x,x)) (0,0)
480-------------------------------------------------------------------------------
481-- Pure stream operations
482-------------------------------------------------------------------------------
484-}
485{-# INLINE eqInstance #-}
486eqInstance :: Stream Int -> Bool
487eqInstance src = src == src
489{-# INLINE eqInstanceNotEq #-}
490eqInstanceNotEq :: Stream Int -> Bool
491eqInstanceNotEq src = src P./= src
493{-# INLINE ordInstance #-}
494ordInstance :: Stream Int -> Bool
495ordInstance src = src P.< src
497{-# INLINE ordInstanceMin #-}
498ordInstanceMin :: Stream Int -> Stream Int
499ordInstanceMin src = P.min src src
501{-# INLINE showInstance #-}
502showInstance :: Stream Int -> P.String
503showInstance src = P.show src
505{-# INLINE readInstance #-}
506readInstance :: P.String -> Stream Int
507readInstance str =
508 let r = P.reads str
509 in case r of
510 [(x,"")] -> x
511 _ -> P.error "readInstance: no parse"
513{-# INLINE pureFoldl' #-}
514pureFoldl' :: MonadIO m => Stream Int -> m Int
515pureFoldl' = S.foldl' (+) 0 . S.unfold A.read
517#ifdef DEVBUILD
518{-# INLINE foldableFoldl' #-}
519foldableFoldl' :: Stream Int -> Int
520foldableFoldl' = F.foldl' (+) 0
522{-# INLINE foldableSum #-}
523foldableSum :: Stream Int -> Int
524foldableSum = P.sum
525#endif
527{-
528{-# INLINE traversableMapM #-}
529traversableMapM :: Stream Identity Int -> IO (Stream Identity Int)
530traversableMapM = P.mapM return
531-}