From bdc18a52ccb08c164a45454cb1c5aceecf613e4c Mon Sep 17 00:00:00 2001 From: Ranjeet Kumar Ranjan Date: Tue, 8 Mar 2022 17:04:38 +0530 Subject: [PATCH] Remove UnionBySorted --- .../Internal/Data/Stream/StreamD/Nesting.hs | 540 ------------------ test/Streamly/Test/Data/Stream/Top.hs | 20 - test/streamly-tests.cabal | 5 + 3 files changed, 5 insertions(+), 560 deletions(-) diff --git a/src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs b/src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs index 7a83eb031f..6fecb60011 100644 --- a/src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs +++ b/src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs @@ -143,7 +143,6 @@ module Streamly.Internal.Data.Stream.StreamD.Nesting , splitInnerBy , splitInnerBySuffix , intersectBySorted - , unionBySorted , differenceBySorted ) where @@ -2488,545 +2487,6 @@ splitInnerBySuffix splitter joiner (Stream step1 state1) = step _ (SplitYielding x next) = return $ Yield x next step _ SplitFinishing = return Stop -------------------------------------------------------------------------------- --- Union of two sorted streams -------------------------------------------------------------------------------- - -{-# INLINE_NORMAL unionBySorted #-} -unionBySorted :: (MonadIO m, Ord a) => - (a -> a -> Ordering) - -> Stream m a - -> Stream m a - -> Stream m a -unionBySorted cmp (Stream stepa ta) (Stream stepb tb) = - Stream - step - ( Just ta -- State of left stream - , Just tb -- State of right stream - , Nothing -- Current element of left stream - , Nothing -- Current element of right stream - , Nothing -- Previous element of right stream - , LeftRun -- Stream runner indicator - , NoneEmpty -- Stream emptyness indicator - ) - - where - {-# INLINE_LATE step #-} - - -- Initial step when left stream could be empty - step - gst - ( Just sa - , Just sb - , Nothing - , Nothing - , Nothing - , LeftRun - , NoneEmpty - ) = - do - -- liftIO $ print "Step 1" - r <- stepa (adaptState gst) sa - return $ case r of - Yield a' sa' -> - Skip - ( Just sa' - , Just sb - , Just a' - , Nothing - , Nothing - , RightRun - , NoneEmpty - ) - Skip sa' -> - Skip - ( Just sa' - , Just sb - , Nothing - , Nothing - , Nothing - , RightRun - , NoneEmpty - ) - Stop -> - Skip - ( Nothing - , Just sb - , Nothing - , Nothing - , Nothing - , RightRun - , LeftEmpty - ) - - -- Take an element from right stream and compare with previously - -- picked element from left stream - step - gst - ( Just sa - , Just sb - , Just a - , Nothing - , Nothing - , RightRun - , NoneEmpty - ) = - do - -- liftIO $ print "Step 2" - r <- stepb (adaptState gst) sb - return $ - case r of - Yield b' sb' -> - Skip - ( Just sa - , Just sb' - , Just a - , Just b' - , Just b' - , CompareRun - , NoneEmpty - ) - Skip sb' -> - Skip - ( Just sa - , Just sb' - , Just a - , Nothing - , Nothing - , RightRun - , NoneEmpty - ) - Stop -> - Skip - ( Just sa - , Nothing - , Just a - , Nothing - , Nothing - , LeftRun - , RightEmpty - ) - - -- Left stream has finished so take the element from right stream - -- here we don't have any previous element from right stream - step - gst - ( Nothing - , Just sb - , Nothing - , Nothing - , Nothing - , RightRun - , LeftEmpty - ) = - do - -- liftIO $ print "Step 2.1" - r <- stepb (adaptState gst) sb - return $ - case r of - Yield b' sb' -> - Yield - b' - ( Nothing - , Just sb' - , Nothing - , Just b' - , Just b' - , RightRun - , LeftEmpty - ) - Skip sb' -> - Skip - ( Nothing - , Just sb' - , Nothing - , Nothing - , Nothing - , RightRun - , LeftEmpty - ) - Stop -> - Stop - - -- Left stream has finished so take the element from right stream. - -- Here we have a previous element from right stream to compare with current - -- element of the same stream and discard the duplicates from right stream. - step - gst - ( Nothing - , Just sb - , Nothing - , Just _ - , Just pb - , RightRun - , LeftEmpty - ) = - do - -- liftIO $ print "Step 2.2" - r <- stepb (adaptState gst) sb - return $ - case r of - Yield b' sb' -> - if pb == b' -- discard the duplicates from right stream. - then - Skip - ( Nothing - , Just sb' - , Nothing - , Just b' - , Just b' - , RightRun - , LeftEmpty - ) - else - Yield - b' - ( Nothing - , Just sb' - , Nothing - , Just b' - , Just b' - , RightRun - , LeftEmpty - ) - Skip sb' -> - Skip - ( Nothing - , Just sb' - , Nothing - , Nothing - , Nothing - , RightRun - , LeftEmpty - ) - Stop -> - Stop - - -- Compare the elements from both streams, if equals then fast farward the - -- right stream to remove duplicated elements. - step gst (Just sa, Just sb, Just a, Just b, Just _, CompareRun, NoneEmpty) = - do - -- liftIO $ print "Step CompareRun" - let res = cmp a b - case res of - LT -> - return $ - Yield - a - ( Just sa - , Just sb - , Just a - , Just b - , Just b - , LeftRun - , NoneEmpty - ) - EQ -> do - r <- stepa (adaptState gst) sa - case r of - Yield a' sa' -> return $ - Yield - a -- remove duplicated elements from right - ( Just sa' - , Just sb - , Just a' - , Just b - , Just b - , FastFarwardRun - , NoneEmpty - ) - Skip sa' -> return $ - Yield - a -- remove duplicated elements from right - ( Just sa' - , Just sb - , Just a - , Just b - , Just b - , FastFarwardRun - , NoneEmpty - ) - Stop -> return $ - Yield - a -- remove duplicated elements from right - ( Nothing - , Just sb - , Nothing - , Just b - , Just b - , FastFarwardRun - , LeftEmpty - ) - GT -> - return $ - Yield - b - ( Just sa - , Just sb - , Just a - , Just b - , Just b - , RightRun - , NoneEmpty - ) - - -- Compare the elements from both streams, if equals then discard the - -- element from right stream. - step - gst - ( Just sa - , Just sb - , Just a - , Just _ - , Just pb - , RightRun - , NoneEmpty - ) = - do - -- liftIO $ print "Step 3" - r <- stepb (adaptState gst) sb - return $ - case r of - Yield b' sb' -> - if pb == b' - then - Skip -- discard the matching elements - ( Just sa - , Just sb' - , Just a - , Just b' - , Just b' - , RightRun - , NoneEmpty - ) - else - Skip - ( Just sa - , Just sb' - , Just a - , Just b' - , Just b' - , CompareRun - , NoneEmpty - ) - - Skip sb' -> - Skip - ( Just sa - , Just sb' - , Just a - , Nothing - , Nothing - , RightRun - , NoneEmpty - ) - Stop -> - Skip - ( Just sa - , Nothing - , Just a - , Nothing - , Nothing - , LeftRun - , RightEmpty - ) - - -- Fast forward right to remove dups - step - gst - ( sa - , Just sb - , a - , Just b - , Just pb - , FastFarwardRun - , e - ) = - do - -- liftIO $ print $ "Step 3.1 " ++ show e - r <- stepb (adaptState gst) sb - return $ - case r of - Yield b' sb' -> - if b'==pb - then - Skip - ( sa - , Just sb' - , a - , Just b' - , Just b' - , FastFarwardRun - , e - ) - else - case e of - LeftEmpty -> - Yield b' - ( Nothing - , Just sb - , Nothing - , Just b' - , Just b' - , RightRun - , LeftEmpty - ) - _ -> - Skip - ( sa - , Just sb - , a - , Just b' - , Just b' - , CompareRun - , NoneEmpty - ) - - Skip sb' -> - Skip - ( sa - , Just sb' - , a - , Just b - , Just pb - , FastFarwardRun, NoneEmpty) - Stop -> - --Yield a - Skip - ( sa - , Nothing - , a - , Nothing - , Nothing - , LeftRun - , RightEmpty - ) - - - -- Right stream is empty just iterate thru left stream - step - gst - ( Just sa - , Nothing - , a - , Nothing - , Nothing - , LeftRun - , RightEmpty - ) = - do - -- liftIO $ print "Step 4" - r <- stepa (adaptState gst) sa - return $ - case r of - Yield a' sa' -> - case a of - Just v -> Yield - v - ( Just sa' - , Nothing - , Just a' - , Nothing - , Nothing - , LeftRun - , RightEmpty - ) - Nothing -> Skip - ( Just sa' - , Nothing - , Just a' - , Nothing - , Nothing - , LeftRun - , RightEmpty - ) - Skip sa' -> - Skip - ( Just sa' - , Nothing - , a - , Nothing - , Nothing - , LeftRun - , NoneEmpty - ) - Stop -> - case a of - Just v -> Yield - v - ( Nothing - , Nothing - , Nothing - , Nothing - , Nothing - , LeftRun - , BothEmpty - ) - Nothing -> Skip - ( Nothing - , Nothing - , Nothing - , Nothing - , Nothing - , LeftRun - , BothEmpty - ) - - -- Right stream is non-empty just iterate thru left stream. - -- If last element of left stream is matching with current right element - -- ignore it. - step gst (Just sa, Just sb, Just a, Just b, Just _, LeftRun, NoneEmpty) = - do - -- liftIO $ print "Step 5" - r <- stepa (adaptState gst) sa - return $ - case r of - Yield a' sa' -> - Skip - ( Just sa' - , Just sb - , Just a' - , Just b - , Just b - , CompareRun - , NoneEmpty - ) - Skip sa' -> - Skip - ( Just sa' - , Just sb - , Just a - , Just b - , Nothing - , LeftRun - , NoneEmpty - ) - Stop -> - if a==b - then - Skip - ( Nothing - , Just sb - , Nothing - , Just b - , Just b - , RightRun - , LeftEmpty - ) - else - Yield - b - ( Nothing - , Just sb - , Nothing - , Just b - , Just b - , RightRun - , LeftEmpty - ) - - step _ (_, _, _, _, _, _, _) = return Stop - ------------------------------------------------------------------------------- -- Difference of sorted streams ----------------------------------------------- ------------------------------------------------------------------------------- diff --git a/test/Streamly/Test/Data/Stream/Top.hs b/test/Streamly/Test/Data/Stream/Top.hs index 41f8e69a0e..54b2340c43 100644 --- a/test/Streamly/Test/Data/Stream/Top.hs +++ b/test/Streamly/Test/Data/Stream/Top.hs @@ -46,25 +46,6 @@ intersectBySorted = let v2 = ls0 `intersect` ls1 assert (v1 == sort v2) -unionBySorted :: Property -unionBySorted = - forAll (listOf (chooseInt (min_value, max_value))) $ \ls0 -> - forAll (listOf (chooseInt (min_value, max_value))) $ \ls1 -> - monadicIO $ action (sort ls0) (sort ls1) - - where - - action ls0 ls1 = do - v1 <- - run - $ S.toList - $ Top.unionBySorted - compare - (S.fromList ls0) - (S.fromList ls1) - let v2 = sort $ union ls0 ls1 - assert (v1 == v2) - differenceBySorted :: Property differenceBySorted = forAll (listOf (chooseInt (min_value, max_value))) $ \ls0 -> @@ -93,5 +74,4 @@ main = hspec $ do describe moduleName $ do -- intersect prop "intersectBySorted" Main.intersectBySorted - prop "unionBySorted" Main.unionBySorted prop "differenceBySorted" Main.differenceBySorted diff --git a/test/streamly-tests.cabal b/test/streamly-tests.cabal index 9f060b6e80..68e9c3e0a8 100644 --- a/test/streamly-tests.cabal +++ b/test/streamly-tests.cabal @@ -389,6 +389,11 @@ test-suite Prelude.Top type: exitcode-stdio-1.0 main-is: Streamly/Test/Prelude/Top.hs +test-suite Data.Stream.Top + import: test-options + type: exitcode-stdio-1.0 + main-is: Streamly/Test/Data/Stream/Top.hs + test-suite Prelude.WAsync import: test-options type: exitcode-stdio-1.0