66-- {-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all -dsuppress-uniques #-}
77
88-- | This module implements quicksort with mutable arrays from linear-base
9- module Simple .Quicksort where
9+ module Data.Array.Mutable .Quicksort where
1010
1111import Data.Array.Mutable.Linear (Array )
1212import qualified Data.Array.Mutable.Linear as Array
@@ -17,15 +17,22 @@ import Prelude.Linear hiding (partition)
1717-- # Quicksort
1818-------------------------------------------------------------------------------
1919
20- quickSort :: [Int ] -> [Int ]
21- quickSort xs = unur $ Array. fromList xs $ Array. toList . arrQuicksort
20+ qsortUsingList :: (Ord a ) => [a ] -> [a ]
21+ qsortUsingList [] = []
22+ qsortUsingList (x : xs) = qsortUsingList ltx ++ x : qsortUsingList gex
23+ where
24+ ltx = [y | y <- xs, y < x]
25+ gex = [y | y <- xs, y >= x]
2226
23- arrQuicksort :: Array Int % 1 -> Array Int
24- arrQuicksort arr =
27+ qsortUsingArray :: (Ord a ) => [a ] -> [a ]
28+ qsortUsingArray xs = unur $ Array. fromList xs $ Array. toList . qsortArray
29+
30+ qsortArray :: (Ord a ) => Array a % 1 -> Array a
31+ qsortArray arr =
2532 Array. size arr
2633 & \ (Ur len, arr1) -> go 0 (len - 1 ) arr1
2734
28- go :: Int -> Int -> Array Int % 1 -> Array Int
35+ go :: ( Ord a ) => Int -> Int -> Array a % 1 -> Array a
2936go lo hi arr
3037 | lo >= hi = arr
3138 | otherwise =
@@ -43,23 +50,23 @@ go lo hi arr
4350-- @arr'[j] > pivot@ for @ix < j <= hi@,
4451-- @arr'[k] = arr[k]@ for @k < lo@ and @k > hi@, and
4552-- @arr'@ is a permutation of @arr@.
46- partition :: Array Int % 1 -> Int -> Int -> Int -> (Array Int , Ur Int )
47- partition arr pivot lx rx
48- | (rx < lx ) = (arr, Ur (lx - 1 ))
53+ partition :: ( Ord a ) => Array a % 1 -> a -> Int -> Int -> (Array a , Ur Int )
54+ partition arr pivot lo hi
55+ | (hi < lo ) = (arr, Ur (lo - 1 ))
4956 | otherwise =
50- Array. read arr lx
57+ Array. read arr lo
5158 & \ (Ur lVal, arr1) ->
52- Array. read arr1 rx
59+ Array. read arr1 hi
5360 & \ (Ur rVal, arr2) -> case (lVal <= pivot, pivot < rVal) of
54- (True , True ) -> partition arr2 pivot (lx + 1 ) (rx - 1 )
55- (True , False ) -> partition arr2 pivot (lx + 1 ) rx
56- (False , True ) -> partition arr2 pivot lx (rx - 1 )
61+ (True , True ) -> partition arr2 pivot (lo + 1 ) (hi - 1 )
62+ (True , False ) -> partition arr2 pivot (lo + 1 ) hi
63+ (False , True ) -> partition arr2 pivot lo (hi - 1 )
5764 (False , False ) ->
58- swap arr2 lx rx
59- & \ arr3 -> partition arr3 pivot (lx + 1 ) (rx - 1 )
65+ swap arr2 lo hi
66+ & \ arr3 -> partition arr3 pivot (lo + 1 ) (hi - 1 )
6067
6168-- | @swap a i j@ exchanges the positions of values at @i@ and @j@ of @a@.
62- swap :: (HasCallStack ) => Array Int % 1 -> Int -> Int -> Array Int
69+ swap :: (HasCallStack ) => Array a % 1 -> Int -> Int -> Array a
6370swap arr i j =
6471 Array. read arr i
6572 & \ (Ur ival, arr1) ->
0 commit comments