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