Da ich in meinem aktuellen Projekt gerade einen Sortieralgorithmus brauchte, der mir eine Liste von Tausenden Type-Objekten sortiert habe ich heute Morgen mal eine Quicksort Funktion geschrieben, um diese Funktion zu erfüllen.
Wie sicher einige wissen hat Rallimen vor 6 Jahren schon ein kleines Tool zu eben diesem Zweck hier im Codearchiv hochgeladen(welches auch immernoch zum Download zur Verfügung steht), seine Funktion ist allerdings im Verhältnis zu meiner sehr kompliziert und zumindest in meinen Tests auch deutlich langsamer, weshalb ich das hier mit euch teilen wollte.
Quicksort ist ursprünglich zwar für Arrays bedacht gewesen, da ich aber für fast alles ausschließlich verlinkte Listen benutzte hab ich ein paar kleine Tricks benutzt und somit funktioniert das ganze nun auch ohne weiteres mit Types.
Weiterhin hab ich darauf geachtet, die Funktion möglichst kurz und besonders die Schleife so einfach wie möglich zu halten, um das ganze möglichst schnell zu machen.
Wie die meisten Quicksort-Algorithmen hat meiner allerdings auch einige Schwächen.
Versucht man mit ihm eine (beinahe) sortierte Liste zu sortieren, wird aus der durchschnittlichen Laufzeit von O(n * log n) ein O(n^2), was für die die sich damit nicht auskennen bedeutet: es braucht sehr lange.
Bei sehr zufälligen Listen hingegen erreicht Quicksort seine Spitzenlaufzeit und sortiert tausende Objekte in Millisekunden.
Weiterhin machen es die verlinkten Listen praktisch unmöglich Randomized Quicksort zu gebrauchen, was unter gewissen Umständen die Durchschnitt-Laufzeit auch noch deutlich verlängern kann.
Aber genug gelabert, hier gibt es erst mal den allgemeinen Code:
BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN] Function QuickSort<TypeName>() QuickSort<TypeName>Step(First <TypeName>, Last <TypeName>) End Function
Function QuickSort<TypeName>Step(fromT.<TypeName>, toT.<TypeName>) If fromT = Null Or toT = Null Or fromT = toT Return End If Local upperBound.<TypeName> = After toT Local lowerBound.<TypeName> = Before fromT Local pivot.<TypeName> = toT Local temp.<TypeName> Local t.<TypeName> = fromT Repeat temp = After t If t\<FieldName> > pivot\<FieldName> Insert t After pivot End If t = temp Until t = pivot If upperBound = Null upperBound = Last <TypeName> Else upperBound = Before upperBound EndIf If lowerBound = Null lowerBound = First <TypeName> Else lowerBound = After lowerBound EndIf If upperBound <> pivot QuickSort<TypeName>Step(After pivot, upperBound) End If If lowerBound <> pivot QuickSort<TypeName>Step(lowerBound, Before pivot) End If End Function
Um die Funktion zu benutzten, einfach den Code kopieren und alle <TypeName> mit dem Namen eures Types sowie die beiden <FieldName> mit dem Namen des Fields nach dessen Wert sortiert werden soll ersetzten.
In diesem Zustand sortiert die Funktion aufsteigend, wenn ihr absteigend lieber habt, könnt ihr einfach das ">" mit einem "<" ersetzten.
Um zu zeigen, dass der Code auch tatsächlich schnell ist, hier noch ein kleiner Test (mein Rechner sortiert die 10000 Objecte mit diesem Code in 15 Millisekunden):
BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN] *snip* (s. unten)
NEU - Mergesort - Noch schneller sortieren!
Da ich ganz offensichtlich nichts besseres zu tun habe, hab ich aus Interesse auch noch Mergesort für verlinkte Listen geschrieben.
Die Funktionen sind deutlich komplizierter und ich benutzte einen Hilfs-Type und doch musste ich überrascht feststellen, dass Mergesort Quicksort in allen meinen Tests deutlich überholt. Der Test der vorher oben zu finden war braucht zum Beispiel mit MergeSort nur 12 statt 15 Millisekunden und in dem Programm wofür ich beide Algorithmen geschrieben habe reduziert er die Sortierzeit sogar von 280ms auf 140ms.
Grund hierfür ist, dass mein Mergesort relativ schlau ist und schon sortierte Teile der Liste erkennt und davon profitiert. Was natürlich auch dafür sorgt, dass wenn die Liste schon sortiert ist die Funktion tatsächlich nur einmal durchläuft und die Liste lässt wie sie ist, anstatt wie Quicksort alles umzuwerfen und neu zu sortieren(was in meinem Test zu einer Sortierzeit von drei Sekunden führte).
Nundenn, auf alle Fälle hier der Code, selbe Sache wie oben, einfach <TypeName> und <FieldName> ersetzten.
Nur Vorsicht, wenn ihr die Sortierreihenfolge ändern wollt müsst ihr die Größer/Kleiner-Zeichen in "MergeSort<TypeName>Merge" UND "GetEndOfSorted<TypeName>Sublist" austauschen.
BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN] Type TMerge<TypeName>Stp Field t.<TypeName> End Type
Function MergeSort<TypeName>s() Local sortedUpTo.<TypeName> = First <TypeName> Local stp.TMerge<TypeName>stp, stp2.TMerge<TypeName>stp While sortedUpTo <> Null sortedUpTo = GetEndOfSorted<TypeName>Sublist(sortedUpTo) stp = New TMerge<TypeName>stp stp\t = sortedUpTo sortedUpTo = After sortedUpTo Wend stp = First TMerge<TypeName>Stp While stp <> Last TMerge<TypeName>stp While stp <> Null stp2 = After stp If stp2 = Null stp2 = Last TMerge<TypeName>stp stp = Before stp2 End If MergeSort<TypeName>Merge(stp, stp2) stp = After stp2 Wend stp = First TMerge<TypeName>stp Wend Delete Each TMerge<TypeName>stp End Function
Function MergeSort<TypeName>Merge(stp1.TMerge<TypeName>Stp, stp2.TMerge<TypeName>Stp) Local nextToSort.<TypeName> = After stp1\t Local stp0.TMerge<TypeName>Stp = Before stp1 Local pivot1.<TypeName> If stp0 = Null pivot1 = First <TypeName> Else pivot1 = After stp0\t End If Local pivot2.<TypeName> = After stp1\t Local temp.<TypeName> Repeat If pivot2\<FieldName> < pivot1\<FieldName> temp = After pivot2 Insert pivot2 Before pivot1 If pivot2 = stp2\t stp2\t = stp1\t Exit End If pivot2 = temp Else If pivot1 = stp1\t Exit EndIf pivot1 = After pivot1 End If Forever Delete stp1 End Function
Function GetEndOfSorted<TypeName>Sublist.<TypeName>(t.<TypeName>) Local test.<TypeName> = After t While test <> Null If test\<FieldName> < t\<FieldName> Exit End If t = test test = After test Wend Return t End Function
So, und ganz zum Schluss noch ein neuer Test, der beide Sortieralgorithmen vergleicht.
BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN] Const COUNT = 10000
Type TestType Field value End Type
Local i, ms, t.TestType
SeedRnd(0) For i = 1 To COUNT t = New TestType t\value = Rand(-1000, 1000) Next
ms = MilliSecs()
QuickSortTestType()
ms = MilliSecs() - ms
Print("Quicksort needed " + ms + "ms to sort " + COUNT + " objects.")
Delete Each TestType
SeedRnd(0) For i = 1 To COUNT t = New TestType t\value = Rand(-1000, 1000) Next
ms = MilliSecs()
MergeSortTestTypes()
ms = MilliSecs() - ms
Print("Mergesort needed " + ms + "ms to sort " + COUNT + " objects.")
Input()
Function QuickSortTestType() QuickSortTestTypeStep(First TestType, Last TestType) End Function
Function QuickSortTestTypeStep(fromT.TestType, toT.TestType) If fromT = Null Or toT = Null Or fromT = toT Return End If Local upperBound.TestType = After toT Local lowerBound.TestType = Before fromT Local pivot.TestType = toT Local temp.TestType Local t.TestType = fromT Repeat temp = After t If t\value > pivot\value Insert t After pivot End If t = temp Until t = pivot If upperBound = Null upperBound = Last TestType Else upperBound = Before upperBound EndIf If lowerBound = Null lowerBound = First TestType Else lowerBound = After lowerBound EndIf If upperBound <> pivot QuickSortTestTypeStep(After pivot, upperBound) End If If lowerBound <> pivot QuickSortTestTypeStep(lowerBound, Before pivot) End If End Function
Type TMergeTestTypeStp Field t.TestType End Type
Function MergeSortTestTypes() Local sortedUpTo.TestType = First TestType Local stp.TMergeTestTypeStp, stp2.TMergeTestTypeStp While sortedUpTo <> Null sortedUpTo = GetEndOfSortedTestTypeSublist(sortedUpTo) stp = New TMergeTestTypeStp stp\t = sortedUpTo sortedUpTo = After sortedUpTo Wend stp = First TMergeTestTypeStp While stp <> Last TMergeTestTypeStp While stp <> Null stp2 = After stp If stp2 = Null stp2 = Last TMergeTestTypeStp stp = Before stp2 End If MergeSortTestTypeMerge(stp, stp2) stp = After stp2 Wend stp = First TMergeTestTypeStp Wend Delete Each TMergeTestTypeStp End Function
Function MergeSortTestTypeMerge(stp1.TMergeTestTypeStp, stp2.TMergeTestTypeStp) Local nextToSort.TestType = After stp1\t Local stp0.TMergeTestTypeStp = Before stp1 Local pivot1.TestType If stp0 = Null pivot1 = First TestType Else pivot1 = After stp0\t End If Local pivot2.TestType = After stp1\t Local temp.TestType Repeat If pivot2\value < pivot1\value temp = After pivot2 Insert pivot2 Before pivot1 If pivot2 = stp2\t stp2\t = stp1\t Exit End If pivot2 = temp Else If pivot1 = stp1\t Exit EndIf pivot1 = After pivot1 End If Forever Delete stp1 End Function
Function GetEndOfSortedTestTypeSublist.TestType(t.TestType) Local test.TestType = After t While test <> Null If test\value < t\value Exit End If t = test test = After test Wend Return t End Function
|