title image


Smiley RlxSort - Mehr Aufwand, aber weniger Zeit


Ich habe dieser Methode meinen Nicknamen gegeben, da ich sie selbst erfunden habe.

Sie arbeitet mit zwei temporären Arrays:

- In aSortiert() werden nach und nach die Elemente ihrer Größe nach geordnet hinterlegt.

- In aGeprueft() wird vermerkt, ob ein bestimmtes Element aus aDaten() bereits in aSortiert eingetragen ist.



Die äußere Schleife ist hier nicht nur bloßer Zähler, sie ist gleichzeitig der Index des Arrays aSortiert(), d.h. nach jedem Durchlauf der inneren Schleife wird genau an der Position, wo der äußere Zähler gerade steht, der gefundene kleinste Wert eingetragen.



In der inneren Schleife wird das Array jeweils komplett durchlaufen und stets der kleinste Wert gesucht. Hier wird nichts ausgetauscht, bis die Schleife restlos durchlaufen ist! Es wird lediglich die Position des kleinsten Elementes vermerkt und ggf. verändert, wenn ein noch kleineres Element gefunden wird.



Erst wenn die innere Schleife komplett durchlaufen ist, passiert folgendes:

- der gefundene kleinste Wert wird in aSortiert() eingetragen

- die Position des gefundenen kleinsten Werts wird in aGeprueft() vermerkt



Jeder innere Schleifendurchlauf muss hier stets bei 1 beginnen und bis zum Ende durchlaufen, da sich überall im Array noch ungeprüfte Elemente befinden können. Die geprüften werden jedoch durch den Vergleich If aGeprueft(x) = False schnell übersprungen.



Da die sortierten Daten am Ende nicht im Array aDaten() sondern in aSortiert() stehen, ist noch ein "Umschreiben" in aDaten() erforderlich, da alle Beispielsubs nunmal ein sortietes aDaten()-Array zurückgeben sollen.



Obwohl es mehr Durchläufe sind als bei BubbleSort oder NoNetSort und trotz des notwendigen "Umschreibens" ist RlxSort geringfügig schneller als die vorgenannten.







      

Sub RlxSort(aDaten)

    'rlx

    Dim aGeprueft() As Boolean, aSortiert() As Variant

    Dim x As Long, y As Long, minPos As Long

    ReDim aGeprueft(UBound(aDaten))

    ReDim aSortiert(1 To UBound(aDaten))

    minPos = 0

    For y = 1 To UBound(aSortiert)

        For x = 1 To UBound(aDaten)

            If aGeprueft(x) = False Then

                If minPos = 0 Then minPos = x

                If aDaten(x) < aDaten(minPos) Then

                    minPos = x

                End If

            End If

        Next

        aGeprueft(minPos) = True

        aSortiert(y) = aDaten(minPos)

        minPos = 0

    Next

    For y = 1 To UBound(aDaten)

        aDaten(y) = aSortiert(y)

    Next

End Sub 





Code eingefügt mit Syntaxhighlighter 3.0




mfg

Ralf

Der Computer löst Probleme, 
die es ohne ihn nicht gäbe!



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: