HeapSort

[remi_meier]

Kleine Implementierung von Heapsort

Code: Alles auswählen

EnableExplicit

Macro ArraySize(a)
  (PeekL(@a - 8))
EndMacro


Procedure downHeap(a.l(1), n.l, v.l)
  Protected w.l = 2 * v + 1 ; 1. Nachfolger von v
  
  While w < n
    
    If w + 1 < n
      ; es existiert ein 2. Nachfolger
      If a(w + 1) > a(w)
        w + 1
      EndIf
    EndIf
    ; w ist der grösste Nachfolger
    
    If a(v) >= a(w)
      ; v hat Heap-Eigenschaft (v ist am grössten des Triples)
      ProcedureReturn 0
    EndIf
    ; v ist nicht am grössten ->
    ; wechsle Position von v und grösstem Nachfolger
    Swap a(v), a(w)
    
    ; korrigiere auch die weiteren Nachfolger
    v = w
    w = 2 * v + 1
  Wend
  
EndProcedure


Procedure buildHeap(a.l(1), n.l)
  Protected v.l
  
  For v = n / 2 - 1 To 0 Step -1
    downHeap(a(), n, v)
  Next
EndProcedure


Procedure heapSort(a.l(1), n.l)
  buildHeap(a(), n)
  
  While n > 1
    n - 1
    Swap a(0), a(n)
    downHeap(a(), n, 0)
  Wend
EndProcedure


Procedure sort(a0.l(1))
  Protected n.l = ArraySize(a0())
  
  heapSort(a0(), n)
EndProcedure




;- Test
#N = 50
Dim a.l(#N)
Define z.l

For z = 0 To #N
  a(z) = Random(100)
Next

sort(a())

For z = 0 To #N
  Debug a(z)
  If z > 0 And a(z) < a(z-1)
    Debug "Fehler"
  EndIf
Next

Die beste Erklärung die ich auf die Schnelle fand, war
http://www.inf.fh-flensburg.de/lang/alg ... p/heap.htm

Viel Spass!

[remi_meier]

Und das etwas schnellere BottomUp-Heapsort:

Code: Alles auswählen

EnableExplicit

Macro ArraySize(a)
  (PeekL(@a - 8))
EndMacro


Procedure upHeap(a.l(1), n.l, v.l, x.l)
  Protected u.l
  
  a(v) = x
  While v > 0
    u = (v - 1) / 2   ; Vorgänger
    If a(u) >= a(v)
      ; Heap-Eigenschaft erfüllt
      ProcedureReturn 0
    EndIf
    Swap a(u), a(v)
    v = u
  Wend
EndProcedure


Procedure.l holeDownHeap(a.l(1), n.l)
  Protected v.l = 0, w.l = 2 * v + 1
  
  While w + 1 < n
    ; 2. Nachfolger existiert
    If a(w + 1) > a(w)
      w + 1
    EndIf
    ; w ist höchster Nachfolger
    a(v) = a(w)
    v = w
    w = 2 * v + 1
  Wend
  
  If w < n
    ; einzelnes Blatt
    a(v) = a(w)
    v    = w
  EndIf
  ; das Loch hat das Blatt erreicht
  ProcedureReturn v
EndProcedure


Procedure downHeap(a.l(1), n.l, v.l)
  Protected w.l = 2 * v + 1 ; 1. Nachfolger von v
  
  While w < n
    
    If w + 1 < n
      ; es existiert ein 2. Nachfolger
      If a(w + 1) > a(w)
        w + 1
      EndIf
    EndIf
    ; w ist der grösste Nachfolger
    
    If a(v) >= a(w)
      ; v hat Heap-Eigenschaft (v ist am grössten des Triples)
      ProcedureReturn 0
    EndIf
    ; v ist nicht am grössten ->
    ; wechsle Position von v und grösstem Nachfolger
    Swap a(v), a(w)
    
    ; korrigiere auch die weiteren Nachfolger
    v = w
    w = 2 * v + 1
  Wend
  
EndProcedure


Procedure buildHeap(a.l(1), n.l)
  Protected v.l
  
  For v = n / 2 - 1 To 0 Step -1
    downHeap(a(), n, v)
  Next
EndProcedure


Procedure buHeapSort(a.l(1), n.l)
  Protected x.l, u.l
  
  buildHeap(a(), n)
  
  While n > 1
    n - 1
    
    x = a(n)  ; letztes Blatt
    a(n) = a(0)
    u = holeDownHeap(a(), n)
    upHeap(a(), n, u, x)
  Wend
EndProcedure


Procedure sort(a0.l(1))
  Protected n.l = ArraySize(a0())
  
  buHeapSort(a0(), n)
EndProcedure




;- Test
#N = 50
Dim a.l(#N)
Define z.l

For z = 0 To #N
  a(z) = Random(100)
Next

sort(a())

For z = 0 To #N
  Debug a(z)
  If z > 0 And a(z) < a(z-1)
    Debug "Fehler"
  EndIf
Next

[remi_meier]

Die Suche eines Wertes in einem Heap (könnte ev. optimiert werden):

Code: Alles auswählen

EnableExplicit

Macro ArraySize(a)
  (PeekL(@a - 8))
EndMacro


Procedure downHeap(a.l(1), n.l, v.l)
  Protected w.l = 2 * v + 1 ; 1. Nachfolger von v
  
  While w < n
    
    If w + 1 < n
      ; es existiert ein 2. Nachfolger
      If a(w + 1) > a(w)
        w + 1
      EndIf
    EndIf
    ; w ist der grösste Nachfolger
    
    If a(v) >= a(w)
      ; v hat Heap-Eigenschaft (v ist am grössten des Triples)
      ProcedureReturn 0
    EndIf
    ; v ist nicht am grössten ->
    ; wechsle Position von v und grösstem Nachfolger
    Swap a(v), a(w)
    
    ; korrigiere auch die weiteren Nachfolger
    v = w
    w = 2 * v + 1
  Wend
  
EndProcedure


Procedure buildHeap(a.l(1), n.l)
  Protected v.l
  
  For v = n / 2 - 1 To 0 Step -1
    downHeap(a(), n, v)
  Next
EndProcedure


Procedure transformToHeap(a.l(1))
  buildHeap(a(), ArraySize(a()))
EndProcedure


; Heap-Functions
#NotFound = -1
Procedure.l getIndex(heap.l(1), id.l, v.l = 0)
  ; v = Startelement
  Protected d1.l, d2.l  ; erster und zweiter Nachfolger
  Protected n.l = ArraySize(heap())
  Protected temp.l
  Protected index.l = #NotFound
  
  
  While v < n
    If heap(v) = id
      index = v
      Break
    EndIf
    ; es ist nicht v
    
    d1 = 2 * v + 1
    d2 = d1 + 1
    If d1 < n
      ; Nachfolger 1 exisitiert
      
      If id < heap(d1)
        ; Nachfolger 1 ist grösser als id
        temp = getIndex(heap(), id, d1)
        If temp <> #NotFound
          index = temp
          Break
        EndIf
        
      ElseIf id = heap(d1)
        index = d1
        Break
      EndIf
      
      If d2 < n
        ; Nachfolger 2 existiert
        If id < heap(d2)
          ; Nachfolger 2 ist grösser als id
          temp = getIndex(heap(), id, d2)
          If temp <> #NotFound
            index = temp
            Break
          EndIf
          
        ElseIf id = heap(d2)
          index = d2
          Break
        EndIf
      EndIf
      
      ; Nichts gefunden in keinem Ast...
      Break
    Else
      Break
    EndIf
    
  Wend
  
  ProcedureReturn index
EndProcedure


;/ TESTE NOCH FÜR 3 oder weniger ELEMENTE!
Define.l z
Dim a.l(5)

a(0) = 500
a(1) = 6000
a(2) = 100
a(3) = 2000
a(4) = 1000
a(5) = 700

transformToHeap(a())

Debug "Array als Heap:"
For z = 0 To 5
  Debug "Index " + Str(z) + ": " + Str(a(z))
Next

Debug "Element 500: " + Str(getIndex(a(), 500))
Debug "Element 6000: " + Str(getIndex(a(), 6000))
Debug "Element 100: " + Str(getIndex(a(), 100))
Debug "Element 2000: " + Str(getIndex(a(), 2000))
Debug "Element 1000: " + Str(getIndex(a(), 1000))
Debug "Element 700: " + Str(getIndex(a(), 700))

[remi_meier]

Und noch das schnelle Anfügen eines Elementes zum Heap:

Code: Alles auswählen

EnableExplicit

Macro ArraySize(a)
  (PeekL(@a - 8))
EndMacro


Procedure downHeap(a.l(1), n.l, v.l)
  Protected w.l = 2 * v + 1 ; 1. Nachfolger von v
  
  While w < n
    
    If w + 1 < n
      ; es existiert ein 2. Nachfolger
      If a(w + 1) > a(w)
        w + 1
      EndIf
    EndIf
    ; w ist der grösste Nachfolger
    
    If a(v) >= a(w)
      ; v hat Heap-Eigenschaft (v ist am grössten des Triples)
      ProcedureReturn 0
    EndIf
    ; v ist nicht am grössten ->
    ; wechsle Position von v und grösstem Nachfolger
    Swap a(v), a(w)
    
    ; korrigiere auch die weiteren Nachfolger
    v = w
    w = 2 * v + 1
  Wend
  
EndProcedure


Procedure buildHeap(a.l(1), n.l)
  Protected v.l
  
  For v = n / 2 - 1 To 0 Step -1
    downHeap(a(), n, v)
  Next
EndProcedure


Procedure transformToHeap(a.l(1))
  buildHeap(a(), ArraySize(a()))
EndProcedure


; Heap-Functions
#NotFound = -1
Procedure.l getIndex(heap.l(1), id.l, v.l = 0)
  ; v = Startelement
  Protected d1.l, d2.l  ; erster und zweiter Nachfolger
  Protected n.l = ArraySize(heap())
  Protected temp.l
  Protected index.l = #NotFound
  
  
  While v < n
    If heap(v) = id
      index = v
      Break
    EndIf
    ; es ist nicht v
    
    d1 = 2 * v + 1
    d2 = d1 + 1
    If d1 < n
      ; Nachfolger 1 exisitiert
      
      If id < heap(d1)
        ; Nachfolger 1 ist grösser als id
        temp = getIndex(heap(), id, d1)
        If temp <> #NotFound
          index = temp
          Break
        EndIf
        
      ElseIf id = heap(d1)
        index = d1
        Break
      EndIf
      
      If d2 < n
        ; Nachfolger 2 existiert
        If id < heap(d2)
          ; Nachfolger 2 ist grösser als id
          temp = getIndex(heap(), id, d2)
          If temp <> #NotFound
            index = temp
            Break
          EndIf
          
        ElseIf id = heap(d2)
          index = d2
          Break
        EndIf
      EndIf
      
      ; Nichts gefunden in keinem Ast...
      Break
    Else
      Break
    EndIf
    
  Wend
  
  ProcedureReturn index
EndProcedure

Procedure addID(heap.l(1), id.l)
  Protected n.l = ArraySize(heap())
  Protected u.l, v.l
  
  Redim heap.l(n)  ; ein Element anfügen
  heap(n) = id
  n + 1
  v = n - 1
  
  ; heap(n - 1) = id
  ; v = n - 1
  
  While v > 0
    u = (v - 1) / 2   ; Vorgänger
    
    If heap(u) >= heap(v)
      ; Heap-Eigenschaft erfüllt
      ProcedureReturn 0
    EndIf
    
    Swap heap(u), heap(v)
    v = u
  Wend
EndProcedure




Define.l z
Dim a.l(5)

a(0) = 500
a(1) = 6000
a(2) = 100
a(3) = 2000
a(4) = 1000
a(5) = 700

transformToHeap(a())

Debug "Array als Heap:"
For z = 0 To ArraySize(a()) - 1
  Debug "Index " + Str(z) + ": " + Str(a(z))
Next
Debug "Suche einzelne Elemente:"
Debug "Element 500: " + Str(getIndex(a(), 500))
Debug "Element 6000: " + Str(getIndex(a(), 6000))
Debug "Element 100: " + Str(getIndex(a(), 100))
Debug "Element 2000: " + Str(getIndex(a(), 2000))
Debug "Element 1000: " + Str(getIndex(a(), 1000))
Debug "Element 700: " + Str(getIndex(a(), 700))



Debug "Das Element 2500 hinzufügen"
addID(a(), 2500)
Debug "Neuer Heap:"
For z = 0 To ArraySize(a()) - 1
  Debug "Index " + Str(z) + ": " + Str(a(z))
Next
Debug "Suche einzelne Elemente:"
Debug "Element 2500: " + Str(getIndex(a(), 2500))
Debug "Element 500: " + Str(getIndex(a(), 500))
Debug "Element 6000: " + Str(getIndex(a(), 6000))
Debug "Element 100: " + Str(getIndex(a(), 100))
Debug "Element 2000: " + Str(getIndex(a(), 2000))
Debug "Element 1000: " + Str(getIndex(a(), 1000))
Debug "Element 700: " + Str(getIndex(a(), 700))

Jetzt sollte man mal probieren Heaps und Hashes zu kombinieren

[remi_meier]

Für dynamisches Einfügen von Elementen in einen Max-Heap wäre man
mit einem ternären oder gar noch höher dimensionalen Heap noch x-mal
schneller, wobei dann aber das Suchen in dem Heap wieder y-mal langsamer
würde . Wäre auch ein genialer Speedtest, wenn jemand Lust
dazu verspührt.


Werd nun, obwohl es sauber erklärt bei obigem Link nachlesbar ist, eine
kleine Zusammenfassung zu diesen Heaps liefern.

Wenn ich Heap sage, meine ich hier meist einen binären Heap. Ein Heap
ist eigentlich einfach ein offener binärer Baum, deshalb kann man auch
ganz einfach zu Nachfolgerknoten oder Vorgängerknoten springen (2*v+1
bzw. (v-1)/2). Ein Max-Heap hat die Eigenschaft (die so genannte Heap-
Eigenschaft), dass der Mutterknoten immer grösser ist als die beiden
Kinderknoten. Also steht in der Wurzel der grösste Wert des gesamten
Arrays. Wenn man ein neues Element anfügen möchte, setzt man es
einfach an die letzte Stelle, also als letztes Blatt des Baums. Nun kann
man, anstatt vollständig neu zu sortieren, einfach entlang des Astes zur
Wurzel "hoch"klettern bis die Heap-Bedingung stimmt. Das erfordert
natürlich bedeutend viel weniger Aufwand als ein gesamtes Neusortieren
des Arrays.
Suchen eines Elementes gestaltet sich auch recht einfach. Man beginnt
bei der Wurzel und klettert, solange die Heap-Bedingung nicht erfüllt ist,
den Baum "runter" zu den Blättern oder stoppt gleich, falls man das
Element gefunden hat bzw. die Kinderknoten beide grösser sind als unser
lieber gesuchter Wert. Nicht ganz so effizient wie mit binären Indizes,
aber dennoch extrem viel schneller als jedes Element durchzugehen.

Dieser Heap ist also ein Zwischending zwischen einem sortierten Array
mit binärer Indizierung, aber langsamem Einfügen neuer Elemente und
einem normalen Array... Wobei etwa 80% Ähnlichkeit auf der Seite
des vorsortierten Arrays ist und nicht beim unsortierten Array (bei welchem
man aber einfacher Elemente anfügen könnte ).


Also nochmals: Wer kombiniert Heaps mit einer Hash-Tabelle? Wäre wirklich
gerade das Schnellste, was mir einfällt um _dynamisch_ Strings in einer
Tabelle zu suchen und einzufügen.

[NicTheQuick]

Wenn ich das mit dem Heapzeugs mal komplett kapiert hab, dann schau ich
mal wegen dem Hash. Aber falls du eh zuviel Zeit hast, kannst du das ja auch
selbst machen.

[dussel]

@remi_meier: Feine Funktion. Danke, für den Code!

[remi_meier]

@dussel:
Danke!

@NicTheQuick:
Das war nur ein kleiner Anfall von mir, eigentlich habe ich gar keine Zeit .
Aber als ich mit einem Kollegen sprach, kam noch die Idee auf, dass ein
normal sortiertes Array eigentlich auch ein Heap ist (ich nenn das mal
sortierter Max-Heap). In einem sortierten Array kann man bekanntlich
binär rumspringen um einen Eintrag zu finden -> noch schneller. Es ist
nur nicht klar, ob man das Einfügen eines neuen Elementes immer noch
ähnlich oder gleich performant machen kann, wenn man dieses Array als
Heap betrachtet. Dabei muss natürlich wieder ein sortierter Max-Heap
entstehen, damit wieder schnell Einträge gefunden werden können. Jedes
mal den Heap zu sortieren ist natürlich zu langsam.

Naja, viel Spass noch