Restore stability for sorting, add tests (#197)

* Add simple stability test for sortWith

* Use larger input array for sortWith stability test

* Stabilize mergesort

* Add ST tests, simplify sortByImpl fix

* Add note about stability to documentation

* Fix compiler warning: replace `STA.empty` with `STA.new`

* Remove fold1 member in NonEmptyArray's Foldable1 instance

* Update foldMap1Default with left version

Co-authored-by: Jordan Martinez <[email protected]>

Author: pete-murphy

src/Data/Array.js

@@ -295,12 +295,6 @@ exports.sortByImpl = (function () {
         xs1[k++] = y;
         ++j;
       }
-      else if (c === 0) {
-        xs1[k++] = x;
-        xs1[k++] = y;
-        ++i;
-        ++j;
-      }
       else {
         xs1[k++] = x;
         ++i;

src/Data/Array.purs

@@ -790,6 +790,7 @@ foreign import scanr :: forall a b. (a -> b -> b) -> b -> Array a -> Array b
 --------------------------------------------------------------------------------
 
 -- | Sort the elements of an array in increasing order, creating a new array.
+-- | Sorting is stable: the order of equal elements is preserved.
 -- |
 -- | ```purescript
 -- | sort [2, -3, 1] = [-3, 1, 2]
@@ -800,6 +801,8 @@ sort xs = sortBy compare xs
 
 -- | Sort the elements of an array in increasing order, where elements are
 -- | compared using the specified partial ordering, creating a new array.
+-- | Sorting is stable: the order of elements is preserved if they are equal
+-- | according to the specified partial ordering.
 -- |
 -- | ```purescript
 -- | compareLength a b = compare (length a) (length b)
@@ -813,7 +816,8 @@ sortBy comp = sortByImpl comp case _ of
   LT -> -1
 
 -- | Sort the elements of an array in increasing order, where elements are
--- | sorted based on a projection
+-- | sorted based on a projection. Sorting is stable: the order of elements is
+-- | preserved if they are equal according to the projection.
 -- |
 -- | ```purescript
 -- | sortWith (_.age) [{name: "Alice", age: 42}, {name: "Bob", age: 21}]

src/Data/Array/NonEmpty/Internal.purs

@@ -15,7 +15,7 @@ import Data.Foldable (class Foldable)
 import Data.FoldableWithIndex (class FoldableWithIndex)
 import Data.FunctorWithIndex (class FunctorWithIndex)
 import Data.Ord (class Ord1)
-import Data.Semigroup.Foldable (class Foldable1, foldMap1Default)
+import Data.Semigroup.Foldable (class Foldable1, foldMap1DefaultL)
 import Data.Semigroup.Traversable (class Traversable1, sequence1Default)
 import Data.Traversable (class Traversable)
 import Data.TraversableWithIndex (class TraversableWithIndex)
@@ -48,8 +48,7 @@ derive newtype instance foldableNonEmptyArray :: Foldable NonEmptyArray
 derive newtype instance foldableWithIndexNonEmptyArray :: FoldableWithIndex Int NonEmptyArray
 
 instance foldable1NonEmptyArray :: Foldable1 NonEmptyArray where
-  foldMap1 = foldMap1Default
-  fold1 = foldl1Impl (<>)
+  foldMap1 = foldMap1DefaultL
   foldr1 = foldr1Impl
   foldl1 = foldl1Impl
 

src/Data/Array/ST.js

@@ -123,12 +123,6 @@ exports.sortByImpl = (function () {
         xs1[k++] = y;
         ++j;
       }
-      else if (c === 0) {
-        xs1[k++] = x;
-        xs1[k++] = y;
-        ++i;
-        ++j;
-      }
       else {
         xs1[k++] = x;
         ++i;

src/Data/Array/ST.purs

@@ -86,7 +86,8 @@ empty = new
 -- | Create a mutable copy of an immutable array.
 foreign import thaw :: forall h a. Array a -> ST h (STArray h a)
 
--- | Sort a mutable array in place.
+-- | Sort a mutable array in place. Sorting is stable: the order of equal
+-- | elements is preserved.
 sort :: forall a h. Ord a => STArray h a -> ST h (STArray h a)
 sort = sortBy compare
 
@@ -101,7 +102,9 @@ foreign import shiftImpl
   -> STArray h a
   -> ST h (Maybe a)
 
--- | Sort a mutable array in place using a comparison function.
+-- | Sort a mutable array in place using a comparison function. Sorting is
+-- | stable: the order of elements is preserved if they are equal according to
+-- | the comparison function.
 sortBy
   :: forall a h
    . (a -> a -> Ordering)
@@ -119,7 +122,8 @@ foreign import sortByImpl
   -> STArray h a
   -> ST h (STArray h a)
 
--- | Sort a mutable array in place based on a projection.
+-- | Sort a mutable array in place based on a projection. Sorting is stable: the
+-- | order of elements is preserved if they are equal according to the projection.
 sortWith
   :: forall a b h
    . Ord b

test/Test/Data/Array.purs

@@ -10,7 +10,7 @@ import Data.Foldable (for_, foldMapDefaultR, class Foldable, all, traverse_)
 import Data.Traversable (scanl, scanr)
 import Data.Maybe (Maybe(..), isNothing, fromJust)
 import Data.Ord.Down (Down(..))
-import Data.Tuple (Tuple(..))
+import Data.Tuple (Tuple(..), fst)
 import Data.Unfoldable (replicateA)
 import Effect (Effect)
 import Effect.Console (log)
@@ -288,9 +288,17 @@ testArray = do
   log "sortBy should reorder a list into ascending order based on the result of a comparison function"
   assert $ A.sortBy (flip compare) [1, 3, 2, 5, 6, 4] == [6, 5, 4, 3, 2, 1]
 
+  log "sortBy should not reorder elements that are equal according to a comparison function"
+  let s1 = map (Tuple "a") (A.range 1 100)
+  assert $ A.sortBy (comparing fst) s1 == s1
+
   log "sortWith should reorder a list into ascending order based on the result of compare over a projection"
   assert $ A.sortWith identity [1, 3, 2, 5, 6, 4] == [1, 2, 3, 4, 5, 6]
 
+  log "sortWith should not reorder elements that are equal according to a projection"
+  let s2 = map (Tuple "a") (A.range 1 100)
+  assert $ A.sortWith fst s2 == s2
+
   log "take should keep the specified number of items from the front of an array, discarding the rest"
   assert $ (A.take 1 [1, 2, 3]) == [1]
   assert $ (A.take 2 [1, 2, 3]) == [1, 2]

test/Test/Data/Array/ST.purs

@@ -3,10 +3,12 @@ module Test.Data.Array.ST (testArrayST) where
 import Prelude
 
 import Control.Monad.ST as ST
+import Data.Array (range)
 import Data.Array.ST (withArray)
 import Data.Array.ST as STA
 import Data.Foldable (all)
 import Data.Maybe (Maybe(..), isNothing)
+import Data.Tuple (Tuple(..), fst)
 import Effect (Effect)
 import Effect.Console (log)
 import Test.Assert (assert)
@@ -234,11 +236,23 @@ testArrayST = do
     STA.sortBy (flip compare) =<< STA.unsafeThaw [1, 3, 2, 5, 6, 4]
   ) == [6, 5, 4, 3, 2, 1]
 
+  log "sortBy should not reorder elements that are equal according to a comparison function"
+  let s1 = map (Tuple "a") (range 1 100)
+  assert $ STA.run (
+    STA.sortBy (comparing fst) =<< STA.unsafeThaw s1
+  ) == s1
+
   log "sortWith should reorder a list into ascending order based on the result of compare over a projection"
   assert $ STA.run (
     STA.sortWith identity =<< STA.unsafeThaw [1, 3, 2, 5, 6, 4]
   ) == [1, 2, 3, 4, 5, 6]
 
+  log "sortWith should not reorder elements that are equal according to a projection"
+  let s2 = map (Tuple "a") (range 1 100)
+  assert $ STA.run (
+    STA.sortWith fst =<< STA.unsafeThaw s2
+  ) == s2
+
   log "splice should be able to delete multiple items at a specified index"
 
   assert $ STA.run (do