Skip to content

Commit

Permalink
Add sorting functions based on samsort
Browse files Browse the repository at this point in the history
  • Loading branch information
konsumlamm committed Jun 18, 2024
1 parent f4326ff commit 228a47c
Show file tree
Hide file tree
Showing 5 changed files with 72 additions and 2 deletions.
4 changes: 4 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,7 @@
# 0.2.2.0 - upcoming

* Add `sort`, `sortBy`, `sortOn` ([#23](https://github.com/konsumlamm/rrb-vector/pull/22))

# 0.2.1.0 - December 2023

* Add `findIndexL`, `findIndexR`, `findIndicesL`, `findIndicesR`
Expand Down
8 changes: 7 additions & 1 deletion rrb-vector.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,13 @@ library
Data.RRBVector.Internal.Array
Data.RRBVector.Internal.Buffer
Data.RRBVector.Internal.IntRef
build-depends: base >= 4.11 && < 5, deepseq >= 1.4.3 && < 1.6, indexed-traversable ^>= 0.1, primitive >= 0.7 && < 0.10
Data.RRBVector.Internal.Sorting
build-depends:
base >= 4.11 && < 5,
deepseq >= 1.4.3 && < 1.6,
indexed-traversable ^>= 0.1,
primitive >= 0.7 && < 0.10,
samsort ^>= 0.1
ghc-options: -O2 -Wall -Wno-name-shadowing -Werror=missing-methods -Werror=missing-fields
default-language: Haskell2010

Expand Down
5 changes: 5 additions & 0 deletions src/Data/RRBVector.hs
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,10 @@ module Data.RRBVector
, map, map', reverse
-- * Zipping and unzipping
, zip, zipWith, unzip, unzipWith
-- * Sorting
--
-- | Currently implemented using [samsort](https://hackage.haskell.org/package/samsort).
, sort, sortBy, sortOn
) where

import Prelude hiding (replicate, lookup, take, drop, splitAt, map, reverse, zip, zipWith, unzip)
Expand All @@ -53,3 +57,4 @@ import Data.Functor.WithIndex
import Data.Traversable.WithIndex

import Data.RRBVector.Internal
import Data.RRBVector.Internal.Sorting
49 changes: 49 additions & 0 deletions src/Data/RRBVector/Internal/Sorting.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,49 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}

module Data.RRBVector.Internal.Sorting
( sort
, sortBy
, sortOn
) where

import Data.Foldable (toList)
import Data.Foldable.WithIndex (ifor_)
import Data.Primitive.Array
import Data.SamSort (sortArrayBy)
import Data.Semigroup (Arg(..))

import Data.RRBVector.Internal

uninitialized :: a
uninitialized = errorWithoutStackTrace "uninitialized"

-- | \(O(n \log n)\). Sort the vector in ascending order.
-- The sort is stable, meaning the order of equal elements is preserved.
--
-- @since 0.2.2.0
sort :: (Ord a) => Vector a -> Vector a
sort = sortBy compare

-- | \(O(n \log n)\). Sort the vector in ascending order according to the specified comparison function.
-- The sort is stable, meaning the order of equal elements is preserved.
--
-- @since 0.2.2.0
sortBy :: (a -> a -> Ordering) -> Vector a -> Vector a
sortBy cmp v =
let sortedArr = createArray (length v) uninitialized $ \arr@(MutableArray arr#) -> do
ifor_ v (writeArray arr)
sortArrayBy cmp arr# 0 (length v)
in fromList . toList $ sortedArr

-- | \(O(n \log n)\). Sort the vector in ascending order by comparing the results of applying the key function to each element.
-- The sort is stable, meaning the order of equal elements is preserved.
-- @`sortOn` f@ is equivalent to @`sortBy` (`Data.Ord.comparing` f)@, but only evaluates @f@ once for each element.
--
-- @since 0.2.2.0
sortOn :: (Ord b) => (a -> b) -> Vector a -> Vector a
sortOn f v =
let sortedArr = createArray (length v) uninitialized $ \arr@(MutableArray arr#) -> do
ifor_ v $ \i x -> let !y = f x in writeArray arr i (Arg y x)
sortArrayBy compare arr# 0 (length v)
in fromList . fmap (\(Arg _ x) -> x) . toList $ sortedArr
8 changes: 7 additions & 1 deletion test/Properties.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,8 @@ module Properties
import Control.Applicative (liftA2)
#endif
import Data.Foldable (Foldable(..))
import Data.List (uncons)
import Data.List (sort, sortBy, sortOn, uncons)
import Data.Ord (comparing)
import Data.Proxy (Proxy(..))
import Prelude hiding ((==)) -- use @===@ instead

Expand Down Expand Up @@ -194,6 +195,11 @@ properties = testGroup "properties"
[ testProperty "unzips the vector" $ \v -> (\(xs, ys) -> (toList xs, toList ys)) (V.unzip v) === unzip (toList v)
, testProperty "valid" $ \v -> let (v1, v2) = V.unzip v in checkValid v1 .&&. checkValid v2
]
, localOption (QuickCheckMaxSize 1000) $ testGroup "sorting"
[ testProperty "sort" $ \v -> toList (V.sort v) === sort (toList v)
, testProperty "sortBy" $ \v -> let cmp = comparing fst in toList (V.sortBy cmp v) === sortBy cmp (toList v)
, testProperty "sortOn" $ \v -> let f = odd in toList (V.sortOn f v) === sortOn f (toList v)
]
, instances
, laws
, issues
Expand Down

0 comments on commit 228a47c

Please sign in to comment.