module Data.Tensort.Subalgorithms.Exchangesort (exchangesort) where import Data.Tensort.Utils.ComparisonFunctions (greaterThanBit, greaterThanRecord) import Data.Tensort.Utils.Types (Sortable (..)) exchangesort :: Sortable -> Sortable exchangesort :: Sortable -> Sortable exchangesort (SortBit [Int] bits) = [Int] -> Sortable SortBit ([Int] -> Int -> Int -> (Int -> Int -> Bool) -> [Int] forall a. [a] -> Int -> Int -> (a -> a -> Bool) -> [a] exchangesortIterable [Int] bits ([Int] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [Int] bits Int -> Int -> Int forall a. Num a => a -> a -> a - Int 1) ([Int] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [Int] bits Int -> Int -> Int forall a. Num a => a -> a -> a - Int 2) Int -> Int -> Bool greaterThanBit) exchangesort (SortRec [Record] recs) = [Record] -> Sortable SortRec ([Record] -> Int -> Int -> (Record -> Record -> Bool) -> [Record] forall a. [a] -> Int -> Int -> (a -> a -> Bool) -> [a] exchangesortIterable [Record] recs ([Record] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [Record] recs Int -> Int -> Int forall a. Num a => a -> a -> a - Int 1) ([Record] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [Record] recs Int -> Int -> Int forall a. Num a => a -> a -> a - Int 2) Record -> Record -> Bool greaterThanRecord) exchangesortIterable :: [a] -> Int -> Int -> (a -> a -> Bool) -> [a] exchangesortIterable :: forall a. [a] -> Int -> Int -> (a -> a -> Bool) -> [a] exchangesortIterable [a] xs Int i Int j a -> a -> Bool greaterThan = do if Int i Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 0 then [a] xs else if Int j Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 0 then [a] -> Int -> Int -> (a -> a -> Bool) -> [a] forall a. [a] -> Int -> Int -> (a -> a -> Bool) -> [a] exchangesortIterable [a] xs (Int i Int -> Int -> Int forall a. Num a => a -> a -> a - Int 1) ([a] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [a] xs Int -> Int -> Int forall a. Num a => a -> a -> a - Int 1) a -> a -> Bool greaterThan else if ((Int i Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int j) Bool -> Bool -> Bool && a -> a -> Bool greaterThan ([a] xs [a] -> Int -> a forall a. HasCallStack => [a] -> Int -> a !! Int j) ([a] xs [a] -> Int -> a forall a. HasCallStack => [a] -> Int -> a !! Int i)) Bool -> Bool -> Bool || ((Int j Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int i) Bool -> Bool -> Bool && a -> a -> Bool greaterThan ([a] xs [a] -> Int -> a forall a. HasCallStack => [a] -> Int -> a !! Int i) ([a] xs [a] -> Int -> a forall a. HasCallStack => [a] -> Int -> a !! Int j)) then [a] -> Int -> Int -> (a -> a -> Bool) -> [a] forall a. [a] -> Int -> Int -> (a -> a -> Bool) -> [a] exchangesortIterable ([a] -> Int -> Int -> [a] forall a. [a] -> Int -> Int -> [a] swap [a] xs Int i Int j) Int i (Int j Int -> Int -> Int forall a. Num a => a -> a -> a - Int 1) a -> a -> Bool greaterThan else [a] -> Int -> Int -> (a -> a -> Bool) -> [a] forall a. [a] -> Int -> Int -> (a -> a -> Bool) -> [a] exchangesortIterable [a] xs Int i (Int j Int -> Int -> Int forall a. Num a => a -> a -> a - Int 1) a -> a -> Bool greaterThan swap :: [a] -> Int -> Int -> [a] swap :: forall a. [a] -> Int -> Int -> [a] swap [a] xs Int i Int j = do let x :: a x = [a] xs [a] -> Int -> a forall a. HasCallStack => [a] -> Int -> a !! Int i let y :: a y = [a] xs [a] -> Int -> a forall a. HasCallStack => [a] -> Int -> a !! Int j let mini :: Int mini = Int -> Int -> Int forall a. Ord a => a -> a -> a min Int i Int j let maxi :: Int maxi = Int -> Int -> Int forall a. Ord a => a -> a -> a max Int i Int j let left :: [a] left = Int -> [a] -> [a] forall a. Int -> [a] -> [a] take Int mini [a] xs let middle :: [a] middle = Int -> [a] -> [a] forall a. Int -> [a] -> [a] take (Int maxi Int -> Int -> Int forall a. Num a => a -> a -> a - Int mini Int -> Int -> Int forall a. Num a => a -> a -> a - Int 1) (Int -> [a] -> [a] forall a. Int -> [a] -> [a] drop (Int mini Int -> Int -> Int forall a. Num a => a -> a -> a + Int 1) [a] xs) let right :: [a] right = Int -> [a] -> [a] forall a. Int -> [a] -> [a] drop (Int maxi Int -> Int -> Int forall a. Num a => a -> a -> a + Int 1) [a] xs [a] left [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] ++ [a y] [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] ++ [a] middle [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] ++ [a x] [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] ++ [a] right