{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- ---------------------------------------------------------------------------
-- |
-- Module      : Data.Vector.Algorithms.Intro
-- Copyright   : (c) 2008-2015 Dan Doel
-- Maintainer  : Dan Doel <dan.doel@gmail.com>
-- Stability   : Experimental
-- Portability : Non-portable (type operators, bang patterns)
--
-- This module implements various algorithms based on the introsort algorithm,
-- originally described by David R. Musser in the paper /Introspective Sorting
-- and Selection Algorithms/. It is also in widespread practical use, as the
-- standard unstable sort used in the C++ Standard Template Library.
--
-- Introsort is at its core a quicksort. The version implemented here has the
-- following optimizations that make it perform better in practice:
--
--   * Small segments of the array are left unsorted until a final insertion
--     sort pass. This is faster than recursing all the way down to
--     one-element arrays.
--
--   * The pivot for segment [l,u) is chosen as the median of the elements at
--     l, u-1 and (u+l)/2. This yields good behavior on mostly sorted (or
--     reverse-sorted) arrays.
--
--   * The algorithm tracks its recursion depth, and if it decides it is
--     taking too long (depth greater than 2 * lg n), it switches to a heap
--     sort to maintain O(n lg n) worst case behavior. (This is what makes the
--     algorithm introsort).

module Data.Vector.Algorithms.Intro
       ( -- * Sorting
         sort
       , sortUniq
       , sortBy
       , sortUniqBy
       , sortByBounds
         -- * Selecting
       , select
       , selectBy
       , selectByBounds
         -- * Partial sorting
       , partialSort
       , partialSortBy
       , partialSortByBounds
       , Comparison
       ) where

import Prelude hiding (read, length)

import Control.Monad
import Control.Monad.Primitive

import Data.Bits
import Data.Vector.Generic.Mutable

import Data.Vector.Algorithms.Common (Comparison, midPoint, uniqueMutableBy)

import qualified Data.Vector.Algorithms.Insertion as I
import qualified Data.Vector.Algorithms.Optimal   as O
import qualified Data.Vector.Algorithms.Heap      as H

-- | Sorts an entire array using the default ordering.
sort :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m ()
sort :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e, Ord e) =>
v (PrimState m) e -> m ()
sort = Comparison e -> v (PrimState m) e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
sortBy Comparison e
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINABLE sort #-}

-- | A variant on `sort` that returns a vector of unique elements.
sortUniq :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m (v (PrimState m) e)
sortUniq :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e, Ord e) =>
v (PrimState m) e -> m (v (PrimState m) e)
sortUniq = Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
sortUniqBy Comparison e
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINABLE sortUniq #-}

-- | A variant on `sortBy` which returns a vector of unique elements.
sortBy :: (PrimMonad m, MVector v e) => Comparison e -> v (PrimState m) e -> m ()
sortBy :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
sortBy Comparison e
cmp v (PrimState m) e
a = Comparison e -> v (PrimState m) e -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> m ()
sortByBounds Comparison e
cmp v (PrimState m) e
a Int
0 (v (PrimState m) e -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
length v (PrimState m) e
a)
{-# INLINE sortBy #-}

-- | Sorts an entire array using a custom ordering returning a vector of
-- the unique elements.
sortUniqBy :: (PrimMonad m, MVector v e) => Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
sortUniqBy :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
sortUniqBy Comparison e
cmp v (PrimState m) e
a = do
  Comparison e -> v (PrimState m) e -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> m ()
sortByBounds Comparison e
cmp v (PrimState m) e
a Int
0 (v (PrimState m) e -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
length v (PrimState m) e
a)
  Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
uniqueMutableBy Comparison e
cmp v (PrimState m) e
a
{-# INLINE sortUniqBy #-}

-- | Sorts a portion of an array [l,u) using a custom ordering
sortByBounds
  :: (PrimMonad m, MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ lower index, l
  -> Int -- ^ upper index, u
  -> m ()
sortByBounds :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> m ()
sortByBounds Comparison e
cmp v (PrimState m) e
a Int
l Int
u
  | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2   = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2  = Comparison e -> v (PrimState m) e -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> m ()
O.sort2ByOffset Comparison e
cmp v (PrimState m) e
a Int
l
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3  = Comparison e -> v (PrimState m) e -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> m ()
O.sort3ByOffset Comparison e
cmp v (PrimState m) e
a Int
l
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4  = Comparison e -> v (PrimState m) e -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> m ()
O.sort4ByOffset Comparison e
cmp v (PrimState m) e
a Int
l
  | Bool
otherwise = Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
introsort Comparison e
cmp v (PrimState m) e
a (Int -> Int
ilg Int
len) Int
l Int
u
 where len :: Int
len = Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l
{-# INLINE sortByBounds #-}

-- Internal version of the introsort loop which allows partial
-- sort functions to call with a specified bound on iterations.
introsort :: (PrimMonad m, MVector v e)
          => Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
introsort :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
introsort Comparison e
cmp v (PrimState m) e
a Int
i Int
l Int
u = Int -> Int -> Int -> m ()
sort Int
i Int
l Int
u m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Comparison e -> v (PrimState m) e -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> m ()
I.sortByBounds Comparison e
cmp v (PrimState m) e
a Int
l Int
u
 where
 sort :: Int -> Int -> Int -> m ()
sort Int
0 Int
l Int
u = Comparison e -> v (PrimState m) e -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> m ()
H.sortByBounds Comparison e
cmp v (PrimState m) e
a Int
l Int
u
 sort Int
d Int
l Int
u
   | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
threshold = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
   | Bool
otherwise = do Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
O.sort3ByIndex Comparison e
cmp v (PrimState m) e
a Int
c Int
l (Int
uInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) -- sort the median into the lowest position
                    e
p <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
a Int
l
                    Int
mid <- Comparison e -> v (PrimState m) e -> e -> Int -> Int -> m Int
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> e -> Int -> Int -> m Int
partitionBy Comparison e
cmp v (PrimState m) e
a e
p (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
u
                    v (PrimState m) e -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> Int -> m ()
unsafeSwap v (PrimState m) e
a Int
l (Int
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                    Int -> Int -> Int -> m ()
sort (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
mid Int
u
                    Int -> Int -> Int -> m ()
sort (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
l   (Int
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  where
  len :: Int
len = Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l
  c :: Int
c   = Int -> Int -> Int
midPoint Int
u Int
l
{-# INLINE introsort #-}

-- | Moves the least k elements to the front of the array in
-- no particular order.
select
  :: (PrimMonad m, MVector v e, Ord e)
  => v (PrimState m) e
  -> Int -- ^ number of elements to select, k
  -> m ()
select :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e, Ord e) =>
v (PrimState m) e -> Int -> m ()
select = Comparison e -> v (PrimState m) e -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> m ()
selectBy Comparison e
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINE select #-}

-- | Moves the least k elements (as defined by the comparison) to
-- the front of the array in no particular order.
selectBy
  :: (PrimMonad m, MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ number of elements to select, k
  -> m ()
selectBy :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> m ()
selectBy Comparison e
cmp v (PrimState m) e
a Int
k = Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
selectByBounds Comparison e
cmp v (PrimState m) e
a Int
k Int
0 (v (PrimState m) e -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
length v (PrimState m) e
a)
{-# INLINE selectBy #-}

-- | Moves the least k elements in the interval [l,u) to the positions
-- [l,k+l) in no particular order.
selectByBounds
  :: (PrimMonad m, MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ number of elements to select, k
  -> Int -- ^ lower bound, l
  -> Int -- ^ upper bound, u
  -> m ()
selectByBounds :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
selectByBounds Comparison e
cmp v (PrimState m) e
a Int
k Int
l Int
u
  | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
u    = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = Int -> Int -> Int -> Int -> m ()
go (Int -> Int
ilg Int
len) Int
l (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k) Int
u
 where
 len :: Int
len = Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l
 go :: Int -> Int -> Int -> Int -> m ()
go Int
0 Int
l Int
m Int
u = Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
H.selectByBounds Comparison e
cmp v (PrimState m) e
a (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) Int
l Int
u
 go Int
n Int
l Int
m Int
u = do Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
O.sort3ByIndex Comparison e
cmp v (PrimState m) e
a Int
c Int
l (Int
uInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                 e
p <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
a Int
l
                 Int
mid <- Comparison e -> v (PrimState m) e -> e -> Int -> Int -> m Int
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> e -> Int -> Int -> m Int
partitionBy Comparison e
cmp v (PrimState m) e
a e
p (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
u
                 v (PrimState m) e -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> Int -> m ()
unsafeSwap v (PrimState m) e
a Int
l (Int
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                 if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mid
                   then Int -> Int -> Int -> Int -> m ()
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
mid Int
m Int
u
                   else if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                        then Int -> Int -> Int -> Int -> m ()
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
l Int
m (Int
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                        else () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where c :: Int
c = Int -> Int -> Int
midPoint Int
u Int
l
{-# INLINE selectByBounds #-}

-- | Moves the least k elements to the front of the array, sorted.
partialSort
  :: (PrimMonad m, MVector v e, Ord e)
  => v (PrimState m) e
  -> Int -- ^ number of elements to sort, k
  -> m ()
partialSort :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e, Ord e) =>
v (PrimState m) e -> Int -> m ()
partialSort = Comparison e -> v (PrimState m) e -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> m ()
partialSortBy Comparison e
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINE partialSort #-}

-- | Moves the least k elements (as defined by the comparison) to
-- the front of the array, sorted.
partialSortBy
  :: (PrimMonad m, MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ number of elements to sort, k
  -> m ()
partialSortBy :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> m ()
partialSortBy Comparison e
cmp v (PrimState m) e
a Int
k = Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
partialSortByBounds Comparison e
cmp v (PrimState m) e
a Int
k Int
0 (v (PrimState m) e -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
length v (PrimState m) e
a)
{-# INLINE partialSortBy #-}

-- | Moves the least k elements in the interval [l,u) to the positions
-- [l,k+l), sorted.
partialSortByBounds
  :: (PrimMonad m, MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ number of elements to sort, k
  -> Int -- ^ lower index, l
  -> Int -- ^ upper index, u
  -> m ()
partialSortByBounds :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
partialSortByBounds Comparison e
cmp v (PrimState m) e
a Int
k Int
l Int
u
  | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
u    = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = let k' :: Int
k' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
uInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
l) Int
k
                      -- N.B. Clamp k to the length of the range
                      -- being sorted.
                in Int -> Int -> Int -> Int -> m ()
go (Int -> Int
ilg Int
len) Int
l (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k') Int
u
 where
 isort :: Int -> Int -> Int -> m ()
isort = Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
introsort Comparison e
cmp v (PrimState m) e
a
 {-# INLINE [1] isort #-}
 len :: Int
len = Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l
 go :: Int -> Int -> Int -> Int -> m ()
go Int
0 Int
l Int
m Int
n = Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
H.partialSortByBounds Comparison e
cmp v (PrimState m) e
a (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) Int
l Int
u
 go Int
n Int
l Int
m Int
u
   | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
m    = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
   | Bool
otherwise = do Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
O.sort3ByIndex Comparison e
cmp v (PrimState m) e
a Int
c Int
l (Int
uInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                    e
p <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
a Int
l
                    Int
mid <- Comparison e -> v (PrimState m) e -> e -> Int -> Int -> m Int
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> e -> Int -> Int -> m Int
partitionBy Comparison e
cmp v (PrimState m) e
a e
p (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
u
                    v (PrimState m) e -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> Int -> m ()
unsafeSwap v (PrimState m) e
a Int
l (Int
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                    case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
m Int
mid of
                      Ordering
GT -> do Int -> Int -> Int -> m ()
isort (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
l (Int
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                               Int -> Int -> Int -> Int -> m ()
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
mid Int
m Int
u
                      Ordering
EQ -> Int -> Int -> Int -> m ()
isort (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
l Int
m
                      Ordering
LT -> Int -> Int -> Int -> Int -> m ()
go Int
n Int
l Int
m (Int
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  where c :: Int
c = Int -> Int -> Int
midPoint Int
u Int
l
{-# INLINE partialSortByBounds #-}

partitionBy :: forall m v e. (PrimMonad m, MVector v e)
            => Comparison e -> v (PrimState m) e -> e -> Int -> Int -> m Int
partitionBy :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> e -> Int -> Int -> m Int
partitionBy Comparison e
cmp v (PrimState m) e
a = e -> Int -> Int -> m Int
partUp
 where
 partUp :: e -> Int -> Int -> m Int
 partUp :: e -> Int -> Int -> m Int
partUp e
p Int
l Int
u
   | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
u = do e
e <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
a Int
l
                case Comparison e
cmp e
e e
p of
                  Ordering
LT -> e -> Int -> Int -> m Int
partUp e
p (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
u
                  Ordering
_  -> e -> Int -> Int -> m Int
partDown e
p Int
l (Int
uInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
   | Bool
otherwise = Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
l

 partDown :: e -> Int -> Int -> m Int
 partDown :: e -> Int -> Int -> m Int
partDown e
p Int
l Int
u
   | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
u = do e
e <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
a Int
u
                case Comparison e
cmp e
p e
e of
                  Ordering
LT -> e -> Int -> Int -> m Int
partDown e
p Int
l (Int
uInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                  Ordering
_  -> v (PrimState m) e -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> Int -> m ()
unsafeSwap v (PrimState m) e
a Int
l Int
u m () -> m Int -> m Int
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> e -> Int -> Int -> m Int
partUp e
p (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
u
   | Bool
otherwise = Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
l
{-# INLINE partitionBy #-}

-- computes the number of recursive calls after which heapsort should
-- be invoked given the lower and upper indices of the array to be sorted
ilg :: Int -> Int
ilg :: Int -> Int
ilg Int
m = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int -> Int
forall {t} {t}. (Num t, Num t, Bits t) => t -> t -> t
loop Int
m Int
0
 where
 loop :: t -> t -> t
loop t
0 !t
k = t
k t -> t -> t
forall a. Num a => a -> a -> a
- t
1
 loop t
n !t
k = t -> t -> t
loop (t
n t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) (t
kt -> t -> t
forall a. Num a => a -> a -> a
+t
1)

-- the size of array at which the introsort algorithm switches to insertion sort
threshold :: Int
threshold :: Int
threshold = Int
18
{-# INLINE threshold #-}