git.iko.soy/streamly
on master help sign in
Add bubbleAsc function
7886550Ranjeet Kumar Ranjan
core/src/Streamly/Internal/Data/Array/Foreign/Mut/Type.hs+29
compare with master
unifiedsplit
@@ -142,6 +142,7 @@ module Streamly.Internal.Data.Array.Foreign.Mut.Type
142 , shuffleBy
142 , shuffleBy
143 , divideBy
143 , divideBy
144 , mergeBy
144 , mergeBy
145+ , bubbleAsc
145
146
146 -- * Casting
147 -- * Casting
147 , cast
148 , cast
@@ -2334,3 +2335,31 @@ strip eq arr@Array{..} = do
2334 then getLast prev low
2335 then getLast prev low
2335 else return cur
2336 else return cur
2336 else return cur
2337 else return cur
2338+
2339+-- | Given an array sorted in ascending order except the last element being out
2340+-- of order, use bubble sort to place the last element at the right place such
2341+-- that the array remains sorted in ascending order.
2342+--
2343+-- /Pre-release/
2344+{-# INLINE bubbleAsc #-}
2345+bubbleAsc :: (MonadIO m, Storable a) =>
2346+ (a -> a -> Ordering) -> Array a -> m ()
2347+bubbleAsc cmp0 arr =
2348+ when (l > 1) $ do
2349+ x <- getIndexUnsafe (l - 1) arr
2350+ go x (l - 2)
2351+
2352+ where
2353+
2354+ l = length arr
2355+
2356+ go x i =
2357+ if i >= 0
2358+ then do
2359+ x1 <- getIndexUnsafe i arr
2360+ case x1 `cmp0` x of
2361+ GT -> do
2362+ putIndexUnsafe (i + 1) x1 arr
2363+ go x (i - 1)
2364+ _ -> putIndexUnsafe (i + 1) x arr
2365+ else putIndexUnsafe (i + 1) x arr
test/Streamly/Test/Data/Array/Foreign.hs+43
@@ -11,13 +11,16 @@ module Streamly.Test.Data.Array.Foreign (main) where
11#include "Streamly/Test/Data/Array/CommonImports.hs"
11#include "Streamly/Test/Data/Array/CommonImports.hs"
12
12
13import Data.Char (isLower)
13import Data.Char (isLower)
14+import Data.List (sort)
14import Data.Word(Word8)
15import Data.Word(Word8)
16+import Test.QuickCheck (chooseInt, listOf)
15
17
16import qualified Streamly.Internal.Data.Fold as Fold
18import qualified Streamly.Internal.Data.Fold as Fold
17import qualified Streamly.Internal.Data.Array.Foreign as A
19import qualified Streamly.Internal.Data.Array.Foreign as A
18import qualified Streamly.Internal.Data.Array.Foreign.Type as A
20import qualified Streamly.Internal.Data.Array.Foreign.Type as A
19import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
21import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
20import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS
22import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS
23+
21type Array = A.Array
24type Array = A.Array
22
25
23moduleName :: String
26moduleName :: String
@@ -131,6 +134,43 @@ unsafeSlice i n list =
131 arr = A.toList $ A.getSliceUnsafe i n $ A.fromList list
134 arr = A.toList $ A.getSliceUnsafe i n $ A.fromList list
132 in arr == lst
135 in arr == lst
133
136
137+{-
138+testAppend :: Property
139+testAppend =
140+ forAll (listOf (chooseInt (-50, 100))) $ \ls0 ->
141+ monadicIO $ action ls0
142+
143+ where
144+
145+ action ls = do
146+ x <- S.fold
147+ (MA.append (MA.newArray 0))
148+ (S.fromList (ls::[Int]))
149+ lst <- MA.toList x
150+ assert (ls == lst)
151+-}
152+
153+testBubbleAsc :: Property
154+testBubbleAsc =
155+ forAll (listOf (chooseInt (-50, 100))) $ \ls0 ->
156+ monadicIO $ action ls0
157+
158+ where
159+
160+ action ls = do
161+ x <- S.fold (fldm ls) $ S.fromList ls
162+ lst <- MA.toList x
163+ assert (sort ls == lst)
164+
165+ fldm ls =
166+ Fold.foldlM'
167+ (\b a -> do
168+ arr <- MA.snoc b a
169+ MA.bubbleAsc compare arr
170+ return arr
171+ )
172+ (MA.newArray $ length ls)
173+
134main :: IO ()
174main :: IO ()
135main =
175main =
136 hspec $
176 hspec $
@@ -139,6 +179,9 @@ main =
139 describe moduleName $ do
179 describe moduleName $ do
140 commonMain
180 commonMain
141 describe "Construction" $ do
181 describe "Construction" $ do
182+ -- XXX There is an issue https://github.com/composewell/streamly/issues/1577
183+ --prop "testAppend" testAppend
184+ prop "testBubbleAsc" testBubbleAsc
142 prop "length . fromStream === n" testLengthFromStream
185 prop "length . fromStream === n" testLengthFromStream
143 prop "toStream . fromStream === id" testFromStreamToStream
186 prop "toStream . fromStream === id" testFromStreamToStream
144 prop "read . write === id" testFoldUnfold
187 prop "read . write === id" testFoldUnfold