git.iko.soy/streamly
on 6cd235f help sign in
streamly/benchmark/ArrayOps.hs
527 lines 16 kB history raw
1-- |
2-- Module : ArrayOps
3-- Copyright : (c) 2018 Harendra Kumar
4--
5-- License : MIT
6-- Maintainer : harendra.kumar@gmail.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 Data.Functor.Identity (Identity, runIdentity)
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.Prelude as S
30import qualified Streamly.Array as A
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 :: Int -> Stream Int
52sourceUnfoldr n = runIdentity $ A.fromStreamN 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 :: Int -> Stream Int
61sourceIntFromTo n = runIdentity $
62 A.fromStreamN value $ S.enumerateFromTo n (n + value)
64{-# INLINE sourceIntFromToFromStream #-}
65sourceIntFromToFromStream :: Int -> Stream Int
66sourceIntFromToFromStream n = runIdentity $
67 A.fromStream $ S.enumerateFromTo n (n + value)
69sourceIntFromToFromList :: Int -> Stream Int
70sourceIntFromToFromList n = A.fromList $ [n..n + value]
72{-# INLINE sourceFromList #-}
73sourceFromList :: Int -> Stream Int
74sourceFromList n = runIdentity $ A.fromStreamN value $ S.fromList [n..n+value]
76{-# INLINE sourceIsList #-}
77sourceIsList :: Int -> Stream Int
78sourceIsList n = runIdentity $ A.fromStreamN value $ GHC.fromList [n..n+value]
80{-# INLINE sourceIsString #-}
81sourceIsString :: Int -> Stream P.Char
82sourceIsString n = runIdentity $
83 A.fromStreamN value $ GHC.fromString (P.replicate (n + value) 'a')
85{-
86-------------------------------------------------------------------------------
87-- Elimination
88-------------------------------------------------------------------------------
90{-# INLINE runStream #-}
91runStream :: Monad m => Stream m a -> m ()
92runStream = S.runStream
94{-# INLINE toList #-}
95toList :: Monad m => Stream m Int -> m [Int]
97{-# INLINE head #-}
98{-# INLINE last #-}
99{-# INLINE maximum #-}
100{-# INLINE minimum #-}
101{-# INLINE find #-}
102{-# INLINE findIndex #-}
103{-# INLINE elemIndex #-}
104{-# INLINE foldl1'Reduce #-}
105head, last, minimum, maximum, find, findIndex, elemIndex, foldl1'Reduce
106 :: Monad m => Stream m Int -> m (Maybe Int)
108{-# INLINE minimumBy #-}
109{-# INLINE maximumBy #-}
110minimumBy, maximumBy :: Monad m => Stream m Int -> m (Maybe Int)
112{-# INLINE foldl'Reduce #-}
113{-# INLINE foldl'ReduceMap #-}
114{-# INLINE foldlM'Reduce #-}
115{-# INLINE foldrMReduce #-}
116{-# INLINE length #-}
117{-# INLINE sum #-}
118{-# INLINE product #-}
119foldl'Reduce, foldl'ReduceMap, foldlM'Reduce, foldrMReduce, length, sum, product
120 :: Monad m
121 => Stream m Int -> m Int
123{-# INLINE foldl'Build #-}
124{-# INLINE foldlM'Build #-}
125{-# INLINE foldrMBuild #-}
126foldrMBuild, foldl'Build, foldlM'Build
127 :: Monad m
128 => Stream m Int -> m [Int]
130{-# INLINE all #-}
131{-# INLINE any #-}
132{-# INLINE and #-}
133{-# INLINE or #-}
134{-# INLINE null #-}
135{-# INLINE elem #-}
136{-# INLINE notElem #-}
137null, elem, notElem, all, any, and, or :: Monad m => Stream m Int -> m Bool
139{-# INLINE toNull #-}
140toNull :: Monad m => (t m a -> S.SerialT m a) -> t m a -> m ()
141toNull t = runStream . t
143{-# INLINE uncons #-}
144uncons :: Monad m => Stream m Int -> m ()
145uncons s = do
146 r <- S.uncons s
147 case r of
148 Nothing -> return ()
149 Just (_, t) -> uncons t
151{-# INLINE init #-}
152init :: Monad m => Stream m a -> m ()
153init s = S.init s >>= Prelude.mapM_ S.runStream
155{-# INLINE tail #-}
156tail :: Monad m => Stream m a -> m ()
157tail s = S.tail s >>= Prelude.mapM_ tail
159{-# INLINE nullHeadTail #-}
160nullHeadTail :: Monad m => Stream m Int -> m ()
161nullHeadTail s = do
162 r <- S.null s
163 when (not r) $ do
164 _ <- S.head s
165 S.tail s >>= Prelude.mapM_ nullHeadTail
167{-# INLINE mapM_ #-}
168mapM_ :: Monad m => Stream m Int -> m ()
169mapM_ = S.mapM_ (\_ -> return ())
171toList = S.toList
173{-# INLINE toRevList #-}
174toRevList :: Monad m => Stream m Int -> m [Int]
175toRevList = S.toRevList
177foldrMBuild = S.foldrM (\x xs -> xs >>= return . (x :)) (return [])
178foldl'Build = S.foldl' (flip (:)) []
179foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) []
181foldrMReduce = S.foldrM (\x xs -> xs >>= return . (x +)) (return 0)
182foldl'Reduce = S.foldl' (+) 0
183foldl'ReduceMap = P.fmap (+1) . S.foldl' (+) 0
184foldl1'Reduce = S.foldl1' (+)
185foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) 0
187last = S.last
188null = S.null
189head = S.head
190elem = S.elem maxValue
191notElem = S.notElem maxValue
192length = S.length
193all = S.all (<= maxValue)
194any = S.any (> maxValue)
195and = S.and . S.map (<= maxValue)
196or = S.or . S.map (> maxValue)
197find = S.find (== maxValue)
198findIndex = S.findIndex (== maxValue)
199elemIndex = S.elemIndex maxValue
200maximum = S.maximum
201minimum = S.minimum
202sum = S.sum
203product = S.product
204minimumBy = S.minimumBy compare
205maximumBy = S.maximumBy compare
206-}
208-------------------------------------------------------------------------------
209-- Transformation
210-------------------------------------------------------------------------------
212{-# INLINE transform #-}
213transform :: Stream a -> Stream a
214transform = P.id
216{-# INLINE composeN #-}
217composeN :: Int -> (Stream Int -> Stream Int) -> Stream Int -> Stream Int
218composeN n f =
219 case n of
220 1 -> transform . f
221 2 -> transform . f . f
222 3 -> transform . f . f . f
223 4 -> transform . f . f . f . 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 :: Int -> Stream Int -> 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 -}
279onArray :: (S.SerialT Identity Int -> S.SerialT Identity Int) -> Stream Int -> Stream Int
280onArray f arr = runIdentity $ A.fromStreamN value $ f $ A.toStream arr
282scanl' n = composeN n $ onArray $ S.scanl' (+) 0
283scanl1' n = composeN n $ onArray $ S.scanl1' (+)
284map n = composeN n $ onArray $ S.map (+1)
285-- map n = composeN n $ A.map (+1)
286{-
287fmap n = composeN n $ Prelude.fmap (+1)
288fmap' t n = composeN' n $ t . Prelude.fmap (+1)
289map' t n = composeN' n $ t . S.map (+1)
290mapM t n = composeN' n $ t . S.mapM return
291mapMaybe n = composeN n $ S.mapMaybe
292 (\x -> if Prelude.odd x then Nothing else Just x)
293mapMaybeM n = composeN n $ S.mapMaybeM
294 (\x -> if Prelude.odd x then return Nothing else return $ Just x)
295sequence t = transform . t . S.sequence
296filterEven n = composeN n $ S.filter even
297filterAllOut n = composeN n $ S.filter (> maxValue)
298filterAllIn n = composeN n $ S.filter (<= maxValue)
299takeOne n = composeN n $ S.take 1
300takeAll n = composeN n $ S.take maxValue
301takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)
302takeWhileMTrue n = composeN n $ S.takeWhileM (return . (<= maxValue))
303dropOne n = composeN n $ S.drop 1
304dropAll n = composeN n $ S.drop maxValue
305dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)
306dropWhileMTrue n = composeN n $ S.dropWhileM (return . (<= maxValue))
307dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)
308findIndices n = composeN n $ S.findIndices (== maxValue)
309elemIndices n = composeN n $ S.elemIndices maxValue
310insertBy n = composeN n $ S.insertBy compare maxValue
311deleteBy n = composeN n $ S.deleteBy (>=) maxValue
312reverse n = composeN n $ S.reverse
313foldrS n = composeN n $ S.foldrS S.cons S.nil
314foldrSMap n = composeN n $ S.foldrS (\x xs -> x + 1 `S.cons` xs) S.nil
315foldrT n = composeN n $ S.foldrT S.cons S.nil
316foldrTMap n = composeN n $ S.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
318-------------------------------------------------------------------------------
319-- Iteration
320-------------------------------------------------------------------------------
322iterStreamLen, maxIters :: Int
323iterStreamLen = 10
324maxIters = 10000
326{-# INLINE iterateSource #-}
327iterateSource
328 :: S.MonadAsync m
329 => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
330iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
331 where
332 f (0 :: Int) m = g m
333 f x m = g (f (x P.- 1) m)
335{-# INLINE iterateMapM #-}
336{-# INLINE iterateScan #-}
337{-# INLINE iterateScanl1 #-}
338{-# INLINE iterateFilterEven #-}
339{-# INLINE iterateTakeAll #-}
340{-# INLINE iterateDropOne #-}
341{-# INLINE iterateDropWhileFalse #-}
342{-# INLINE iterateDropWhileTrue #-}
343iterateMapM, iterateScan, iterateScanl1, iterateFilterEven, iterateTakeAll,
344 iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue
345 :: S.MonadAsync m
346 => Int -> Stream m Int
348-- this is quadratic
349iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
350-- so is this
351iterateScanl1 = iterateSource (S.scanl1' (+)) (maxIters `div` 10)
353iterateMapM = iterateSource (S.mapM return) maxIters
354iterateFilterEven = iterateSource (S.filter even) maxIters
355iterateTakeAll = iterateSource (S.take maxValue) maxIters
356iterateDropOne = iterateSource (S.drop 1) maxIters
357iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue)) maxIters
358iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
360-------------------------------------------------------------------------------
361-- Zipping and concat
362-------------------------------------------------------------------------------
364{-# INLINE zip #-}
365{-# INLINE zipM #-}
366{-# INLINE mergeBy #-}
367zip, zipM, mergeBy :: Monad m => Stream m Int -> m ()
369zip src = do
370 r <- S.tail src
371 let src1 = fromJust r
372 transform (S.zipWith (,) src src1)
373zipM src = do
374 r <- S.tail src
375 let src1 = fromJust r
376 transform (S.zipWithM (curry return) src src1)
378mergeBy src = do
379 r <- S.tail src
380 let src1 = fromJust r
381 transform (S.mergeBy P.compare src src1)
383{-# INLINE isPrefixOf #-}
384{-# INLINE isSubsequenceOf #-}
385isPrefixOf, isSubsequenceOf :: Monad m => Stream m Int -> m Bool
387isPrefixOf src = S.isPrefixOf src src
388isSubsequenceOf src = S.isSubsequenceOf src src
390{-# INLINE stripPrefix #-}
391stripPrefix :: Monad m => Stream m Int -> m ()
392stripPrefix src = do
393 _ <- S.stripPrefix src src
394 return ()
396{-# INLINE zipAsync #-}
397{-# INLINE zipAsyncM #-}
398{-# INLINE zipAsyncAp #-}
399zipAsync, zipAsyncAp, zipAsyncM :: S.MonadAsync m => Stream m Int -> m ()
401zipAsync src = do
402 r <- S.tail src
403 let src1 = fromJust r
404 transform (S.zipAsyncWith (,) src src1)
406zipAsyncM src = do
407 r <- S.tail src
408 let src1 = fromJust r
409 transform (S.zipAsyncWithM (curry return) src src1)
411zipAsyncAp src = do
412 r <- S.tail src
413 let src1 = fromJust r
414 transform (S.zipAsyncly $ (,) <$> S.serially src
415 <*> S.serially src1)
417{-# INLINE eqBy #-}
418eqBy :: (Monad m, P.Eq a) => Stream m a -> m P.Bool
419eqBy src = S.eqBy (==) src src
421{-# INLINE cmpBy #-}
422cmpBy :: (Monad m, P.Ord a) => Stream m a -> m P.Ordering
423cmpBy src = S.cmpBy P.compare src src
425concatStreamLen, maxNested :: Int
426concatStreamLen = 1
427maxNested = 100000
429{-# INLINE concatMap #-}
430concatMap :: S.MonadAsync m => Int -> Stream m Int
431concatMap n = S.concatMap (\_ -> sourceUnfoldrMN maxNested n)
432 (sourceUnfoldrMN concatStreamLen n)
434-------------------------------------------------------------------------------
435-- Mixed Composition
436-------------------------------------------------------------------------------
438{-# INLINE scanMap #-}
439{-# INLINE dropMap #-}
440{-# INLINE dropScan #-}
441{-# INLINE takeDrop #-}
442{-# INLINE takeScan #-}
443{-# INLINE takeMap #-}
444{-# INLINE filterDrop #-}
445{-# INLINE filterTake #-}
446{-# INLINE filterScan #-}
447{-# INLINE filterScanl1 #-}
448{-# INLINE filterMap #-}
449scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
450 filterTake, filterScan, filterScanl1, filterMap
451 :: Monad m => Int -> Stream m Int -> m ()
453scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
454dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
455dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
456takeDrop n = composeN n $ S.drop 1 . S.take maxValue
457takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue
458takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue
459filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
460filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
461filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
462filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
463filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
465data Pair a b = Pair !a !b deriving (Generic, NFData)
467{-# INLINE sumProductFold #-}
468sumProductFold :: Monad m => Stream m Int -> m (Int, Int)
469sumProductFold = S.foldl' (\(s,p) x -> (s + x, p P.* x)) (0,1)
471{-# INLINE sumProductScan #-}
472sumProductScan :: Monad m => Stream m Int -> m (Pair Int Int)
473sumProductScan = S.foldl' (\(Pair _ p) (s0,x) -> Pair s0 (p P.* x)) (Pair 0 1)
474 . S.scanl' (\(s,_) x -> (s + x,x)) (0,0)
476-------------------------------------------------------------------------------
477-- Pure stream operations
478-------------------------------------------------------------------------------
480-}
481{-# INLINE eqInstance #-}
482eqInstance :: Stream Int -> Bool
483eqInstance src = src == src
485{-# INLINE eqInstanceNotEq #-}
486eqInstanceNotEq :: Stream Int -> Bool
487eqInstanceNotEq src = src P./= src
489{-# INLINE ordInstance #-}
490ordInstance :: Stream Int -> Bool
491ordInstance src = src P.< src
493{-# INLINE ordInstanceMin #-}
494ordInstanceMin :: Stream Int -> Stream Int
495ordInstanceMin src = P.min src src
497{-# INLINE showInstance #-}
498showInstance :: Stream Int -> P.String
499showInstance src = P.show src
501{-# INLINE readInstance #-}
502readInstance :: P.String -> Stream Int
503readInstance str =
504 let r = P.reads str
505 in case r of
506 [(x,"")] -> x
507 _ -> P.error "readInstance: no parse"
509{-# INLINE pureFoldl' #-}
510pureFoldl' :: Stream Int -> Int
511pureFoldl' = runIdentity . S.foldl' (+) 0 . A.toStream
513#ifdef DEVBUILD
514{-# INLINE foldableFoldl' #-}
515foldableFoldl' :: Stream Int -> Int
516foldableFoldl' = F.foldl' (+) 0
518{-# INLINE foldableSum #-}
519foldableSum :: Stream Int -> Int
520foldableSum = P.sum
521#endif
523{-
524{-# INLINE traversableMapM #-}
525traversableMapM :: Stream Identity Int -> IO (Stream Identity Int)
526traversableMapM = P.mapM return
527-}