{-# LANGUAGE Safe #-}

{- |
    Module      :  SDP.SortM.Insertion
    Copyright   :  (c) Andrey Mulik 2019
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  portable
    
    "SDP.SortM.Insertion" provides insertion sort - simple sorting algorithm.
-}
module SDP.SortM.Insertion
(
  -- * Insertion Sort
  insertionSort, insertionSortBy, insertionSortOn, unsafeInsertionSort
)
where

import Prelude ()
import SDP.SafePrelude
import SDP.IndexedM

default ()

--------------------------------------------------------------------------------

-- | 'insertionSort' is just synonym for @'insertionSortBy' 'compare'@.
{-# INLINE insertionSort #-}
insertionSort :: (LinearM m v e, BorderedM m v i, Ord e) => v -> m ()
insertionSort :: v -> m ()
insertionSort =  Compare e -> v -> m ()
forall (m :: * -> *) v e i.
(LinearM m v e, BorderedM m v i) =>
Compare e -> v -> m ()
insertionSortBy Compare e
forall a. Ord a => a -> a -> Ordering
compare

{- |
  'insertionSortOn' is a version of 'insertionSortBy' that uses a cast function
  to 'compare' elements.
-}
{-# INLINE insertionSortOn #-}
insertionSortOn :: (LinearM m v e, BorderedM m v i, Ord o) => (e -> o) -> v -> m ()
insertionSortOn :: (e -> o) -> v -> m ()
insertionSortOn =  Compare e -> v -> m ()
forall (m :: * -> *) v e i.
(LinearM m v e, BorderedM m v i) =>
Compare e -> v -> m ()
insertionSortBy (Compare e -> v -> m ())
-> ((e -> o) -> Compare e) -> (e -> o) -> v -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> o) -> Compare e
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing

{- |
  'insertionSortBy' is naive service sorting procedure, that have @O(n^2)@
  complexity in all cases.
-}
{-# INLINE insertionSortBy #-}
insertionSortBy :: (LinearM m v e, BorderedM m v i) => Compare e -> v -> m ()
insertionSortBy :: Compare e -> v -> m ()
insertionSortBy Compare e
cmp v
es = do Int
n <- v -> m Int
forall (m :: * -> *) b i. BorderedM m b i => b -> m Int
getSizeOf v
es; Compare e -> v -> Int -> Int -> Int -> m ()
forall (m :: * -> *) v e.
LinearM m v e =>
Compare e -> v -> Int -> Int -> Int -> m ()
unsafeInsertionSort Compare e
cmp v
es Int
0 Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

--------------------------------------------------------------------------------

{- |
  unsafeInsertionSort cmp es b s e is internal sorting procedure, where
  @cmp@ - compare function, @es@ - data structure, @[b .. s]@ - sorted range,
  @[b .. e]@ - sortable range.
-}
unsafeInsertionSort :: (LinearM m v e) => Compare e -> v -> Int -> Int -> Int -> m ()
unsafeInsertionSort :: Compare e -> v -> Int -> Int -> Int -> m ()
unsafeInsertionSort Compare e
cmp v
es Int
b Int
s Int
e = [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
e] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ Int
i -> do
  e
ei <- v
es v -> Int -> m e
forall (m :: * -> *) l e. LinearM m l e => l -> Int -> m e
!#> Int
i
  let
    next' :: Int -> Int -> Int -> m Int
next' Int
l Int
u Int
j = Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
u Bool -> m Int -> m Int -> m Int
forall a. Bool -> a -> a -> a
? Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
j (m Int -> m Int) -> m Int -> m Int
forall a b. (a -> b) -> a -> b
$ do
      let c :: Int
c = (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
u) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
      e
ec <- v
es v -> Int -> m e
forall (m :: * -> *) l e. LinearM m l e => l -> Int -> m e
!#> Int
c
      case e
ei Compare e
`cmp` e
ec of
        Ordering
GT -> Int -> Int -> Int -> m Int
next' (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
u Int
j
        Ordering
LT -> Int -> Int -> Int -> m Int
next' Int
l (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
c
        Ordering
EQ -> Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  Int
p <- Int -> Int -> Int -> m Int
forall (m :: * -> *). LinearM m v e => Int -> Int -> Int -> m Int
next' Int
b (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
i
  (Int -> m ()) -> [Int] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (v -> Int -> Int -> m ()
forall (m :: * -> *) l e. LinearM m l e => l -> Int -> Int -> m ()
swapM v
es Int
i) [Int
p .. Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]