Strict

Import "ds_heap.bmx" 'dreamora.ds_heap

Global heap:THeap   = THeap.create(,False)
Global heap2:THeap   = theap.create(,False,compareNumbers)
Local elem:Object
For Local i:Int = 1 To 20
   elem   = String(110-3*i)
   heap.add(elem)
   heap2.add(elem)
Next

Print "Heap ohne Vergleichsfunktion: "
Print "Heap Grösse: " + heap.count()

While Not heap.isEmpty()
   Print "Element: " + heap.getTop().tostring()
Wend
Print "Huh, was ist denn da los? Warum soll auf einmal 102 kleiner sein als 50?"

Print "~n~nHeap mit Vergleichsfunktion: "
Print "Heap Grösse: " + heap2.count()

While Not heap2.isEmpty()
   Print "Element: " + heap2.getTop().tostring()
Wend

Print "Ahh. Siehst du, mit einer eigenen Vergleichsfunktion kannst du den Fehler beim Grössenvergleich von Nummern beseitigen!"


Function compareNumbers:Int(one:Object, two:Object)
   Return Int(one.tostring())-Int(two.tostring())
End Function

Strict
Rem
    bbdoc: Heap
    about: Heap Klasse. Kann für PrioritätsQueues genutzt werden sowie um aus einer Menge von Objekten immer effizient das kleinste / grösste zu ziehen.
End Rem
Rem
Module dreamora.ds_heap

ModuleInfo "Version: 1.0"
ModuleInfo "Author: Marc 'Dreamora' Schaerer"
ModuleInfo "License: Public domain"
ModuleInfo "Copyright: 2006  Marc 'Dreamora' Schaerer"
ModuleInfo "Modserver: dreamora"

ModuleInfo "History:"
moduleinfo "-   1.0 Veröffentlichung"
End Rem
Import brl.retro

Rem
   bbdoc: THeap
   about: Heap Klasse
End Rem
Type THeap
   Field _data:Object[]
   Field _ascending:Int
   Field _length:Int = 1
   Field _sortingFunction:Int(one:Object,two:Object)
   
   Rem
      bbdoc: Create
      about: Erzeugt eine neues THeap Objekt und gibt eine Referenz auf dieses zurück.<br>
      <b>elements:</b> Anzahl Elemente mit welcher der Heap initialisiert werden soll.<br>
      "ird bei Bedarf effizient dynamisch vergrössert und verkleinert.<br>
      Dient primär dazu, dass der Heap bereits entsprechend gross erzeugt werden kann, wenn du in etwa weisst, wieviele Objekte gleich rein gesteckt werden.<br>
      Defaultwert ist 16.<br>
      <b>maximum:</b> Definiert ob oben auf dem Heap jeweils das grösste (true) oder das kleinste Objekt liegen soll.<br>
      Defaultwert ist Maximum also true.<br>
      <b>ComparisionFunction:int( one:Object,two:Object):</b> Lässt dich eine eigene Vergleichsfunktion definieren, die 2 Objekte vergleicht.<br>
      Die Beispielanwendung zeigt wie man das benützt und auch in welchen Dingen es besonders Sinn machen kann.<br>
      Defaultwert für die Vergleichsfunktion ist BlitzMaxs eigene Compare Methode von Objekten.
      returns: Gibt eine Referenz auf den erzeugten Heap zurück.
   End Rem
   Function Create:THeap(elements:Int = 16, maximum:Int = True, ComparisionFunction:Int( one:Object,two:Object)=compareObjects)
      Local result:THeap   = New THeap
      result._data      = New Object[elements]
      result._ascending   = maximum
      result._sortingFunction   = ComparisionFunction
      Return result
   End Function
   
   Rem
      bbdoc: Add
      about: Fügt ein neues Objekt dem Heap hinzu.<br>
      <b>obj:</b> Referenz auf das Objekt, das dem Heap hinzugefügt werden soll.
   End Rem
   Method Add(obj:Object)
      If _length = _data.length      _data   = _data[.._data.length*2]
      _data[_length] = obj
      Local ret:Int = _bubbleUp(_length)
      If ret > 0      _siftDown(ret)
      _length   :+ 1
   End Method
   
   Rem
      bbdoc: Top
      about: Gibt euch eine Referenz auf das oberste Objekt im Heap zurück, ohne es vom Heap zu entfernen.
      returns: Referenz auf das oberste Objekt im Heap.
   End Rem
   Method Top:Object()
      If isEmpty()         Throw "THeap.Top: Not supported on an empty heap!"
      Return _data[1]
   End Method
   
   Rem
      bbdoc: GetTop
      about: Gibt eine Referenz auf das oberste Objekt im Heap zurück. Dieses wird dabei vom Heap entfernt!
      returns: Referenz auf das oberste Objekt im Heap.
   End Rem
   Method GetTop:Object()
      If isEmpty()      Throw "THeap.GetTop: Not supported on an empty heap!"
      Local tmp:Object   = _data[1]
      _data[1]   = _data[_length-1]
      _length   :- 1
      _siftDown(1)
      If _data.length <= 0.35 * _length      _data   = _data[.._data.length/2]
      Return tmp
   End Method
   
   Rem
      bbdoc: Count
      about: Gibt die Anzahl Elemente im Heap zurück.
      returns: Anzahl Elemente im Heap.
   End Rem
   Method Count:Int()
      Return _length-1
   End Method
   
   Rem
      bbdoc: isEmpty
      about: Teilt euch mit, ob der Heap leer ist oder nicht.
      returns: True falls er leer ist, sonst false.
   End Rem
   Method isEmpty:Int()
      Return _length = 1
   End Method
   
   Rem
      interne Funktion
   End Rem
   Method _bubbleUp:Int(index:Int)
      Local tmp:Object      = _data[index]
      If _ascending
         While index > 1 And _sortingFunction(tmp,_data[index/2]) > 0
            _data[index]   = _data[index/2]
            index         :/ 2
         Wend
      Else
         While index > 1 And _sortingFunction(tmp,_data[index/2]) < 0
            _data[index]   = _data[index/2]
            index         :/ 2
         Wend
      EndIf
      _data[index]      = tmp
      Return index
   End Method
   
   Rem
      interne Funktion
   End Rem
   Method _siftDown(index:Int)
      Local tmp:Object         = _data[index]
      Local j:Int
      Local N:Int               = _length - 1
      If _ascending
         While index <= N/2
            j   = index+index
            If _data[j+1] And _sortingFunction(_data[j + 1],_data[j]) > 0   j :+ 1
            If _sortingFunction(tmp,_data[j]) >  0               Exit
            _data[index]      = _data[j]
            index            = j
         Wend
      Else
         While index <= N/2
            j   = index+index
            If _data[j+1] And _sortingFunction(_data[j + 1],_data[j]) < 0   j :+ 1
            If _sortingFunction(tmp,_data[j]) <  0               Exit
            _data[index]      = _data[j]
            index            = j
         Wend
      EndIf
      _data[index]         = tmp
   End Method
End Type



Function CompareObjects:Int(o1:Object, o2:Object)
   Return o1.compare(o2)
End Function

result._sortingFunction   = sortingFunction

While Abc
   If Blub("Erste Zeile Erste Zeile", ..
           "Zweite Zeile Zweite Zeile", ..
           "Dritte Zeile Dritte Zeile") Then
      DoAnything()
      DoAnything()
      DoAnything()
   EndIf
Wend

While Abc
°If Blub("Erste Zeile Erste Zeile", ..
°........"Zweite Zeile Zweite Zeile", ..
°........"Dritte Zeile Dritte Zeile") Then
°°DoAnything()
°°DoAnything()
°°DoAnything()
°EndIf
Wend