module HeapSort 
  where
{-
Definitionen:
Sei H ein Binärbaum, dann sei (#H) die Zahl seiner 
inneren Knoten. Ein B-Heap ist ein Binärbaum mit 
Elementen nur in den inneren Knoten, in dem gilt: 
  1. Balance: An jedem inneren Knoten (Kn a h1 h2) gilt für 
              die Sub-Heaps: #h1 - #h2 = 0 oder 1, d.h. ihre 
              Knotenzahl unterscheidet sich maximal um 1 und der linke 
              Teilbaum ist größer.
  2. Ordnung: Das enthaltene Element in einem Knoten ist stets kleiner 
              (oder allenfalls gleich) als die Elemente in beiden 
              Sub-Heaps des Knotens.

Die Funktion "toHeap" muss diese Regeln beachten, ebenso die Funktion 
"removeTop" zum Herausnehmen des obersten Elements.
-}

data BHeap a = Empty 
              | Kn a (BHeap a) (BHeap a) 
        deriving Show -- Anzeigefunktion automatisch erstellen lassen

-- sortieren mit Heap: alles einfügen und sortiert wieder herausnehmen
heapsort :: Ord a => [a] -> [a]
heapsort [] = []
heapsort xs = fromHeap ( toHeap xs)

-- Herausnehmen
fromHeap :: Ord a => BHeap a -> [a]
fromHeap Empty = []
fromHeap heap  = a:(fromHeap h')
        where (a,h') = removeTop heap

-- Einfügen
toHeap :: Ord a => [a] -> BHeap a
toHeap [] = Empty
toHeap xs = let insertAll :: Ord a => BHeap a -> [a] -> BHeap a
                insertAll h   []  = h
                insertAll h (a:as)= insertAll (insertHeap h a) as
            in insertAll Empty xs
-- dies ist eine einfache Faltungsfunktion (von links falten, Start mit leerem BHeap:
      --  = foldl insertHeap Empty xs
            
-- Spitze des Heap (kleinstes Element) entfernen, Heap-Eigenschaft muss erhalten bleiben
removeTop :: Ord a => BHeap a -> (a,BHeap a)
removeTop Empty = error "removeTop: Heap empty"
removeTop (Kn a Empty Empty) = (a,Empty)
removeTop (Kn a   lh    rh ) = error "removeTop: bitte implementieren."
-- praktisch ist hier eine Funktion, um zwei BHeaps zu vereinen...

-- neues Element in einen Heap einfügen, Heap-Eigenschaft erhalten
-- (Trick für Balance-Bedingung: immer in rechten Teilbaum einfügen, austauschen)
insertHeap :: Ord a => BHeap a -> a -> BHeap a
insertHeap   Empty a          = Kn a Empty Empty
insertHeap (Kn x left right) a = error "insertHeap: bitte implementieren."