------------------------------------------------------------------------------
--- A collection of useful functions for sorting and comparing
--- characters, strings, and lists.
---
--- @author Michael Hanus
--- @version April 2016
--- @category algorithm
------------------------------------------------------------------------------
{-# OPTIONS_CYMAKE -Wno-overlapping #-}
module Sort
( sort, sortBy, sorted, sortedBy
, permSort, permSortBy, insertionSort, insertionSortBy
, quickSort, quickSortBy, mergeSort, mergeSortBy
, cmpChar, cmpList, cmpString
, leqChar, leqCharIgnoreCase, leqList
, leqString, leqStringIgnoreCase, leqLexGerman
) where
import Char ( toLower, toUpper )
--- The default sorting operation, mergeSort, with standard ordering `<=`.
sort :: Ord a => [a] -> [a]
sort = sortBy (<=)
-- Postcondition: input and output lists have same length and output is sorted.
sort'post :: Ord a => [a] -> [a] -> Bool
sort'post xs ys = length xs == length ys && sorted ys
-- Specification via permutation sort:
sort'spec :: Ord a => [a] -> [a]
sort'spec xs = permSort xs
--- The default sorting operation: mergeSort
sortBy :: (a -> a -> Bool) -> [a] -> [a]
sortBy = mergeSortBy
--- `sorted xs` is satisfied if the elements `xs` are in ascending order.
sorted :: Ord a => [a] -> Bool
sorted = sortedBy (<=)
--- `sortedBy leq xs` is satisfied if all adjacent elements of the list `xs`
--- satisfy the ordering predicate `leq`.
sortedBy :: (a -> a -> Bool) -> [a] -> Bool
sortedBy _ [] = True
sortedBy _ [_] = True
sortedBy leq (x:y:ys) = leq x y && sortedBy leq (y:ys)
------------------------------------------------------------------------------
--- Permutation sort with standard ordering `<=`.
--- Sorts a list by finding a sorted permutation
--- of the input. This is not a usable way to sort a list but it can be used
--- as a specification of other sorting algorithms.
permSort :: Ord a => [a] -> [a]
permSort = permSortBy (<=)
--- Permutation sort with ordering as first parameter.
--- Sorts a list by finding a sorted permutation
--- of the input. This is not a usable way to sort a list but it can be used
--- as a specification of other sorting algorithms.
permSortBy :: Eq a => (a -> a -> Bool) -> [a] -> [a]
permSortBy leq xs | sortedBy leq ys = ys
where ys = perm xs
--- Computes a permutation of a list.
perm :: [a] -> [a]
perm [] = []
perm (x:xs) = insert (perm xs)
where
insert ys = x : ys
insert (y:ys) = y : insert ys
------------------------------------------------------------------------------
--- Insertion sort with standard ordering `<=`.
--- The list is sorted by repeated sorted insertion of the elements
--- into the already sorted part of the list.
insertionSort :: Ord a => [a] -> [a]
insertionSort = insertionSortBy (<=)
-- Postcondition: input and output lists have same length and output is sorted.
insertionSort'post :: Ord a => [a] -> [a] -> Bool
insertionSort'post xs ys = length xs == length ys && sorted ys
-- Specification via permutation sort:
insertionSort'spec :: Ord a => [a] -> [a]
insertionSort'spec = permSort
--- Insertion sort with ordering as first parameter.
--- The list is sorted by repeated sorted insertion of the elements
--- into the already sorted part of the list.
insertionSortBy :: (a -> a -> Bool) -> [a] -> [a]
insertionSortBy _ [] = []
insertionSortBy leq (x:xs) = insert (insertionSortBy leq xs)
where
insert [] = [x]
insert zs@(y:ys) | leq x y = x : zs
| otherwise = y : insert ys
------------------------------------------------------------------------------
--- Quicksort with standard ordering `<=`.
--- The classical quicksort algorithm on lists.
quickSort :: Ord a => [a] -> [a]
quickSort = quickSortBy (<=)
-- Postcondition: input and output lists have same length and output is sorted.
quickSort'post :: Ord a => [a] -> [a] -> Bool
quickSort'post xs ys = length xs == length ys && sorted ys
-- Specification via permutation sort:
quickSort'spec :: Ord a => [a] -> [a]
quickSort'spec = permSort
--- Quicksort with ordering as first parameter.
--- The classical quicksort algorithm on lists.
quickSortBy :: (a -> a -> Bool) -> [a] -> [a]
quickSortBy _ [] = []
quickSortBy leq (x:xs) = let (l,r) = split x xs
in quickSortBy leq l ++ (x : quickSortBy leq r)
where
split _ [] = ([],[])
split e (y:ys) | leq y e = (y:l,r)
| otherwise = (l,y:r)
where (l,r) = split e ys
------------------------------------------------------------------------------
--- Bottom-up mergesort with standard ordering `<=`.
mergeSort :: Ord a => [a] -> [a]
mergeSort = mergeSortBy (<=)
-- Postcondition: input and output lists have same length and output is sorted.
mergeSort'post :: Ord a => [a] -> [a] -> Bool
mergeSort'post xs ys = length xs == length ys && sorted ys
-- Specification via permutation sort:
mergeSort'spec :: Ord a => [a] -> [a]
mergeSort'spec = permSort
--- Bottom-up mergesort with ordering as first parameter.
mergeSortBy :: (a -> a -> Bool) -> [a] -> [a]
mergeSortBy leq zs = mergeLists (genRuns zs)
where
-- generate runs of length 2:
genRuns [] = []
genRuns [x] = [[x]]
genRuns (x1:x2:xs) | leq x1 x2 = [x1,x2] : genRuns xs
| otherwise = [x2,x1] : genRuns xs
-- merge the runs:
mergeLists [] = []
mergeLists [x] = x
mergeLists (x1:x2:xs) = mergeLists (merge leq x1 x2 : mergePairs xs)
mergePairs [] = []
mergePairs [x] = [x]
mergePairs (x1:x2:xs) = merge leq x1 x2 : mergePairs xs
--- Merges two lists with respect to an ordering predicate.
merge :: (a -> a -> Bool) -> [a] -> [a] -> [a]
merge _ [] ys = ys
merge _ (x:xs) [] = x : xs
merge leq (x:xs) (y:ys) | leq x y = x : merge leq xs (y:ys)
| otherwise = y : merge leq (x:xs) ys
------------------------------------------------------------------------------
-- Comparing lists, characters and strings
--- Less-or-equal on lists.
leqList :: Eq a => (a -> a -> Bool) -> [a] -> [a] -> Bool
leqList _ [] _ = True
leqList _ (_:_) [] = False
leqList leq (x:xs) (y:ys) | x == y = leqList leq xs ys
| otherwise = leq x y
--- Comparison of lists.
cmpList :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering
cmpList _ [] [] = EQ
cmpList _ [] (_:_) = LT
cmpList _ (_:_) [] = GT
cmpList cmp (x:xs) (y:ys) | cmp x y == EQ = cmpList cmp xs ys
| otherwise = cmp x y
--- Less-or-equal on characters (deprecated, use 'Prelude.<=').
leqChar :: Char -> Char -> Bool
leqChar = (<=)
--- Comparison of characters (deprecated, use 'Prelude.compare').
cmpChar :: Char -> Char -> Ordering
cmpChar = compare
--- Less-or-equal on characters ignoring case considerations.
leqCharIgnoreCase :: Char -> Char -> Bool
leqCharIgnoreCase c1 c2 = (toUpper c1) <= (toUpper c2)
--- Less-or-equal on strings (deprecated, use 'Prelude.<=').
leqString :: String -> String -> Bool
leqString = (<=)
--- Comparison of strings (deprecated, use 'Prelude.compare').
cmpString :: String -> String -> Ordering
cmpString = compare
--- Less-or-equal on strings ignoring case considerations.
leqStringIgnoreCase :: String -> String -> Bool
leqStringIgnoreCase = leqList leqCharIgnoreCase
--- Lexicographical ordering on German strings.
--- Thus, upper/lowercase are not distinguished and Umlauts are sorted
--- as vocals.
leqLexGerman :: String -> String -> Bool
leqLexGerman [] _ = True
leqLexGerman (_:_) [] = False
leqLexGerman (x:xs) (y:ys) | x' == y' = leqLexGerman xs ys
| otherwise = x' < y'
where
x' = glex (ord x)
y' = glex (ord y)
-- map umlauts to vocals and make everything lowercase:
glex o | o >= ord 'A' && o <= ord 'Z' = o + (ord 'a' - ord 'A')
| o == 228 = ord 'a'
| o == 246 = ord 'o'
| o == 252 = ord 'u'
| o == 196 = ord 'a'
| o == 214 = ord 'o'
| o == 220 = ord 'u'
| o == 223 = ord 's'
| otherwise = o
-- end module Sort