COMMENT:-----------------------

"Ubersetzung:
        ghc -c HeapSort.lhs
Mit der -O Option gibt es einen `Heap space exhausted'.
-------------------------------

> import BinTree

> hsort                 :: Ord a => [a] -> [a]
> hsort                 =  hsortBy (<=)

> hsortBy               :: (a -> a -> Bool) -> [a] -> [a]
> hsortBy (<=)          =  unheap (<=) . buildHeap (<=)

> buildHeap             :: (a -> a -> Bool) -> [a] -> BinTree a
> buildHeap (<=)        =  foldl (sink (<=)) Empty

> sink (<=) Empty a     =  Node Empty a Empty
> sink (<=) (Node l b r) a
>     | a <= b          =  Node (fall r b) a l
>     | otherwise       =  Node (sink (<=) r a) b l

> fall Empty a          =  Node Empty a Empty
> fall (Node l b r) a   =  Node (fall r b) a l

> unheap                        :: (a -> a -> Bool) -> BinTree a -> [a]
> unheap (<=) Empty             =  []
> unheap (<=) (Node l a r)      =  a : unheap (<=) (reheap (<=) l r)

> reheap (<=) Empty t           =  t
> reheap (<=) t@(Node l a r) Empty = t
> reheap (<=) t@(Node ll a lr) u@(Node rl b rr)
>     | a <= b                  =  Node (reheap (<=) ll lr) a u
>     | otherwise               =  Node t b (reheap (<=) rl rr)

> bhsort                :: Ord a => [a] -> [a]
> bhsort                =  bhsortBy (<=)

> bhsortBy              :: (a -> a -> Bool) -> [a] -> [a]
> bhsortBy (<=)         =  unheap (<=) . buildBalHeap (<=)

> buildBalHeap                  :: (a -> a -> Bool) -> [a] -> BinTree a
> buildBalHeap (<=) x           =  fst (splitBuildHeap (<=) (length x) x)

> splitBuildHeap (<=) 0 x       =  (Empty,x)
> splitBuildHeap (<=) (n+1) (a:x)=  (heapify (<=) l a r,z)
>     where m                   =  n `div` 2
>           (l,y)               =  splitBuildHeap (<=) m x
>           (r,z)               =  splitBuildHeap (<=) (n - m) y

> heapify                       :: (a -> a -> Bool)
>                               -> BinTree a -> a -> BinTree a -> BinTree a
> heapify (<=) Empty a Empty    =  Node Empty a Empty
> heapify (<=) Empty a (Node rl c rr)
>                               =  swapr (<=) Empty a rl c rr
> heapify (<=) (Node ll b lr) a Empty
>                               =  swapl (<=) ll b lr a Empty
> heapify (<=) l@(Node ll b lr) a r@(Node rl c rr)
>     | b <= c                  =  swapl (<=) ll b lr a r
>     | otherwise               =  swapr (<=) l a rl c rr

> swapl (<=) ll b lr a r
>     | a <= b                  =  Node (Node ll b lr) a r
>     | otherwise               =  Node (heapify (<=) ll a lr) b r
> swapr (<=) l a rl b rr
>     | a <= b                  =  Node l a (Node rl b rr)
>     | otherwise               =  Node l b (heapify (<=) rl a rr)