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
|
BlitzBasic 
Do, Mai 12, 2011 18:33