on cbb57f2 help sign in
608 lines 20 kB history raw
1-- |
2-- Module : Streamly.Internal.Data.Stream.IsStream.Top
3-- Copyright : (c) 2020 Composewell Technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
7-- Portability : GHC
8--
9-- Top level IsStream module that can use all other lower level IsStream
10-- modules.
12module Streamly.Internal.Data.Stream.IsStream.Top
13 (
14 -- * Transformation
15 -- ** Sampling
16 -- | Value agnostic filtering.
17 sampleFromThen
18 , sampleIntervalStart
19 , sampleIntervalEnd
20 , sampleBurstStart
21 , sampleBurstEnd
23 -- ** Reordering
24 , sortBy
26 -- * Nesting
27 -- ** Set like operations
28 -- | These are not exactly set operations because streams are not
29 -- necessarily sets, they may have duplicated elements.
30 , intersectBy
31 , mergeIntersectBy
32 , differenceBy
33 , mergeDifferenceBy
34 , unionBy
35 , mergeUnionBy
37 -- ** Join operations
38 , crossJoin
39 , innerJoin
40 , mergeInnerJoin
41 , hashInnerJoin
42 , leftJoin
43 , mergeLeftJoin
44 , hashLeftJoin
45 , outerJoin
46 , mergeOuterJoin
47 , hashOuterJoin
48 )
49where
51#include "inline.hs"
53import Control.Monad.IO.Class (MonadIO(..))
54import Control.Monad.Trans.Class (lift)
55import Control.Monad.Trans.State.Strict (get, put)
56-- import Data.Hashable (Hashable)
57import Data.IORef (newIORef, readIORef, modifyIORef')
58import Data.Kind (Type)
59#if !(MIN_VERSION_base(4,11,0))
60import Data.Semigroup (Semigroup(..))
61#endif
62import Streamly.Internal.Data.SVar (MonadAsync)
63import Streamly.Internal.Data.Stream.IsStream.Common (concatM)
64import Streamly.Internal.Data.Stream.Prelude (foldl', fromList)
65import Streamly.Internal.Data.Stream.Serial (SerialT)
66import Streamly.Internal.Data.Stream.StreamK (IsStream)
67import Streamly.Internal.Data.Time.Units (NanoSecond64(..), toRelTime64)
69import qualified Data.List as List
70import qualified Streamly.Internal.Data.Array as Array
71import qualified Streamly.Internal.Data.Fold as Fold
72import qualified Streamly.Internal.Data.Stream.IsStream.Lift as Stream
73import qualified Streamly.Internal.Data.Stream.IsStream.Eliminate as Stream
74import qualified Streamly.Internal.Data.Stream.IsStream.Generate as Stream
75import qualified Streamly.Internal.Data.Stream.IsStream.Expand as Stream
76import qualified Streamly.Internal.Data.Stream.IsStream.Reduce as Stream
77import qualified Streamly.Internal.Data.Stream.IsStream.Transform as Stream
78import qualified Streamly.Internal.Data.Stream.StreamK as StreamK
80import Prelude hiding (filter, zipWith, concatMap, concat)
82-- $setup
83-- >>> :m
84-- >>> import Prelude hiding (filter, zipWith, concatMap, concat)
85-- >>> import qualified Streamly.Prelude as Stream
86-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream
88------------------------------------------------------------------------------
89-- Sampling
90------------------------------------------------------------------------------
92-- XXX We can implement this using addition instead of "mod" to make it more
93-- efficient.
94--
95-- | @sampleFromthen offset stride@ samples the element at @offset@ index and
96-- then every element at strides of @stride@.
97--
98-- >>> Stream.toList $ Stream.sampleFromThen 2 3 $ Stream.enumerateFromTo 0 10
99-- [2,5,8]
100--
101-- /Pre-release/
102--
103{-# INLINE sampleFromThen #-}
104sampleFromThen :: (IsStream t, Monad m, Functor (t m)) =>
105 Int -> Int -> t m a -> t m a
106sampleFromThen offset stride =
107 Stream.with Stream.indexed Stream.filter
108 (\(i, _) -> i >= offset && (i - offset) `mod` stride == 0)
110-- | Continuously evaluate the input stream and sample the last event in time
111-- window of @n@ seconds.
112--
113-- This is also known as @throttle@ in some libraries.
114--
115-- @
116-- sampleIntervalEnd n = Stream.catMaybes . Stream.intervalsOf n Fold.last
117-- @
118--
119-- /Pre-release/
120--
121{-# INLINE sampleIntervalEnd #-}
122sampleIntervalEnd :: (IsStream t, MonadAsync m, Functor (t m)) =>
123 Double -> t m a -> t m a
124sampleIntervalEnd n = Stream.catMaybes . Stream.intervalsOf n Fold.last
126-- | Like 'sampleInterval' but samples at the beginning of the time window.
127--
128-- @
129-- sampleIntervalStart n = Stream.catMaybes . Stream.intervalsOf n Fold.head
130-- @
131--
132-- /Pre-release/
133--
134{-# INLINE sampleIntervalStart #-}
135sampleIntervalStart :: (IsStream t, MonadAsync m, Functor (t m)) =>
136 Double -> t m a -> t m a
137sampleIntervalStart n = Stream.catMaybes . Stream.intervalsOf n Fold.head
139-- | Sample one event at the end of each burst of events. A burst is a group
140-- of events close together in time, it ends when an event is spaced by more
141-- than the specified time interval from the previous event.
142--
143-- This is known as @debounce@ in some libraries.
144--
145-- The clock granularity is 10 ms.
146--
147-- /Pre-release/
148--
149{-# INLINE sampleBurstEnd #-}
150sampleBurstEnd :: (IsStream t, MonadAsync m, Functor (t m)) =>
151 Double -> t m a -> t m a
152sampleBurstEnd gap =
153 let f (t1, _) (t2, _) =
154 t2 - t1 >= toRelTime64 (NanoSecond64 (round (gap * 10^(9::Int))))
155 in Stream.map snd
156 . Stream.catMaybes
157 . Stream.groupsByRolling f Fold.last
158 . Stream.timeIndexed
160-- | Like 'sampleBurstEnd' but samples the event at the beginning of the burst
161-- instead of at the end of it.
162--
163-- /Pre-release/
164--
165{-# INLINE sampleBurstStart #-}
166sampleBurstStart :: (IsStream t, MonadAsync m, Functor (t m)) =>
167 Double -> t m a -> t m a
168sampleBurstStart gap =
169 let f (t1, _) (t2, _) =
170 t2 - t1 >= toRelTime64 (NanoSecond64 (round (gap * 10^(9::Int))))
171 in Stream.map snd
172 . Stream.catMaybes
173 . Stream.groupsByRolling f Fold.head
174 . Stream.timeIndexed
176------------------------------------------------------------------------------
177-- Reordering
178------------------------------------------------------------------------------
179--
180-- We could possibly choose different algorithms depending on whether the
181-- input stream is almost sorted (ascending/descending) or random. We could
182-- serialize the stream to an array and use quicksort.
183--
184-- | Sort the input stream using a supplied comparison function.
185--
186-- /O(n) space/
187--
188-- Note: this is not the fastest possible implementation as of now.
189--
190-- /Pre-release/
191--
192{-# INLINE sortBy #-}
193sortBy :: (IsStream t, Monad m) => (a -> a -> Ordering) -> t m a -> t m a
194-- XXX creating StreamD and using D.mergeBy may be more efficient due to fusion
195sortBy f = Stream.concatPairsWith (Stream.mergeBy f) Stream.fromPure
197------------------------------------------------------------------------------
198-- SQL Joins
199------------------------------------------------------------------------------
200--
201-- Some references:
202-- * https://en.wikipedia.org/wiki/Relational_algebra
203-- * https://en.wikipedia.org/wiki/Join_(SQL)
205-- TODO: OrdSet/IntSet/hashmap based versions of these. With Eq only
206-- constraint, the best would be to use an Array with linear search. If the
207-- second stream is sorted we can also use a binary search, using Ord
208-- constraint or an ordering function.
209--
210-- For Storables we can cache the second stream into an unboxed array for
211-- possibly faster access/compact representation?
212--
213-- If we do not want to keep the stream in memory but always read it from the
214-- source (disk/network) every time we iterate through it then we can do that
215-- too by reading the stream every time, the stream must have immutable state
216-- in that case and the user is responsible for the behavior if the stream
217-- source changes during iterations. We can also use an Unfold instead of
218-- stream. We probably need a way to distinguish streams that can be read
219-- mutliple times without any interference (e.g. unfolding a stream using an
220-- immutable handle would work i.e. using pread/pwrite instead of maintianing
221-- an offset in the handle).
223-- XXX We can do this concurrently.
224--
225-- | This is the same as 'Streamly.Internal.Data.Unfold.outerProduct' but less
226-- efficient.
227--
228-- The second stream is evaluated multiple times. If the second stream is
229-- consume-once stream then it can be cached in an 'Data.Array.Array' before
230-- calling this function. Caching may also improve performance if the stream is
231-- expensive to evaluate.
232--
233-- Time: O(m x n)
234--
235-- /Pre-release/
236{-# INLINE crossJoin #-}
237crossJoin :: Monad (t m) => t m a -> t m b -> t m (a, b)
238crossJoin s1 s2 = do
239 -- XXX use concatMap instead?
240 a <- s1
241 b <- s2
242 return (a, b)
244-- XXX We can do this concurrently.
245-- XXX If the second stream is sorted and passed as an Array we could use
246-- binary search if we have an Ord instance or Ordering returning function. The
247-- time complexity would then become (m x log n).
248--
249-- | For all elements in @t m a@, for all elements in @t m b@ if @a@ and @b@
250-- are equal by the given equality pedicate then return the tuple (a, b).
251--
252-- The second stream is evaluated multiple times. If the stream is a
253-- consume-once stream then the caller should cache it in an 'Data.Array.Array'
254-- before calling this function. Caching may also improve performance if the
255-- stream is expensive to evaluate.
256--
257-- For space efficiency use the smaller stream as the second stream.
258--
259-- Space: O(n) assuming the second stream is cached in memory.
260--
261-- Time: O(m x n)
262--
263-- /Pre-release/
264{-# INLINE innerJoin #-}
265innerJoin ::
266 forall (t :: (Type -> Type) -> Type -> Type) m a b.
267 (IsStream t, Monad (t m)) =>
268 (a -> b -> Bool) -> t m a -> t m b -> t m (a, b)
269innerJoin eq s1 s2 = do
270 -- XXX use concatMap instead?
271 a <- s1
272 b <- s2
273 if a `eq` b
274 then return (a, b)
275 else StreamK.nil
277-- If the second stream is too big it can be partitioned based on hashes and
278-- then we can process one parition at a time.
279--
280-- | Like 'innerJoin' but uses a hashmap for efficiency.
281--
282-- For space efficiency use the smaller stream as the second stream.
283--
284-- Space: O(n)
285--
286-- Time: O(m + n)
287--
288-- /Unimplemented/
289{-# INLINE hashInnerJoin #-}
290hashInnerJoin :: -- Hashable b =>
291 (a -> b -> Bool) -> t m a -> t m b -> t m (a, b)
292hashInnerJoin = undefined
294-- | Like 'innerJoin' but works only on sorted streams.
295--
296-- Space: O(1)
297--
298-- Time: O(m + n)
299--
300-- /Unimplemented/
301{-# INLINE mergeInnerJoin #-}
302mergeInnerJoin :: (a -> b -> Ordering) -> t m a -> t m b -> t m (a, b)
303mergeInnerJoin = undefined
305-- XXX We can do this concurrently.
306-- XXX If the second stream is sorted and passed as an Array or a seek capable
307-- stream then we could use binary search if we have an Ord instance or
308-- Ordering returning function. The time complexity would then become (m x log
309-- n).
310--
311-- | For all elements in @t m a@, for all elements in @t m b@ if @a@ and @b@
312-- are equal then return the tuple @(a, Just b)@. If @a@ is not present in @t
313-- m b@ then return @(a, Nothing)@.
314--
315-- The second stream is evaluated multiple times. If the stream is a
316-- consume-once stream then the caller should cache it in an 'Data.Array.Array'
317-- before calling this function. Caching may also improve performance if the
318-- stream is expensive to evaluate.
319--
320-- @
321-- rightJoin = flip leftJoin
322-- @
323--
324-- Space: O(n) assuming the second stream is cached in memory.
325--
326-- Time: O(m x n)
327--
328-- /Unimplemented/
329{-# INLINE leftJoin #-}
330leftJoin :: Monad m =>
331 (a -> b -> Bool) -> SerialT m a -> SerialT m b -> SerialT m (a, Maybe b)
332leftJoin eq s1 s2 = Stream.evalStateT (return False) $ do
333 a <- Stream.liftInner s1
334 -- XXX should we use StreamD monad here?
335 -- XXX Is there a better way to perform some action at the end of a loop
336 -- iteration?
337 lift $ put False
338 let final = do
339 r <- lift get
340 if r
341 then StreamK.nil
342 else StreamK.fromPure Nothing
343 b <- fmap Just (Stream.liftInner s2) <> final
344 case b of
345 Just b1 ->
346 if a `eq` b1
347 then do
348 lift $ put True
349 return (a, Just b1)
350 else StreamK.nil
351 Nothing -> return (a, Nothing)
353-- | Like 'outerJoin' but uses a hashmap for efficiency.
354--
355-- Space: O(n)
356--
357-- Time: O(m + n)
358--
359-- /Unimplemented/
360{-# INLINE hashLeftJoin #-}
361hashLeftJoin :: -- Hashable b =>
362 (a -> b -> Bool) -> t m a -> t m b -> t m (a, Maybe b)
363hashLeftJoin = undefined
365-- | Like 'leftJoin' but works only on sorted streams.
366--
367-- Space: O(1)
368--
369-- Time: O(m + n)
370--
371-- /Unimplemented/
372{-# INLINE mergeLeftJoin #-}
373mergeLeftJoin :: -- Monad m =>
374 (a -> b -> Ordering) -> t m a -> t m b -> t m (a, Maybe b)
375mergeLeftJoin _eq _s1 _s2 = undefined
377-- XXX We can do this concurrently.
378--
379-- | For all elements in @t m a@, for all elements in @t m b@ if @a@ and @b@
380-- are equal by the given equality pedicate then return the tuple (Just a, Just
381-- b). If @a@ is not found in @t m b@ then return (a, Nothing), return
382-- (Nothing, b) for vice-versa.
383--
384-- For space efficiency use the smaller stream as the second stream.
385--
386-- Space: O(n)
387--
388-- Time: O(m x n)
389--
390-- /Unimplemented/
391{-# INLINE outerJoin #-}
392outerJoin :: MonadIO m =>
393 (a -> b -> Bool)
394 -> SerialT m a
395 -> SerialT m b
396 -> SerialT m (Maybe a, Maybe b)
397outerJoin eq s1 s =
398 Stream.concatM $ do
399 arr <- Array.fromStream $ fmap (,False) s
400 return $ go arr <> leftOver arr
402 where
404 leftOver =
405 fmap (\(x, _) -> (Nothing, Just x))
406 . Stream.filter (not . snd)
407 . Array.toStream
409 go arr = Stream.evalStateT (return False) $ do
410 a <- Stream.liftInner s1
411 -- XXX should we use StreamD monad here?
412 -- XXX Is there a better way to perform some action at the end of a loop
413 -- iteration?
414 lift $ put False
415 let final = do
416 r <- lift get
417 if r
418 then StreamK.nil
419 else StreamK.fromPure Nothing
420 (_i, b) <-
421 Stream.indexed
422 $ fmap Just (Stream.liftInner (Array.toStream arr)) <> final
423 case b of
424 Just (b1, _used) ->
425 if a `eq` b1
426 then do
427 lift $ put True
428 -- XXX Need to use a mutable array
429 -- when (not used) $ Array.writeIndex i True
430 return (Just a, Just b1)
431 else StreamK.nil
432 Nothing -> return (Just a, Nothing)
434-- Put the b's that have been paired, in another hash or mutate the hash to set
435-- a flag. At the end go through @t m b@ and find those that are not in that
436-- hash to return (Nothing, b).
437--
438-- | Like 'outerJoin' but uses a hashmap for efficiency.
439--
440-- For space efficiency use the smaller stream as the second stream.
441--
442-- Space: O(n)
443--
444-- Time: O(m + n)
445--
446-- /Unimplemented/
447{-# INLINE hashOuterJoin #-}
448hashOuterJoin :: -- (Monad m, Hashable b) =>
449 (a -> b -> Ordering) -> t m a -> t m b -> t m (Maybe a, Maybe b)
450hashOuterJoin _eq _s1 _s2 = undefined
452-- | Like 'outerJoin' but works only on sorted streams.
453--
454-- Space: O(1)
455--
456-- Time: O(m + n)
457--
458-- /Unimplemented/
459{-# INLINE mergeOuterJoin #-}
460mergeOuterJoin :: -- Monad m =>
461 (a -> b -> Ordering) -> t m a -> t m b -> t m (Maybe a, Maybe b)
462mergeOuterJoin _eq _s1 _s2 = undefined
464------------------------------------------------------------------------------
465-- Set operations (special joins)
466------------------------------------------------------------------------------
467--
468-- TODO: OrdSet/IntSet/hashmap based versions of these. With Eq only constraint
469-- the best would be to use an Array with linear search. If the second stream
470-- is sorted we can also use a binary search, using Ord constraint.
472-- | 'intersectBy' is essentially a filtering operation that retains only those
473-- elements in the first stream that are present in the second stream.
474--
475-- >>> Stream.toList $ Stream.intersectBy (==) (Stream.fromList [1,2,2,4]) (Stream.fromList [2,1,1,3])
476-- [1,2,2]
477--
478-- >>> Stream.toList $ Stream.intersectBy (==) (Stream.fromList [2,1,1,3]) (Stream.fromList [1,2,2,4])
479-- [2,1,1]
480--
481-- 'intersectBy' is similar to but not the same as 'innerJoin':
482--
483-- >>> Stream.toList $ fmap fst $ Stream.innerJoin (==) (Stream.fromList [1,2,2,4]) (Stream.fromList [2,1,1,3])
484-- [1,1,2,2]
485--
486-- Space: O(n) where @n@ is the number of elements in the second stream.
487--
488-- Time: O(m x n) where @m@ is the number of elements in the first stream and
489-- @n@ is the number of elements in the second stream.
490--
491-- /Pre-release/
492{-# INLINE intersectBy #-}
493intersectBy :: (IsStream t, Monad m) =>
494 (a -> a -> Bool) -> t m a -> t m a -> t m a
495intersectBy eq s1 s2 =
496 concatM
497 $ do
498 -- This may work well when s2 is small
499 xs <- Stream.toListRev $ Stream.uniqBy eq $ StreamK.adapt s2
500 return $ Stream.filter (\x -> List.any (eq x) xs) s1
502-- | Like 'intersectBy' but works only on sorted streams.
503--
504-- Space: O(1)
505--
506-- Time: O(m+n)
507--
508-- /Unimplemented/
509{-# INLINE mergeIntersectBy #-}
510mergeIntersectBy :: -- (IsStream t, Monad m) =>
511 (a -> a -> Ordering) -> t m a -> t m a -> t m a
512mergeIntersectBy _eq _s1 _s2 = undefined
514-- Roughly leftJoin s1 s2 = s1 `difference` s2 + s1 `intersection` s2
516-- | Delete first occurrences of those elements from the first stream that are
517-- present in the second stream. If an element occurs multiple times in the
518-- second stream as many occurrences of it are deleted from the first stream.
519--
520-- >>> Stream.toList $ Stream.differenceBy (==) (Stream.fromList [1,2,2]) (Stream.fromList [1,2,3])
521-- [2]
522--
523-- The following laws hold:
524--
525-- @
526-- (s1 `serial` s2) `differenceBy eq` s1 === s2
527-- (s1 `wSerial` s2) `differenceBy eq` s1 === s2
528-- @
529--
530-- Same as the list 'Data.List.//' operation.
531--
532-- Space: O(m) where @m@ is the number of elements in the first stream.
533--
534-- Time: O(m x n) where @m@ is the number of elements in the first stream and
535-- @n@ is the number of elements in the second stream.
536--
537-- /Pre-release/
538{-# INLINE differenceBy #-}
539differenceBy :: (IsStream t, Monad m) =>
540 (a -> a -> Bool) -> t m a -> t m a -> t m a
541differenceBy eq s1 s2 =
542 concatM
543 $ do
544 -- This may work well if s1 is small
545 -- If s1 is big we can go through s1, deleting elements from s2 and
546 -- not emitting an element if it was successfully deleted from s2.
547 -- we will need a deleteBy that can return whether the element was
548 -- deleted or not.
549 xs <- Stream.toList $ StreamK.adapt s1
550 fmap fromList $ foldl' (flip (List.deleteBy eq)) xs s2
552-- | Like 'differenceBy' but works only on sorted streams.
553--
554-- Space: O(1)
555--
556-- /Unimplemented/
557{-# INLINE mergeDifferenceBy #-}
558mergeDifferenceBy :: -- (IsStream t, Monad m) =>
559 (a -> a -> Ordering) -> t m a -> t m a -> t m a
560mergeDifferenceBy _eq _s1 _s2 = undefined
562-- | This is essentially an append operation that appends all the extra
563-- occurrences of elements from the second stream that are not already present
564-- in the first stream.
565--
566-- >>> Stream.toList $ Stream.unionBy (==) (Stream.fromList [1,2,2,4]) (Stream.fromList [1,1,2,3])
567-- [1,2,2,4,3]
568--
569-- Equivalent to the following except that @s1@ is evaluated only once:
570--
571-- @
572-- unionBy eq s1 s2 = s1 \`serial` (s2 `differenceBy eq` s1)
573-- @
574--
575-- Similar to 'outerJoin' but not the same.
576--
577-- Space: O(n)
578--
579-- Time: O(m x n)
580--
581-- /Pre-release/
582{-# INLINE unionBy #-}
583unionBy :: (IsStream t, MonadAsync m, Semigroup (t m a)) =>
584 (a -> a -> Bool) -> t m a -> t m a -> t m a
585unionBy eq s1 s2 =
586 concatM
587 $ do
588 xs <- Stream.toList $ StreamK.adapt s2
589 -- XXX we can use postscanlMAfter' instead of IORef
590 ref <- liftIO $ newIORef $! List.nubBy eq xs
591 let f x = do
592 liftIO $ modifyIORef' ref (List.deleteBy eq x)
593 return x
594 s3 = concatM
595 $ do
596 xs1 <- liftIO $ readIORef ref
597 return $ fromList xs1
598 return $ Stream.mapM f s1 <> s3
600-- | Like 'unionBy' but works only on sorted streams.
601--
602-- Space: O(1)
603--
604-- /Unimplemented/
605{-# INLINE mergeUnionBy #-}
606mergeUnionBy :: -- (IsStream t, Monad m) =>
607 (a -> a -> Ordering) -> t m a -> t m a -> t m a
608mergeUnionBy _eq _s1 _s2 = undefined