Dieser Algorithmus ist auch auf meinem Mist gewachsen, aber er ist nur entstanden, weil ich beim ersten Versuch, RlxSort zu visualisieren, durch Beschreiben eines temporären Arrays einen bestimmten Effekt erzielt hatte, den kein anderer Algorithmus zeigte.
Allerdings war die Visualisierung falsch, sie zeigte ein Verhalten, welches RlxSort an sich gar nicht hat.
So habe ich dann diesen Algorithmus entwickelt, der tatsächlich genau so vorgeht, wie es die ursprüngliche Visualisierung von RlxSort vorgegaukelt hat. Wer wissen will, was ich meine, muss sich die Visualisierung vom MinsertionSort eben mal ansehen: Es scheint so, als ob die unsortierten Werte "zusammengeschoben" werden.
Die Vorgehensweise ist recht einfach: Zunächst wird das Array komplett durchgegangen und dabei der kleinste Wert gesucht, so wie bei MinSort. Die Position dieses Wertes merkt sich das Programm. Der gefundene Wert wird dann an den Anfang des Arrays geholt, allerdings nicht durch den direkten Tausch mit dem ersten Wert (wie bei Minsort), sondern indem auch alle anderen Werte, die zwischen dem ersten und der Position des gefundenen kleinsten Wertes liegen, um eins "nach hinten" verschoben werden (wie bei InsertionSort). Der zweite Durchlauf beginnt dann mit dem zweiten Wert, der dritte mit dem dritten usw.
Es handelt sich somit um eine Kombination aus MinSort und InsertionSort, daher der Kunstname "Minsertion" (aus Minimum und Insertion). In Punkto Geschwindigkeit kann MinsertionSort jedoch seinen beiden Vorbildern nicht das Wasser reichen, weil es hier pro äußerem Schleifendurchlauf zwei innere Schleifendurchläufe gibt.
Sub MinsertionSort(aDaten())
Dim minPos As Long, x As Long, y As Long, z As Long, minWert
minPos = 0
For y = 1 To UBound(aDaten)
minPos = y
For x = y + 1 To UBound(aDaten)
If aDaten(x) < aDaten(minPos) Then
minPos = x
End If
Next
minWert = aDaten(minPos)
For z = minPos To y + 1 Step -1
aDaten(z) = aDaten(z - 1)
Next
aDaten(y) = minWert
Next
End Sub
Code eingefügt mit Syntaxhighlighter 3.0
|
