{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- Uncomment the line below to observe the generated (optimised) Core. It will
-- land in a file named “Quicksort.dump-simpl”
-- {-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all -dsuppress-uniques #-}

-- | This module implements quicksort with mutable arrays from linear-base
module Simple.Quicksort where

import Data.Array.Mutable.Linear (Array)
import qualified Data.Array.Mutable.Linear as Array
import Data.Unrestricted.Linear
import GHC.Stack
import Prelude.Linear hiding (partition)

-- # Quicksort
-------------------------------------------------------------------------------

quicksortUsingList :: (Ord a) => [a] -> [a]
quicksortUsingList :: forall a. Ord a => [a] -> [a]
quicksortUsingList [] = []
quicksortUsingList (a
x : [a]
xs) = [a] -> [a]
forall a. Ord a => [a] -> [a]
quicksortUsingList [a]
ltx [a] %1 -> [a] %1 -> [a]
forall a. [a] %1 -> [a] %1 -> [a]
++ a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
forall a. Ord a => [a] -> [a]
quicksortUsingList [a]
gex
  where
    ltx :: [a]
ltx = [a
y | a
y <- [a]
xs, a
y a %1 -> a %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
< a
x]
    gex :: [a]
gex = [a
y | a
y <- [a]
xs, a
y a %1 -> a %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
>= a
x]

quicksortUsingArray :: (Ord a) => [a] -> [a]
quicksortUsingArray :: forall a. Ord a => [a] -> [a]
quicksortUsingArray [a]
xs = Ur [a] %1 -> [a]
forall a. Ur a %1 -> a
unur (Ur [a] %1 -> [a]) -> Ur [a] %1 -> [a]
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ [a] -> (Array a %1 -> Ur [a]) %1 -> Ur [a]
forall b a.
(HasCallStack, Movable b) =>
[a] -> (Array a %1 -> b) %1 -> b
Array.fromList [a]
xs ((Array a %1 -> Ur [a]) %1 -> Ur [a])
-> (Array a %1 -> Ur [a]) %1 -> Ur [a]
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ Array a %1 -> Ur [a]
forall a. Array a %1 -> Ur [a]
Array.toList (Array a %1 -> Ur [a])
-> (Array a %1 -> Array a) -> Array a %1 -> Ur [a]
forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. Array a %1 -> Array a
forall a. Ord a => Array a %1 -> Array a
quicksortArray

quicksortArray :: (Ord a) => Array a %1 -> Array a
quicksortArray :: forall a. Ord a => Array a %1 -> Array a
quicksortArray Array a
arr =
  Array a %1 -> (Ur Int, Array a)
forall a. Array a %1 -> (Ur Int, Array a)
Array.size Array a
arr
    (Ur Int, Array a)
%1 -> ((Ur Int, Array a) %1 -> Array a) -> Array a
forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur Int
len, Array a
arr1) -> Int -> Int -> Array a %1 -> Array a
forall a. Ord a => Int -> Int -> Array a %1 -> Array a
go Int
0 (Int
len Int %1 -> Int %1 -> Int
forall a. AdditiveGroup a => a %1 -> a %1 -> a
- Int
1) Array a
arr1

go :: (Ord a) => Int -> Int -> Array a %1 -> Array a
go :: forall a. Ord a => Int -> Int -> Array a %1 -> Array a
go Int
lo Int
hi Array a
arr
  | Int
lo Int %1 -> Int %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
>= Int
hi = Array a
arr
  | Bool
otherwise =
      Array a %1 -> Int -> (Ur a, Array a)
forall a. HasCallStack => Array a %1 -> Int -> (Ur a, Array a)
Array.read Array a
arr Int
lo
        (Ur a, Array a) %1 -> ((Ur a, Array a) %1 -> Array a) -> Array a
forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur a
pivot, Array a
arr1) ->
          Array a %1 -> a -> Int -> Int -> (Array a, Ur Int)
forall a.
Ord a =>
Array a %1 -> a -> Int -> Int -> (Array a, Ur Int)
partition Array a
arr1 a
pivot Int
lo Int
hi
            (Array a, Ur Int)
%1 -> ((Array a, Ur Int) %1 -> Array a) -> Array a
forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Array a
arr2, Ur Int
ix) ->
              Array a %1 -> Int -> Int -> Array a
forall a. HasCallStack => Array a %1 -> Int -> Int -> Array a
swap Array a
arr2 Int
lo Int
ix
                Array a %1 -> (Array a %1 -> Array a) -> Array a
forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \Array a
arr3 ->
                  Int -> Int -> Array a %1 -> Array a
forall a. Ord a => Int -> Int -> Array a %1 -> Array a
go Int
lo (Int
ix Int %1 -> Int %1 -> Int
forall a. AdditiveGroup a => a %1 -> a %1 -> a
- Int
1) Array a
arr3
                    Array a %1 -> (Array a %1 -> Array a) -> Array a
forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \Array a
arr4 -> Int -> Int -> Array a %1 -> Array a
forall a. Ord a => Int -> Int -> Array a %1 -> Array a
go (Int
ix Int %1 -> Int %1 -> Int
forall a. Additive a => a %1 -> a %1 -> a
+ Int
1) Int
hi Array a
arr4

-- | @partition arr pivot lo hi = (arr', Ur ix)@ such that
-- @arr'[i] <= pivot@ for @lo <= i <= ix@,
-- @arr'[j] > pivot@ for @ix < j <= hi@,
-- @arr'[k] = arr[k]@ for @k < lo@ and @k > hi@, and
-- @arr'@ is a permutation of @arr@.
partition :: (Ord a) => Array a %1 -> a -> Int -> Int -> (Array a, Ur Int)
partition :: forall a.
Ord a =>
Array a %1 -> a -> Int -> Int -> (Array a, Ur Int)
partition Array a
arr a
pivot Int
lo Int
hi
  | (Int
hi Int %1 -> Int %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
< Int
lo) = (Array a
arr, Int -> Ur Int
forall a. a -> Ur a
Ur (Int
lo Int %1 -> Int %1 -> Int
forall a. AdditiveGroup a => a %1 -> a %1 -> a
- Int
1))
  | Bool
otherwise =
      Array a %1 -> Int -> (Ur a, Array a)
forall a. HasCallStack => Array a %1 -> Int -> (Ur a, Array a)
Array.read Array a
arr Int
lo
        (Ur a, Array a)
%1 -> ((Ur a, Array a) %1 -> (Array a, Ur Int))
-> (Array a, Ur Int)
forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur a
lVal, Array a
arr1) ->
          Array a %1 -> Int -> (Ur a, Array a)
forall a. HasCallStack => Array a %1 -> Int -> (Ur a, Array a)
Array.read Array a
arr1 Int
hi
            (Ur a, Array a)
%1 -> ((Ur a, Array a) %1 -> (Array a, Ur Int))
-> (Array a, Ur Int)
forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur a
rVal, Array a
arr2) -> case (a
lVal a %1 -> a %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
<= a
pivot, a
pivot a %1 -> a %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
< a
rVal) of
              (Bool
True, Bool
True) -> Array a %1 -> a -> Int -> Int -> (Array a, Ur Int)
forall a.
Ord a =>
Array a %1 -> a -> Int -> Int -> (Array a, Ur Int)
partition Array a
arr2 a
pivot (Int
lo Int %1 -> Int %1 -> Int
forall a. Additive a => a %1 -> a %1 -> a
+ Int
1) (Int
hi Int %1 -> Int %1 -> Int
forall a. AdditiveGroup a => a %1 -> a %1 -> a
- Int
1)
              (Bool
True, Bool
False) -> Array a %1 -> a -> Int -> Int -> (Array a, Ur Int)
forall a.
Ord a =>
Array a %1 -> a -> Int -> Int -> (Array a, Ur Int)
partition Array a
arr2 a
pivot (Int
lo Int %1 -> Int %1 -> Int
forall a. Additive a => a %1 -> a %1 -> a
+ Int
1) Int
hi
              (Bool
False, Bool
True) -> Array a %1 -> a -> Int -> Int -> (Array a, Ur Int)
forall a.
Ord a =>
Array a %1 -> a -> Int -> Int -> (Array a, Ur Int)
partition Array a
arr2 a
pivot Int
lo (Int
hi Int %1 -> Int %1 -> Int
forall a. AdditiveGroup a => a %1 -> a %1 -> a
- Int
1)
              (Bool
False, Bool
False) ->
                Array a %1 -> Int -> Int -> Array a
forall a. HasCallStack => Array a %1 -> Int -> Int -> Array a
swap Array a
arr2 Int
lo Int
hi
                  Array a
%1 -> (Array a %1 -> (Array a, Ur Int)) -> (Array a, Ur Int)
forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \Array a
arr3 -> Array a %1 -> a -> Int -> Int -> (Array a, Ur Int)
forall a.
Ord a =>
Array a %1 -> a -> Int -> Int -> (Array a, Ur Int)
partition Array a
arr3 a
pivot (Int
lo Int %1 -> Int %1 -> Int
forall a. Additive a => a %1 -> a %1 -> a
+ Int
1) (Int
hi Int %1 -> Int %1 -> Int
forall a. AdditiveGroup a => a %1 -> a %1 -> a
- Int
1)

-- | @swap a i j@ exchanges the positions of values at @i@ and @j@ of @a@.
swap :: (HasCallStack) => Array a %1 -> Int -> Int -> Array a
swap :: forall a. HasCallStack => Array a %1 -> Int -> Int -> Array a
swap Array a
arr Int
i Int
j =
  Array a %1 -> Int -> (Ur a, Array a)
forall a. HasCallStack => Array a %1 -> Int -> (Ur a, Array a)
Array.read Array a
arr Int
i
    (Ur a, Array a) %1 -> ((Ur a, Array a) %1 -> Array a) -> Array a
forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur a
ival, Array a
arr1) ->
      Array a %1 -> Int -> (Ur a, Array a)
forall a. HasCallStack => Array a %1 -> Int -> (Ur a, Array a)
Array.read Array a
arr1 Int
j
        (Ur a, Array a) %1 -> ((Ur a, Array a) %1 -> Array a) -> Array a
forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur a
jval, Array a
arr2) -> (Int -> a -> Array a %1 -> Array a
forall a. HasCallStack => Int -> a -> Array a %1 -> Array a
Array.set Int
i a
jval (Array a %1 -> Array a)
-> (Array a %1 -> Array a) -> Array a %1 -> Array a
forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. Int -> a -> Array a %1 -> Array a
forall a. HasCallStack => Int -> a -> Array a %1 -> Array a
Array.set Int
j a
ival) Array a
arr2