git.iko.soy/streamly
on master help sign in
Add bubbleAsc function

Fix review comments Fix last element Fix empty arraay check

commit7886550a71c2b75322111b54b274be4a5999b597 authorRanjeet Kumar Ranjan <ranjeetr@composewell.com> dateTue 29 Mar 2022, 20:11 (5 years ago) parenta6f041c
2 files changed+72
compare with master
unifiedsplit
core/src/Streamly/Internal/Data/Array/Foreign/Mut/Type.hs+29 test/Streamly/Test/Data/Array/Foreign.hs+43
core/src/Streamly/Internal/Data/Array/Foreign/Mut/Type.hs+29
@@ -142,6 +142,7 @@ module Streamly.Internal.Data.Array.Foreign.Mut.Type
142142 , shuffleBy
143143 , divideBy
144144 , mergeBy
145+ , bubbleAsc
145146
146147 -- * Casting
147148 , cast
@@ -2334,3 +2335,31 @@ strip eq arr@Array{..} = do
23342335 then getLast prev low
23352336 else return cur
23362337 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
1111#include "Streamly/Test/Data/Array/CommonImports.hs"
1212
1313import Data.Char (isLower)
14+import Data.List (sort)
1415import Data.Word(Word8)
16+import Test.QuickCheck (chooseInt, listOf)
1517
1618import qualified Streamly.Internal.Data.Fold as Fold
1719import qualified Streamly.Internal.Data.Array.Foreign as A
1820import qualified Streamly.Internal.Data.Array.Foreign.Type as A
1921import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
2022import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS
23+
2124type Array = A.Array
2225
2326moduleName :: String
@@ -131,6 +134,43 @@ unsafeSlice i n list =
131134 arr = A.toList $ A.getSliceUnsafe i n $ A.fromList list
132135 in arr == lst
133136
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+
134174main :: IO ()
135175main =
136176 hspec $
@@ -139,6 +179,9 @@ main =
139179 describe moduleName $ do
140180 commonMain
141181 describe "Construction" $ do
182+ -- XXX There is an issue https://github.com/composewell/streamly/issues/1577
183+ --prop "testAppend" testAppend
184+ prop "testBubbleAsc" testBubbleAsc
142185 prop "length . fromStream === n" testLengthFromStream
143186 prop "toStream . fromStream === id" testFromStreamToStream
144187 prop "read . write === id" testFoldUnfold