{-# LANGUAGE TypeFamilies #-}

-- ---------------------------------------------------------------------------
-- |
-- Module      : Data.Vector.Algorithms.Insertion
-- Copyright   : (c) 2008-2010 Dan Doel
-- Maintainer  : Dan Doel
-- Stability   : Experimental
-- Portability : Portable
--
-- A simple insertion sort. Though it's O(n^2), its iterative nature can be
-- beneficial for small arrays. It is used to sort small segments of an array
-- by some of the more heavy-duty, recursive algorithms.

module Data.Vector.Algorithms.Insertion
       ( sort
       , sortUniq
       , sortBy
       , sortUniqBy
       , sortByBounds
       , sortByBounds'
       , Comparison
       ) where


import Prelude hiding (read, length)

import Control.Monad.Primitive

import Data.Vector.Generic.Mutable

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

import qualified Data.Vector.Algorithms.Optimal as O

-- | Sorts an entire array using the default comparison for the type
sort :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m ()
sort :: 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 :: 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 #-}

-- | Sorts an entire array using a given comparison
sortBy :: (PrimMonad m, MVector v e) => Comparison e -> v (PrimState m) e -> m ()
sortBy :: 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 #-}

-- | A variant on `sortBy` which returns a vector of unique elements.
sortUniqBy :: (PrimMonad m, MVector v e) => Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
sortUniqBy :: 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 the portion of an array delimited by [l,u)
sortByBounds :: (PrimMonad m, MVector v e)
             => Comparison e -> v (PrimState m) e -> Int -> Int -> m ()
sortByBounds :: 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 (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 -> 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 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 ()
sortByBounds' Comparison e
cmp v (PrimState m) e
a Int
l (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int
u
 where
 len :: Int
len = Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l
{-# INLINE sortByBounds #-}

-- | Sorts the portion of the array delimited by [l,u) under the assumption
-- that [l,m) is already sorted.
sortByBounds' :: (PrimMonad m, MVector v e)
              => Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
sortByBounds' :: Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
sortByBounds' Comparison e
cmp v (PrimState m) e
a Int
l Int
m Int
u = Int -> m ()
sort Int
m
 where
 sort :: Int -> m ()
sort Int
i
   | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
u     = do e
v <- 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
i
                    Comparison e -> v (PrimState m) e -> Int -> e -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> e -> Int -> m ()
insert Comparison e
cmp v (PrimState m) e
a Int
l e
v Int
i
                    Int -> m ()
sort (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
   | Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE sortByBounds' #-}

-- Given a sorted array in [l,u), inserts val into its proper position,
-- yielding a sorted [l,u]
insert :: (PrimMonad m, MVector v e)
       => Comparison e -> v (PrimState m) e -> Int -> e -> Int -> m ()
insert :: Comparison e -> v (PrimState m) e -> Int -> e -> Int -> m ()
insert Comparison e
cmp v (PrimState m) e
a Int
l = e -> Int -> m ()
loop
 where
 loop :: e -> Int -> m ()
loop e
val Int
j
   | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l    = v (PrimState m) e -> Int -> e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
unsafeWrite v (PrimState m) e
a Int
l e
val
   | Bool
otherwise = 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
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                    case Comparison e
cmp e
val e
e of
                      Ordering
LT -> v (PrimState m) e -> Int -> e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
unsafeWrite v (PrimState m) e
a Int
j e
e m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> e -> Int -> m ()
loop e
val (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                      Ordering
_  -> v (PrimState m) e -> Int -> e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
unsafeWrite v (PrimState m) e
a Int
j e
val
{-# INLINE insert #-}