The examples posted use variant arrays, which are less efficient than typed arrays, and they only work on single-dimension arrays.
Some basic terminology:
Stable
A stable sorting algorithm is one that maintains relative order for duplicate keys. (This is only relevant for two-dimensional arrays.) As a conceptual example, let's say you were sorting the 365 days of the year by day-of month. In a stable algorithm, the first 12 elements in order will be: January 1, February 1, March 1, April 1, etc... An unstable algorithm will produce unpredictable results for identical keys, so the first twelve elements in order might be: October 1, March 1, June 1, etc...
In-Place
In a nutshell, "in-place" algorithms are those that don't need "extra" memory for their sorting operations. This gets complicated when categorizing recursive algorithms, so for the purposes of this thread, an in-place algorithm is defined as one that sorts the array directly by swapping around the elements. Conversely, an out-of-place algorithm will make a sorted copy of the original array, thus requiring double the memory. Out-of-place algorithms are useful for creating indexes, though that functionality is not implemented here. (It is much more efficient to sort two-dimensional arrays out-of-place, due to the expensive nature of swapping elements.)
Online
An online algorithm is one that can sort an array even if it only gets pieces of the array at a time. (ie: Receiving packets over the internet.)
Recursive
Recursive algorithms call themselves during normal operation. As a general rule, recursive functions are both efficient and complex.
Grade
The grade is an arbitrary letter grade that I personally awarded to each implementation.
It is worth pointing out that Jump Sort was created by our very own Code Doc. Also, thanks to Doogle for debugging smooth sort, and Merri for providing both Shaker sort and Shear sort.
For those just looking for basic code, here's quicksort, binary search, and the Knuth shuffle:
Code:
Option Explicit
Option Compare Text
' Omit plngLeft & plngRight; they are used internally during recursion
Public Sub QuickSort(ByRef pvarArray As Variant, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
Dim lngFirst As Long
Dim lngLast As Long
Dim varMid As Variant
Dim varSwap As Variant
If plngRight = 0 Then
plngLeft = LBound(pvarArray)
plngRight = UBound(pvarArray)
End If
lngFirst = plngLeft
lngLast = plngRight
varMid = pvarArray((plngLeft + plngRight) \ 2)
Do
Do While pvarArray(lngFirst) < varMid And lngFirst < plngRight
lngFirst = lngFirst + 1
Loop
Do While varMid < pvarArray(lngLast) And lngLast > plngLeft
lngLast = lngLast - 1
Loop
If lngFirst <= lngLast Then
varSwap = pvarArray(lngFirst)
pvarArray(lngFirst) = pvarArray(lngLast)
pvarArray(lngLast) = varSwap
lngFirst = lngFirst + 1
lngLast = lngLast - 1
End If
Loop Until lngFirst > lngLast
If plngLeft < lngLast Then QuickSort pvarArray, plngLeft, lngLast
If lngFirst < plngRight Then QuickSort pvarArray, lngFirst, plngRight
End Sub
' Simple binary search. Be sure array is sorted first.
' Returns index of first match, or -1 if no match found
Public Function BinarySearch(pvarArray As Variant, pvarFind As Variant) As Long
Dim lngFirst As Long
Dim lngMid As Long
Dim lngLast As Long
BinarySearch = -1
lngMid = -1
lngFirst = LBound(pvarArray)
lngLast = UBound(pvarArray)
Do While lngFirst <= lngLast
lngMid = (lngFirst + lngLast) \ 2
If pvarArray(lngMid) > pvarFind Then
lngLast = lngMid - 1
ElseIf pvarArray(lngMid) < pvarFind Then
lngFirst = lngMid + 1
Else
Exit Do
End If
Loop
' Make sure this is the first match in array
Do While lngMid > lngFirst
If pvarArray(lngMid - 1) <> pvarFind Then Exit Do
lngMid = lngMid - 1
Loop
' Set return value if match was found
If pvarArray(lngMid) = pvarFind Then BinarySearch = lngMid
End Function
' Knuth shuffle (very fast)
Public Function ShuffleArray(pvarArray As Variant)
Dim i As Long
Dim iMin As Long
Dim iMax As Long
Dim lngReplace As Long
Dim varSwap As Variant
iMin = LBound(pvarArray)
iMax = UBound(pvarArray)
For i = iMax To iMin + 1 Step -1
lngReplace = Int((i - iMin + 1) * Rnd + iMin)
varSwap = pvarArray(i)
pvarArray(i) = pvarArray(lngReplace)
pvarArray(lngReplace) = varSwap
Next
End Function
Attached is the current state of the sorting program. It is still a work in progress; it currently only does the graphical representation of the algorithms. Double-click an algorithm to see detailed information on it.
Last edited by Ellis Dee; May 26th, 2008 at 04:02 PM.
Once an array is sorted, searching for a given value can be done very quickly using a binary search. The idea is to split the sorted list in half by recursively comparing against the middle element, and subsequently dividing the list in half. Which half you keep searching is determined by whether the search term is higher or lower than the middle element.
vb Code:
' Simple binary search. Be sure array is sorted first.
' Returns index of first match, or -1 if no match found
Public Function BinarySearch1(pvarArray As Variant, pvarFind As Variant) As Long
Dim lngFirst As Long
Dim lngMid As Long
Dim lngLast As Long
BinarySearch1 = -1
lngMid = -1
lngFirst = LBound(pvarArray)
lngLast = UBound(pvarArray)
Do While lngFirst <= lngLast
lngMid = (lngFirst + lngLast) \ 2
If pvarArray(lngMid) > pvarFind Then
lngLast = lngMid - 1
ElseIf pvarArray(lngMid) < pvarFind Then
lngFirst = lngMid + 1
Else
Exit Do
End If
Loop
' Make sure this is the first match in array
Do While lngMid > lngFirst
If pvarArray(lngMid - 1) <> pvarFind Then Exit Do
lngMid = lngMid - 1
Loop
' Set return value if match was found
If pvarArray(lngMid) = pvarFind Then BinarySearch1 = lngMid
End Function
Another common issue is shuffling an array. The Knuth shuffle involves moving through the array, swapping each element in turn with another element from a random position that has not yet been passed through (including itself).
vb Code:
' Knuth shuffle (very fast)
Public Function ShuffleArray1(pvarArray As Variant)
Dim i As Long
Dim iMin As Long
Dim iMax As Long
Dim lngReplace As Long
Dim varSwap As Variant
iMin = LBound(pvarArray)
iMax = UBound(pvarArray)
For i = iMax To iMin + 1 Step -1
lngReplace = Int((i - iMin + 1) * Rnd + iMin)
varSwap = pvarArray(i)
pvarArray(i) = pvarArray(lngReplace)
pvarArray(lngReplace) = varSwap
Next
End Function
Last edited by Ellis Dee; May 20th, 2008 at 10:44 AM.
Stable: Yes
In-Place: Yes
Online: No
Recursive: No
Grade: D-
Bubble sort is a simple sorting algorithm. It works by repeatedly stepping through the list to be sorted, comparing two items at a time and swapping them if they are in the wrong order. The pass through the list is repeated until no swaps are needed, which means the list is sorted.
The algorithm gets its name from the way smaller elements "bubble" to the top (i.e. the beginning) of the list via the swaps. One way to optimize bubblesort (implemented here) is to note that, after each pass, the largest element will always move down to the bottom. Thus it suffices to sort the remaining n - 1 elements each subsequent pass.
Although simple, this algorithm is highly inefficient and is rarely used except in education.
vb Code:
Public Sub BubbleSort1(ByRef pvarArray As Variant)
Dim i As Long
Dim iMin As Long
Dim iMax As Long
Dim varSwap As Variant
Dim blnSwapped As Boolean
iMin = LBound(pvarArray)
iMax = UBound(pvarArray) - 1
Do
blnSwapped = False
For i = iMin To iMax
If pvarArray(i) > pvarArray(i + 1) Then
varSwap = pvarArray(i)
pvarArray(i) = pvarArray(i + 1)
pvarArray(i + 1) = varSwap
blnSwapped = True
End If
Next
iMax = iMax - 1
Loop Until Not blnSwapped
End Sub
Last edited by Ellis Dee; May 20th, 2008 at 11:10 AM.
Stable: Yes
In-Place: Yes
Online: No
Recursive: No
Grade: D-
Cocktail sort is a variation of bubble sort that sorts in both directions each pass through the list.
One optimization (implemented here) is to add an if-statement that checks whether there has been a swap after the first pass each iteration. If there hasn't been a swap the list is sorted and the algorithm can stop.
vb Code:
Public Sub CocktailSort1(ByRef pvarArray As Variant)
Dim i As Long
Dim iMin As Long
Dim iMax As Long
Dim varSwap As Variant
Dim blnSwapped As Boolean
iMin = LBound(pvarArray)
iMax = UBound(pvarArray) - 1
Do
blnSwapped = False
For i = iMin To iMax
If pvarArray(i) > pvarArray(i + 1) Then
varSwap = pvarArray(i)
pvarArray(i) = pvarArray(i + 1)
pvarArray(i + 1) = varSwap
blnSwapped = True
End If
Next
iMax = iMax - 1
If Not blnSwapped Then Exit Do
For i = iMax To iMin Step -1
If pvarArray(i) > pvarArray(i + 1) Then
varSwap = pvarArray(i)
pvarArray(i) = pvarArray(i + 1)
pvarArray(i + 1) = varSwap
blnSwapped = True
End If
Next
iMin = iMin + 1
Loop Until Not blnSwapped
End Sub
Last edited by Ellis Dee; May 20th, 2008 at 11:10 AM.
Stable: No
In-Place: Yes
Online: No
Recursive: No
Grade: B+
Comb sort was invented by Stephen Lacey and Richard Box, who first described it to Byte Magazine in 1991. It improves on bubble sort and rivals in speed more complex algorithms like quicksort. The idea is to eliminate turtles, or small values near the end of the list, since in a bubble sort these slow the sorting down tremendously. (Rabbits, large values around the beginning of the list, do not pose a problem in bubble sort.)
In bubble sort, when any two elements are compared, they always have a gap (distance from each other) of one. The basic idea of comb sort is that the gap can be much more than one.
The gap starts out as the length of the list being sorted divided by the shrink factor (generally 1.3; see below), and the list is sorted with that value (rounded down to an integer if needed) for the gap. Then the gap is divided by the shrink factor again, the list is sorted with this new gap, and the process repeats until the gap is one. At this point, comb sort reverts to a true bubble sort, using a gap of one until the list is fully sorted. In this final stage of the sort most turtles have already been dealt with, so a bubble sort will be efficient.
The shrink factor has a great effect on the efficiency of comb sort. In the original article, the authors suggested 1.3 after trying some random lists and finding it to be generally the most effective. A value too small slows the algorithm down because more comparisons must be made, whereas a value too large may not kill enough turtles to be practical.
vb Code:
Public Sub CombSort1(ByRef pvarArray As Variant)
Const ShrinkFactor = 1.3
Dim lngGap As Long
Dim i As Long
Dim iMin As Long
Dim iMax As Long
Dim varSwap As Variant
Dim blnSwapped As Boolean
iMin = LBound(pvarArray)
iMax = UBound(pvarArray)
lngGap = iMax - iMin + 1
Do
If lngGap > 1 Then
lngGap = Int(lngGap / ShrinkFactor)
If lngGap = 10 Or lngGap = 9 Then lngGap = 11
End If
blnSwapped = False
For i = iMin To iMax - lngGap
If pvarArray(i) > pvarArray(i + lngGap) Then
varSwap = pvarArray(i)
pvarArray(i) = pvarArray(i + lngGap)
pvarArray(i + lngGap) = varSwap
blnSwapped = True
End If
Next
Loop Until lngGap = 1 And Not blnSwapped
End Sub
Last edited by Ellis Dee; May 20th, 2008 at 11:13 AM.
Stable: Yes
In-Place: Yes
Online: No
Recursive: No
Grade: C-
Gnome sort is a sorting algorithm which is similar to insertion sort except that moving an element to its proper place is accomplished by a series of swaps, as in bubble sort. It is conceptually simple, requiring no nested loops. In practice the algorithm has been reported to generally run as fast as Insertion sort, although this depends on the details of the architecture and the implementation
The name comes from the behavior of the Dutch garden gnome in sorting a line of flowerpots. He looks at the flower pot next to him and the previous one; if they are in the right order he steps one pot forward, otherwise he swaps them and steps one pot backwards. If there is no previous pot, he steps forwards; if there is no pot next to him, he is done
Effectively, the algorithm always finds the first place where two adjacent elements are in the wrong order, and swaps them. It takes advantage of the fact that performing a swap can only introduce a new out-of-order adjacent pair right before the two swapped elements, and so checks this position immediately after performing such a swap.
vb Code:
Public Sub GnomeSort1(ByRef pvarArray As Variant)
Dim i As Long
Dim j As Long
Dim iMin As Long
Dim iMax As Long
Dim varSwap As Variant
iMin = LBound(pvarArray) + 1
iMax = UBound(pvarArray)
i = iMin
j = i + 1
Do While i <= iMax
If pvarArray(i) < pvarArray(i - 1) Then
varSwap = pvarArray(i)
pvarArray(i) = pvarArray(i - 1)
pvarArray(i - 1) = varSwap
If i > iMin Then i = i - 1
Else
i = j
j = j + 1
End If
Loop
End Sub
Last edited by Ellis Dee; May 20th, 2008 at 11:14 AM.
Stable: No
In-Place: Yes
Online: No
Recursive: No
Grade: A-
Heap sort is a much more efficient version of selection sort. Invented by John William Joseph Williams in 1964, it works efficiently by using a data structure called a heap.
A heap is a specialized tree-based data structure that satisfies the heap property: if B is a child node of A, then key(A) >= key(B). This implies that the element with the greatest key is always in the root node. All elements to be sorted are inserted into a heap, and the heap organizes the elements added to it in such a way that the largest value can be quickly extracted.
Once the data list has been made into a heap, the root node is guaranteed to be the largest element. It is removed and placed at the end of the list, then the heap is rearranged so the largest element remaining moves to the root. Using the heap, finding the next largest element takes much less time than scanning every remaining element, which gives heap sort much better performance than selection sort. Similar to selection sort, the initial conditions have little or no effect on the amount of time required.
Heap sort is one of the best general-purpose sorting algorithms. Although somewhat slower in practice on most machines than a good implementation of quicksort, it has a better worst-case runtime.
vb Code:
Public Sub HeapSort1(ByRef pvarArray As Variant)
Dim i As Long
Dim iMin As Long
Dim iMax As Long
Dim varSwap As Variant
iMin = LBound(pvarArray)
iMax = UBound(pvarArray)
For i = (iMax + iMin) \ 2 To iMin Step -1
Heap1 pvarArray, i, iMin, iMax
Next i
For i = iMax To iMin + 1 Step -1
varSwap = pvarArray(i)
pvarArray(i) = pvarArray(iMin)
pvarArray(iMin) = varSwap
Heap1 pvarArray, iMin, iMin, i - 1
Next i
End Sub
Private Sub Heap1(ByRef pvarArray As Variant, ByVal i As Long, iMin As Long, iMax As Long)
Dim lngLeaf As Long
Dim varSwap As Variant
Do
lngLeaf = i + i - (iMin - 1)
Select Case lngLeaf
Case Is > iMax: Exit Do
Case Is < iMax: If pvarArray(lngLeaf + 1) > pvarArray(lngLeaf) Then lngLeaf = lngLeaf + 1
End Select
If pvarArray(i) > pvarArray(lngLeaf) Then Exit Do
varSwap = pvarArray(i)
pvarArray(i) = pvarArray(lngLeaf)
pvarArray(lngLeaf) = varSwap
i = lngLeaf
Loop
End Sub
Last edited by Ellis Dee; May 20th, 2008 at 11:17 AM.
Stable: Yes
In-Place: Yes
Online: Yes
Recursive: No
Grade: C
Insertion sort is a simple comparison sort in which the sorted array (or list) is built one entry at a time. It is much less efficient on large lists than more advanced algorithms such as quicksort, heapsort, or merge sort, but it's very efficient on small (5-50 key) lists, as well as lists that are mostly sorted to begin with.
In abstract terms, every iteration of an insertion sort removes an element from the input data, inserting it at the correct position in the already sorted list, until no elements are left in the input. The choice of which element to remove from the input is arbitrary and can be made using almost any choice algorithm.
vb Code:
Public Sub InsertionSort1(ByRef pvarArray As Variant)
Dim i As Long
Dim j As Long
Dim iMin As Long
Dim iMax As Long
Dim varSwap As Variant
iMin = LBound(pvarArray) + 1
iMax = UBound(pvarArray)
For i = iMin To iMax
varSwap = pvarArray(i)
For j = i To iMin Step -1
If varSwap < pvarArray(j - 1) Then pvarArray(j) = pvarArray(j - 1) Else Exit For
Next j
pvarArray(j) = varSwap
Next i
End Sub
Last edited by Ellis Dee; May 20th, 2008 at 11:18 AM.
Stable: No
In-Place: Yes
Online: No
Recursive: No
Grade: C+
JSort is a hybrid of heap sort and insertion sort developed by Jason Morrison. It works by running two heap passes to roughly order the array, and then finishes with an insertion sort.
The first heap pass converts the array to a heap, moving the smallest item to the top. The second heap pass works in reverse, moving the largest element to the bottom. These two passes combine to roughly order the array, though much work is still left to the final insertion sort.
Because each heap pass only partially orders the list, the larger the array the more work is left for the final insertion sort pass, which can end up being highly ineffecient.
For small lists, JSort is extremely efficient, but due to its design it does not scale well.
(code not currently available)
Last edited by Ellis Dee; May 20th, 2008 at 12:56 PM.
Stable: No
In-Place: Yes
Online: No
Recursive: No
Grade: B-
Similar to shell sort and comb sort, jump sort employs a gap value that decreases in each successive pass that allows out-of-place elements to be moved very far initially. The underlying framework is based on bubble sort instead of the more efficient insertion sort, but due to the initial ordering in the early passes it ends up being very efficient in practice, though still somewhat slower than either shell sort or comb sort.
vb Code:
Public Sub JumpSort1(ByRef pvarArray As Variant)
Dim lngJump As Long
Dim i As Long
Dim iMin As Long
Dim iMax As Long
Dim varSwap As Variant
Dim blnSwapped As Boolean
iMin = LBound(pvarArray)
iMax = UBound(pvarArray)
lngJump = iMax - iMin
If lngJump < 2 Then lngJump = 2
Do
lngJump = lngJump \ 2
Do
blnSwapped = False
For i = iMin To iMax - lngJump
If pvarArray(i) > pvarArray(i + lngJump) Then
varSwap = pvarArray(i)
pvarArray(i) = pvarArray(i + lngJump)
pvarArray(i + lngJump) = varSwap
blnSwapped = True
End If
Next
Loop Until Not blnSwapped
Loop Until lngJump = 1
End Sub
Last edited by Ellis Dee; May 20th, 2008 at 12:53 PM.
Stable: Yes
In-Place: No
Online: No
Recursive: Yes
Grade: A-
Similar to quicksort, merge sort is a recursive algorithm based on a divide and conquer strategy. First, the sequence to be sorted is split into two halves. Each half is then sorted independently, and the two sorted halves are merged to a sorted sequence. Merge sort takes advantage of the ease of merging together already sorted lists.
In many implementations, merge sort calls out to an external algorithm -- usually insertion sort -- when it reaches a level of around 10-20 elements. This is not necessary in Visual Basic; in fact such an implementation appears to slow merge sort's overall performance in practice.
Instead, the implementation here uses the purest form of merge sort, where the list is recursively divided into halves until it reaches a list size of two, at which point those two elements are sorted.
Unfortunately, extra memory is required to combine two sorted lists together. The extra memory in this implementation is in the form of a full copy of the initial array. There are various optimizations that can be made to improve on this, but that is left as an exercise for the reader.
Invented in 1945 by John von Neumann, merge sort is far and away the fastest stable algorithm.
vb Code:
' Omit pvarMirror, plngLeft & plngRight; they are used internally during recursion
Public Sub MergeSort1(ByRef pvarArray As Variant, Optional pvarMirror As Variant, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
Dim lngMid As Long
Dim L As Long
Dim R As Long
Dim O As Long
Dim varSwap As Variant
If plngRight = 0 Then
plngLeft = LBound(pvarArray)
plngRight = UBound(pvarArray)
ReDim pvarMirror(plngLeft To plngRight)
End If
lngMid = plngRight - plngLeft
Select Case lngMid
Case 0
Case 1
If pvarArray(plngLeft) > pvarArray(plngRight) Then
Stable: No
In-Place: Yes
Online: No
Recursive: Yes
Grade: A
Quicksort was originally invented in 1960 by Charles Antony Richard Hoare. It is a divide and conquer algorithm which relies on a partition operation.
To partition an array, a pivot element is first randomly selected, and then compared against every other element. All smaller elements are moved before the pivot, and all larger elements are moved after. The lesser and greater sublists are then recursively processed until the entire list is sorted. This can be done efficiently in linear time and in-place.
Quick sort turns out to be the fastest sorting algorithm in practice. However, in the (very rare) worst case quick sort is as slow as bubble sort. There are good sorting algorithms with a better worst case, e.g. heap sort and merge sort, but on the average they are slower than quick sort by a consistent margin.
The implementation here uses Niklaus Wirth's variant for selecting the pivot value, which is simply using the middle value. This works particularly well for already sorted lists.
Its speed and modest space usage makes quick sort one of the most popular sorting algorithms, available in many standard libraries.
vb Code:
' Omit plngLeft & plngRight; they are used internally during recursion
Public Sub QuickSort1(ByRef pvarArray As Variant, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
Dim lngFirst As Long
Dim lngLast As Long
Dim varMid As Variant
Dim varSwap As Variant
If plngRight = 0 Then
plngLeft = LBound(pvarArray)
plngRight = UBound(pvarArray)
End If
lngFirst = plngLeft
lngLast = plngRight
varMid = pvarArray((plngLeft + plngRight) \ 2)
Do
Do While pvarArray(lngFirst) < varMid And lngFirst < plngRight
lngFirst = lngFirst + 1
Loop
Do While varMid < pvarArray(lngLast) And lngLast > plngLeft
lngLast = lngLast - 1
Loop
If lngFirst <= lngLast Then
varSwap = pvarArray(lngFirst)
pvarArray(lngFirst) = pvarArray(lngLast)
pvarArray(lngLast) = varSwap
lngFirst = lngFirst + 1
lngLast = lngLast - 1
End If
Loop Until lngFirst > lngLast
If plngLeft < lngLast Then QuickSort1 pvarArray, plngLeft, lngLast
If lngFirst < plngRight Then QuickSort1 pvarArray, lngFirst, plngRight
End Sub
Last edited by Ellis Dee; May 20th, 2008 at 12:37 PM.
Stable: No
In-Place: Yes
Online: No
Recursive: Yes
Grade: A+
The critical operation in the standard quick sort is choosing a pivot: the element around which the list is partitioned. The simplest pivot selection algorithm is to take the first or the last element of the list as the pivot, causing poor behavior for the case of sorted or nearly-sorted input. Niklaus Wirth's variant uses the middle element to prevent these occurrences, degenerating to O(n²) for contrived sequences.
The median-of-3 pivot selection algorithm takes the median of the first, middle, and last elements of the list; however, even though this performs well on many real-world inputs, it is still possible to contrive a median-of-3 killer list that will cause dramatic slowdown of a quicksort based on this pivot selection technique. Such inputs could potentially be exploited by an aggressor, for example by sending such a list to an Internet server for sorting as a denial of service attack.
The quicksort3 implementation here uses a median-of-3 technique, but instead of using the first, last and middle elements, three elements are chosen at random. This has the advantage of being immune to intentional attacks, though there is still a possibility (however remote) of realizing the worst case scenario.
vb Code:
' Omit plngLeft & plngRight; they are used internally during recursion
Public Sub MedianThreeQuickSort1(ByRef pvarArray As Variant, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
Dim lngFirst As Long
Dim lngLast As Long
Dim varMid As Variant
Dim lngIndex As Long
Dim varSwap As Variant
Dim a As Long
Dim b As Long
Dim c As Long
If plngRight = 0 Then
plngLeft = LBound(pvarArray)
plngRight = UBound(pvarArray)
End If
lngFirst = plngLeft
lngLast = plngRight
lngIndex = plngRight - plngLeft + 1
a = Int(lngIndex * Rnd) + plngLeft
b = Int(lngIndex * Rnd) + plngLeft
c = Int(lngIndex * Rnd) + plngLeft
If pvarArray(a) <= pvarArray(b) And pvarArray(b) <= pvarArray(c) Then
lngIndex = b
Else
If pvarArray(b) <= pvarArray(a) And pvarArray(a) <= pvarArray(c) Then
lngIndex = a
Else
lngIndex = c
End If
End If
varMid = pvarArray(lngIndex)
Do
Do While pvarArray(lngFirst) < varMid And lngFirst < plngRight
lngFirst = lngFirst + 1
Loop
Do While varMid < pvarArray(lngLast) And lngLast > plngLeft
lngLast = lngLast - 1
Loop
If lngFirst <= lngLast Then
varSwap = pvarArray(lngFirst)
pvarArray(lngFirst) = pvarArray(lngLast)
pvarArray(lngLast) = varSwap
lngFirst = lngFirst + 1
lngLast = lngLast - 1
End If
Loop Until lngFirst > lngLast
If lngLast – plngLeft < plngRight – lngFirst Then
If plngLeft < lngLast Then MedianThreeQuickSort1 pvarArray, plngLeft, lngLast
If lngFirst < plngRight Then MedianThreeQuickSort1 pvarArray, lngFirst, plngRight
Else
If lngFirst < plngRight Then MedianThreeQuickSort1 pvarArray, lngFirst, plngRight
If plngLeft < lngLast Then MedianThreeQuickSort1 pvarArray, plngLeft, lngLast
End If
End Sub
Last edited by Ellis Dee; Sep 11th, 2009 at 07:15 AM.
Stable: No
In-Place: Yes
Online: No
Recursive: No
Grade: C-
Selection sort is a simple sorting algorithm that mimics the way humans instinctively sort. It works by first scanning the entire list to find the smallest element, swapping it into the first position. It then finds the next smallest element, swapping that into the second position, and so on until the list is sorted.
Selection sort is unique compared to almost any other algorithm in that its running time is not affected by the prior ordering of the list; it always performs the same number of operations because of its simple structure. Selection sort also requires only n swaps, which can be very attractive if writes are the most expensive operation.
Unless writes are very expensive, selection sort will usually be outperformed by the more complicated algorithms, though it will always outperform a basic bubble sort. Heap sort is an efficient variation of selection sort that is both very fast and also scales well.
vb Code:
Public Sub SelectionSort1(ByRef pvarArray As Variant)
Dim i As Long
Dim j As Long
Dim iMin As Long
Dim iMax As Long
Dim varSwap As Variant
iMin = LBound(pvarArray)
iMax = UBound(pvarArray)
For i = iMin To iMax - 1
iMin = i
For j = (i + 1) To iMax
If pvarArray(j) < pvarArray(iMin) Then iMin = j
Next
varSwap = pvarArray(i)
pvarArray(i) = pvarArray(iMin)
pvarArray(iMin) = varSwap
Next
End Sub
Last edited by Ellis Dee; May 20th, 2008 at 12:17 PM.
Stable: Yes
In-Place: Yes
Online: No
Recursive: No
Grade: B
Shaker sort is a gap-based bubble sort with a twist. Most gap sorts -- shell sort, comb sort, et al. -- begin with a large gap and gradually shrink it down to one. By the time the gap reaches one, the list should be mostly ordered so the final pass should be efficient.
Like other gap sorts, shaker sort begins with a large gap which gradually shrinks. However, once the gap reaches one, the gap gets expanded again before shrinking back toward one. The expanding and contracting gap sizes constitute the "shaking" part of shaker sort. Each additional expansion is smaller and smaller until it eventually resolves to one, when no further expansion is done. At this point the list is almost certain to be nearly sorted, so the final bubble sort pass is very efficient.
vb Code:
Public Function ShakerSort1(ByRef pvarArray As Variant)
Dim i As Long
Dim j As Long
Dim k As Long
Dim iMin As Long
Dim iMax As Long
Dim varSwap As Variant
Dim blnSwapped As Boolean
iMin = LBound(pvarArray)
iMax = UBound(pvarArray)
i = (iMax - iMin) \ 2 + iMin
Do While i > iMin
j = i
Do While j > iMin
For k = iMin To i - j
If pvarArray(k) > pvarArray(k + j) Then
varSwap = pvarArray(k)
pvarArray(k) = pvarArray(k + j)
pvarArray(k + j) = varSwap
End If
Next
j = j \ 2
Loop
i = i \ 2
Loop
iMax = iMax - 1
Do
blnSwapped = False
For i = iMin To iMax
If pvarArray(i) > pvarArray(i + 1) Then
varSwap = pvarArray(i)
pvarArray(i) = pvarArray(i + 1)
pvarArray(i + 1) = varSwap
blnSwapped = True
End If
Next i
If blnSwapped Then
blnSwapped = False
iMax = iMax - 1
For i = iMax To iMin Step -1
If pvarArray(i) > pvarArray(i + 1) Then
varSwap = pvarArray(i)
pvarArray(i) = pvarArray(i + 1)
pvarArray(i + 1) = varSwap
blnSwapped = True
End If
Next i
iMin = iMin + 1
End If
Loop Until Not blnSwapped
End Function
Last edited by Ellis Dee; May 20th, 2008 at 12:16 PM.
Stable: No
In-Place: Yes
Online: No
Recursive: No
Grade: B+
Shell sort is a variation of insertion sort that was invented by (and takes its name from) Donald Shell, who published the algorithm in 1959.
Shell sort improves on insertion sort by comparing elements separated by a gap of several positions. This lets an element take "bigger steps" toward its expected position. Multiple passes over the data are taken using insertion sort with smaller and smaller gap sizes. The last step of Shell sort is with a gap size of one -- meaning it is a standard insertion sort -- guaranteeing that the final list is sorted. By then, the list will be almost sorted already, so the final pass is efficient.
The gap sequence is an integral part of the shellsort algorithm. Any increment sequence will work, so long as the last element is 1. Donald Shell originally suggested a gap sequence starting at half the size of the list, dividing by half every iteration until it reached one. While offering significant improvement over a standard insertion sort, it was later found that steps of three improve performance even further.
In the implementation here, the initial gap size is calculated by an iterative formula x=3x+1, where x starts at 0 and grows until the gap is larger than the list size. Each insertion sort loop begins by dividing the gap by three, thus ensuring a very large starting gap.
A key feature of shell sort is that the elements remain k-sorted even as the gap diminishes. For instance, if a list was 5-sorted and then 3-sorted, the list is now not only 3-sorted, but both 5- and 3-sorted. If this were not true, the algorithm would undo work that it had done in previous iterations, and would not achieve such a low running time.
Although shell sort is inefficient for large data sets, it is one of the fastest algorithms for sorting small numbers of elements (sets with less than 1000 or so elements). Another advantage of this algorithm is that it requires relatively small amounts of memory. It is worth noting that shell sort enjoyed a brief period when it was the fastest sorting algorithm known, only to be eclipsed by quicksort one year later.
vb Code:
Public Sub ShellSort1(ByRef pvarArray As Variant)
Dim lngHold As Long
Dim lngGap As Long
Dim i As Long
Dim iMin As Long
Dim iMax As Long
Dim varSwap As Variant
iMin = LBound(pvarArray)
iMax = UBound(pvarArray)
lngGap = iMin
Do
lngGap = 3 * lngGap + 1
Loop Until lngGap > iMax
Do
lngGap = lngGap \ 3
For i = lngGap + iMin To iMax
varSwap = pvarArray(i)
lngHold = i
Do While pvarArray(lngHold - lngGap) > varSwap
pvarArray(lngHold) = pvarArray(lngHold - lngGap)
lngHold = lngHold - lngGap
If lngHold < iMin + lngGap Then Exit Do
Loop
pvarArray(lngHold) = varSwap
Next i
Loop Until lngGap = 1
End Sub
Last edited by Ellis Dee; May 26th, 2008 at 04:01 PM.
Stable: No
In-Place: Yes
Online: No
Recursive: No
Grade: A-
Smooth sort is a variation of heap sort developed by Edsger Dijkstra in 1981. (Here is a direct link to his original paper in pdf form.)
Smooth sort has a similar average case to heap sort but a much better best case, with a smooth transition between the two. This is where the name comes from. The advantage of smoothsort is that it's faster if the input is already sorted to some degree.
Due to its complexity, smoothsort is rarely used.
vb Code:
' This code is not mine; converted from java code
Public Sub SmoothSort1(ByRef pvarArray As Variant)
Dim q As Long
Dim R As Long
Dim p As Long
Dim b As Long
Dim c As Long
Dim temp As Long
q = 1
p = 1
b = 1
c = 1
Do While q <> UBound(pvarArray) + 1
If p Mod 8 = 3 Then
SmoothSift pvarArray, R, b, c
p = (p + 1) \ 4
SmoothUp b, c
SmoothUp b, c
ElseIf p Mod 4 = 1 Then
If q + c < UBound(pvarArray) + 1 Then
SmoothSift pvarArray, R, b, c
Else
SmoothTrinkle pvarArray, R, p, b, c
End If
Do
SmoothDown b, c
p = p * 2
Loop While b <> 1
p = p + 1
End If
q = q + 1
R = R + 1
Loop
SmoothTrinkle pvarArray, R, p, b, c
Do While q <> 1
q = q - 1
If b = 1 Then
R = R - 1
p = p - 1
Do While p Mod 2 = 0
p = p / 2
SmoothUp b, c
Loop
ElseIf b >= 3 Then
p = p - 1
R = R + c - b
If p <> 0 Then SmoothSemiTrinkle pvarArray, R, p, b, c
SmoothDown b, c
p = p * 2 + 1
R = R + c
SmoothSemiTrinkle pvarArray, R, p, b, c
SmoothDown b, c
p = p * 2 + 1
End If
Loop
End Sub
Private Sub SmoothUp(b As Long, c As Long)
Dim temp As Long
temp = b + c + 1
c = b
b = temp
End Sub
Private Sub SmoothDown(b As Long, c As Long)
Dim temp As Long
temp = b - c - 1
b = c
c = temp
End Sub
Private Sub SmoothSift(ByRef pvarArray As Variant, ByVal R As Long, ByVal b As Long, ByVal c As Long)
Dim r2 As Long
Dim varSwap As Variant
Do While b >= 3
r2 = R - b + c
If pvarArray(r2) < pvarArray(R - 1) Then
r2 = R - 1
SmoothDown b, c
End If
If pvarArray(R) >= pvarArray(r2) Then
b = 1
Else
varSwap = pvarArray(R)
pvarArray(R) = pvarArray(r2)
pvarArray(r2) = varSwap
R = r2
SmoothDown b, c
End If
Loop
End Sub
Private Sub SmoothTrinkle(pvarArray As Variant, ByVal R As Long, ByVal p As Long, ByVal b As Long, ByVal c As Long)
Dim r2 As Long
Dim r3 As Long
Dim varSwap As Variant
Do While p > 0
Do While p Mod 2 = 0
p = p \ 2
SmoothUp b, c
Loop
r3 = R - b
If p = 1 Then
p = 0
ElseIf pvarArray(r3) <= pvarArray(R) Then
p = 0
Else
p = p - 1
If b = 1 Then
varSwap = pvarArray(R)
pvarArray(R) = pvarArray(r3)
pvarArray(r3) = varSwap
R = r3
ElseIf b >= 3 Then
r2 = R - b + c
If pvarArray(r2) < pvarArray(R - 1) Then
r2 = R - 1
SmoothDown b, c
p = p * 2
End If
If pvarArray(r3) >= pvarArray(r2) Then
varSwap = pvarArray(R)
pvarArray(R) = pvarArray(r3)
pvarArray(r3) = varSwap
R = r3
Else
varSwap = pvarArray(R)
pvarArray(R) = pvarArray(r2)
pvarArray(r2) = varSwap
R = r2
SmoothDown b, c
p = 0
End If
End If
End If
Loop
SmoothSift pvarArray, R, b, c
End Sub
Private Sub SmoothSemiTrinkle(pvarArray As Variant, ByVal R As Long, ByVal p As Long, ByVal b As Long, ByVal c As Long)
Dim r1 As Long
Dim varSwap As Variant
r1 = R - c
If pvarArray(r1) > pvarArray(R) Then
varSwap = pvarArray(R)
pvarArray(R) = pvarArray(r1)
pvarArray(r1) = varSwap
SmoothTrinkle pvarArray, r1, p, b, c
End If
End Sub
Last edited by Ellis Dee; May 20th, 2008 at 12:07 PM.
Stable: No
In-Place: No
Online: No
Recursive: No
Grade: A
An original algorithm, snake sort was invented by me in 2007 while I was writing this program. It is as fast or faster than any other algorithm, including quicksort, and it scales up as well as quick sort excluding memory constraints. It is in the merge sort family, and is unstable, out-of-place, offline, and non-recursive. I call it snake sort due to its similarities to fantasy football snake drafts.
The idea is simple: A random ordering will result in very small contiguous ordered blocks in either direction. Snake sort begins by identifying all those blocks, and then merges them together. Each merge pass will halve the remaining number of blocks, so it very quickly resolves to a sorted state.
It uses quite a bit of memory: a full copy of the original array, plus an index array (to remember the block cutoffs) half the size of the original array.
One key feature is to bounce the array contents back and forth between the original array and the mirror array. The standard merge sort wastes operations by first merging to a mirror array and then copying the result back each step. Snake sort does a similar merge each pass, but then leaves the result in whichever array was merged to. Each subsequent pass merges to the other array, in effect snaking the results back and forth until the list is fully sorted. This means that if the last step leaves the contents in the mirror array, a final pass must be run to copy that back over the original.
The most interesting feature of snake sort is that the more ordered the array is initially, the faster it runs. Because it is in the unique position of knowing when the intial order is descending, it is optimally efficient at transposing such a list to an ordered state.
vb Code:
Public Sub SnakeSort1(ByRef pvarArray As Variant)
Dim i As Long
Dim iMin As Long
Dim iMax As Long
Dim lngIndex() As Long
Dim lngLevel As Long
Dim lngOldLevel As Long
Dim lngNewLevel As Long
Dim varMirror As Variant
Dim lngDirection As Long
Dim blnMirror As Boolean
Dim varSwap As Variant
iMin = LBound(pvarArray)
iMax = UBound(pvarArray)
ReDim lngIndex((iMax - iMin + 3) \ 2)
lngIndex(0) = iMin
i = iMin
' Initial loop: locate cutoffs for each ordered section
Do Until i >= iMax
Select Case lngDirection
Case 1
Do Until i = iMax
If pvarArray(i) > pvarArray(i + 1) Then Exit Do
i = i + 1
Loop
Case -1
Do Until i = iMax
If pvarArray(i) < pvarArray(i + 1) Then Exit Do
i = i + 1
Loop
Case Else
Do Until i = iMax
If pvarArray(i) <> pvarArray(i + 1) Then Exit Do
i = i + 1
Loop
If i = iMax Then lngDirection = 1
End Select
If lngDirection = 0 Then
If pvarArray(i) > pvarArray(i + 1) Then
lngDirection = -1
Else
lngDirection = 1
End If
Else
lngLevel = lngLevel + 1
lngIndex(lngLevel) = i * lngDirection
lngDirection = 0
End If
i = i + 1
Loop
If Abs(lngIndex(lngLevel)) < iMax Then
If lngDirection = 0 Then lngDirection = 1
lngLevel = lngLevel + 1
lngIndex(lngLevel) = i * lngDirection
End If
' If the list is already sorted, exit
If lngLevel <= 1 Then
' If sorted descending, reverse before exiting
If lngIndex(lngLevel) < 0 Then
For i = 0 To (iMax - iMin) \ 2
varSwap = pvarArray(iMin + i)
pvarArray(iMin + i) = pvarArray(iMax - i)
pvarArray(iMax - i) = varSwap
Next
End If
Exit Sub
End If
' Main loop - merge section pairs together until only one section left
Did something just because I thought it looks cool. Not fast, but cool:
Code:
Public Function ShearSort1(ByRef pvarArray As Variant)
Dim Log As Long, Rows As Long, Cols As Long
Dim pow As Long, div As Long
Dim h() As Long
Dim i As Long, k As Long, j As Long
Dim lMax As Long, lMin As Long
lMax = UBound(pvarArray) + 1
lMin = LBound(pvarArray)
pow = 1
div = 1
Do While i * i <= lMax
If i > 0 Then
If lMax Mod i = 0 Then div = i
Else
div = i
End If
i = i + 1
Loop
Rows = div
Cols = lMax \ div
Do While pow <= Rows
pow = pow * 2
Log = Log + 1
Loop
ReDim h(Rows)
For i = 0 To Rows
h(i) = i * Cols
Next i
For k = 0 To Log - 1
For j = 0 To Cols \ 2 - 1
For i = 0 To Rows - 1
ShearPart1 pvarArray, h(i), h(i + 1), 1, i Mod 2 = 0
Next i
For i = 0 To Rows - 1
ShearPart2 pvarArray, h(i), h(i + 1), 1, i Mod 2 = 0
Next i
Next j
For j = 0 To Rows \ 2 - 1
For i = 0 To Cols - 1
ShearPart1 pvarArray, i, Rows * Cols + i, Cols, True
Next i
For i = 0 To Cols - 1
ShearPart2 pvarArray, i, Rows * Cols + i, Cols, True
Next i
Next j
Next k
For j = 0 To Cols \ 2 - 1
For i = 0 To Rows - 1
ShearPart1 pvarArray, h(i), h(i + 1), 1, True
Next i
For i = 0 To Rows - 1
ShearPart2 pvarArray, h(i), h(i + 1), 1, True
Next i
Next j
For i = 0 To Rows - 1
h(i) = -1
Next i
End Function
Private Sub ShearPart1(ByRef a As Variant, ByVal Lo As Long, ByVal Hi As Long, ByVal Nx As Long, ByVal Up As Boolean)
Dim t As Variant
Dim j As Long
j = Lo
If Up Then
Do While j + Nx < Hi
If a(j) > a(j + Nx) Then
t = a(j)
a(j) = a(j + Nx)
a(j + Nx) = t
End If
j = j + 2 * Nx
Loop
Else
Do While j + Nx < Hi
If a(j) < a(j + Nx) Then
t = a(j)
a(j) = a(j + Nx)
a(j + Nx) = t
End If
j = j + 2 * Nx
Loop
End If
End Sub
Private Sub ShearPart2(ByRef a As Variant, ByVal Lo As Long, ByVal Hi As Long, ByVal Nx As Long, ByVal Up As Boolean)
Dim t As Variant
Dim j As Long
j = Lo + Nx
If Up Then
Do While j + Nx < Hi
If a(j) > a(j + Nx) Then
t = a(j)
a(j) = a(j + Nx)
a(j + Nx) = t
End If
j = j + 2 * Nx
Loop
Else
Do While j + Nx < Hi
If a(j) < a(j + Nx) Then
t = a(j)
a(j) = a(j + Nx)
a(j + Nx) = t
End If
j = j + 2 * Nx
Loop
End If
End Sub
Code:
Public Function ShearSort(ByRef plngArray() As Long)
Dim Log As Long, Rows As Long, Cols As Long
Dim pow As Long, div As Long
Dim h() As Long
Dim i As Long, k As Long, j As Long
Dim lMax As Long, lMin As Long
lMax = UBound(plngArray) + 1
lMin = LBound(plngArray)
pow = 1
div = 1
Do While i * i <= lMax
If i > 0 Then
If lMax Mod i = 0 Then div = i
Else
div = i
End If
i = i + 1
Loop
Rows = div
Cols = lMax \ div
Do While pow <= Rows
pow = pow * 2
Log = Log + 1
Loop
ReDim h(Rows)
For i = 0 To Rows
h(i) = i * Cols
Next i
For k = 0 To Log - 1
For j = 0 To Cols \ 2 - 1
For i = 0 To Rows - 1
ShearPart1 plngArray, h(i), h(i + 1), 1, i Mod 2 = 0
Next i
For i = 0 To Rows - 1
ShearPart2 plngArray, h(i), h(i + 1), 1, i Mod 2 = 0
Next i
Next j
For j = 0 To Rows \ 2 - 1
For i = 0 To Cols - 1
ShearPart1 plngArray, i, Rows * Cols + i, Cols, True
Next i
For i = 0 To Cols - 1
ShearPart2 plngArray, i, Rows * Cols + i, Cols, True
Next i
Next j
Next k
For j = 0 To Cols \ 2 - 1
For i = 0 To Rows - 1
ShearPart1 plngArray, h(i), h(i + 1), 1, True
Next i
For i = 0 To Rows - 1
ShearPart2 plngArray, h(i), h(i + 1), 1, True
Next i
Next j
For i = 0 To Rows - 1
h(i) = -1
Next i
End Function
Private Sub ShearPart1(ByRef a() As Long, ByVal Lo As Long, ByVal Hi As Long, ByVal Nx As Long, ByVal Up As Boolean)
Dim t As Long
Dim j As Long
j = Lo
If Up Then
Do While j + Nx < Hi
Compare aeShakersort, j, j + Nx
If a(j) > a(j + Nx) Then
Exchange aeShakersort, j, j + Nx
End If
j = j + 2 * Nx
Loop
Else
Do While j + Nx < Hi
Compare aeShakersort, j, j + Nx
If a(j) < a(j + Nx) Then
Exchange aeShakersort, j, j + Nx
End If
j = j + 2 * Nx
Loop
End If
End Sub
Private Sub ShearPart2(ByRef a As Variant, ByVal Lo As Long, ByVal Hi As Long, ByVal Nx As Long, ByVal Up As Boolean)
Dim t As Variant
Dim j As Long
j = Lo + Nx
If Up Then
Do While j + Nx < Hi
Compare aeShakersort, j, j + Nx
If a(j) > a(j + Nx) Then
Exchange aeShakersort, j, j + Nx
End If
j = j + 2 * Nx
Loop
Else
Do While j + Nx < Hi
Compare aeShakersort, j, j + Nx
If a(j) < a(j + Nx) Then
Exchange aeShakersort, j, j + Nx
End If
j = j + 2 * Nx
Loop
End If
End Sub
hehheh, that's funny. It looks particularly trippy when doing the worst case. (And it seems to have a panic attack when dealing with best case.) And hey, it's faster than bubblesort, so I'm including it. I'm thinking I could fit a third row in there.
I think you're almost as into watching those little lines draw as I am. I swear, I can just sit and stare at them like a mental patient. I don't need food, or drink, or sleep; must watch lines.
I came up with a new sorting algorithm that is as fast or faster than any other algorithm, including quick sort, and it scales up as well as quicksort excluding memory constraints. It is in the merge sort family, and it is unstable, out-of-place, offline, and non-recursive. I call it snake sort due to its similarity to fantasy football snake drafts.
The idea is simple: A random ordering will result in very small contiguous ordered blocks in either direction. Snake sort begins by identifying all those blocks, and then merges them together. Each merge pass will halve the remaining number of blocks, so it very quickly resolves to a sorted state.
It uses quite a bit of memory; a full copy of the original array, plus an index array (to remember the block cutoffs) of longs half the size of the original array.
Consider the 10 character string SJDFGASLKD. The first three letters, SJD, are already in descending order, so they are the first block. FG are in ascending order, so that's the second block. AS becomes the third block, and LKD (descending order) rounds us out with the fourth and final block.
One key optimization is to bounce the array contents back and forth between the original array and the mirror array instead of merging to the mirror and then copying back to the original each step. This means that if the last step leaves the contents in the mirror, an additional pass must be run to copy that back over the original.
Due to the support of both ascending and descending blocks and the bouncing back and forth between the two arrays -- both of which greatly improve efficiency -- the code sprawl is significant. I've moved the merging code into a separate function to help alleviate this, which means it could still be slightly improved by moving it all into a single function. That optimization would make the code sprawl severe, and likely wouldn't improve sorting times that much.
Here's the debug info I generated in testing for a shuffled array in the graphical screen. Notice how descending blocks are denoted by negative numbers: (Blocks are called levels.)
Once the initial pass identifies the original blocks, no basic comparisons are needed ever again, since by definition any elements inside a block are already in a sorted order. Each subsequent pass merges two blocks together, so the new block cutoffs are already known. This is another key optimization, which resulted in huge time savings. (Almost doubling the speed.)
Last edited by Ellis Dee; Jul 10th, 2007 at 03:54 AM.
Public Sub SnakeSort1(ByRef pvarArray As Variant)
Dim i As Long
Dim iMin As Long
Dim iMax As Long
Dim lngIndex() As Long
Dim lngLevel As Long
Dim lngOldLevel As Long
Dim lngNewLevel As Long
Dim varMirror As Variant
Dim lngDirection As Long
Dim blnMirror As Boolean
Dim varSwap As Variant
iMin = LBound(pvarArray)
iMax = UBound(pvarArray)
ReDim lngIndex((iMax - iMin + 3) \ 2)
lngIndex(0) = iMin
i = iMin
' Initial loop: locate cutoffs for each block
Do Until i >= iMax
Select Case lngDirection
Case 1
Do Until i = iMax
If pvarArray(i) > pvarArray(i + 1) Then Exit Do
i = i + 1
Loop
Case -1
Do Until i = iMax
If pvarArray(i) < pvarArray(i + 1) Then Exit Do
i = i + 1
Loop
Case Else
Do Until i = iMax
If pvarArray(i) <> pvarArray(i + 1) Then Exit Do
i = i + 1
Loop
If i = iMax Then lngDirection = 1
End Select
If lngDirection = 0 Then
If pvarArray(i) > pvarArray(i + 1) Then
lngDirection = -1
Else
lngDirection = 1
End If
Else
lngLevel = lngLevel + 1
lngIndex(lngLevel) = i * lngDirection
lngDirection = 0
End If
i = i + 1
Loop
If Abs(lngIndex(lngLevel)) < iMax Then
If lngDirection = 0 Then lngDirection = 1
lngLevel = lngLevel + 1
lngIndex(lngLevel) = i * lngDirection
End If
' If the list is already sorted, exit
If lngLevel <= 1 Then
' If sorted descending, reverse before exiting
If lngIndex(lngLevel) < 0 Then
For i = 0 To (iMax - iMin) \ 2
varSwap = pvarArray(iMin + i)
pvarArray(iMin + i) = pvarArray(iMax - i)
pvarArray(iMax - i) = varSwap
Next
End If
Exit Sub
End If
' Main loop - merge section pairs together until only one section left
ReDim varMirror(iMin To iMax)
Do Until lngLevel = 1
lngOldLevel = lngLevel
For lngLevel = 1 To lngLevel - 1 Step 2
If blnMirror Then
SnakeSortMerge varMirror, lngIndex(lngLevel - 1), lngIndex(lngLevel), lngIndex(lngLevel + 1), pvarArray
Else
SnakeSortMerge pvarArray, lngIndex(lngLevel - 1), lngIndex(lngLevel), lngIndex(lngLevel + 1), varMirror
End If
lngNewLevel = lngNewLevel + 1
lngIndex(lngNewLevel) = Abs(lngIndex(lngLevel + 1))
Next
If lngOldLevel Mod 2 = 1 Then
If blnMirror Then
For i = lngIndex(lngNewLevel) + 1 To iMax
pvarArray(i) = varMirror(i)
Next
Else
For i = lngIndex(lngNewLevel) + 1 To iMax
varMirror(i) = pvarArray(i)
Next
End If
lngNewLevel = lngNewLevel + 1
lngIndex(lngNewLevel) = lngIndex(lngOldLevel)
End If
lngLevel = lngNewLevel
lngNewLevel = 0
blnMirror = Not blnMirror
Loop
' Copy back to main array if necessary
If blnMirror Then
For i = iMin To iMax
pvarArray(i) = varMirror(i)
Next
End If
End Sub
Private Sub SnakeSortMerge(pvarSource As Variant, plngLeft As Long, plngMid As Long, plngRight As Long, pvarDest As Variant)
Dim L As Long
Dim LMin As Long
Dim LMax As Long
Dim LStep As Long
Dim R As Long
Dim RMin As Long
Dim RMax As Long
Dim RStep As Long
Dim O As Long
If plngLeft <> 0 Then O = Abs(plngLeft) + 1
If plngMid > 0 Then
LMin = O
LMax = Abs(plngMid)
LStep = 1
Else
LMin = Abs(plngMid)
LMax = O
LStep = -1
End If
If plngRight > 0 Then
RMin = Abs(plngMid) + 1
RMax = Abs(plngRight)
RStep = 1
Else
RMin = Abs(plngRight)
RMax = Abs(plngMid) + 1
RStep = -1
End If
L = LMin
R = RMin
Do
If pvarSource(L) <= pvarSource(R) Then
pvarDest(O) = pvarSource(L)
If L = LMax Then
For R = R To RMax Step RStep
O = O + 1
pvarDest(O) = pvarSource(R)
Next
Exit Do
End If
L = L + LStep
Else
pvarDest(O) = pvarSource(R)
If R = RMax Then
For L = L To LMax Step LStep
O = O + 1
pvarDest(O) = pvarSource(L)
Next
Exit Do
End If
R = R + RStep
End If
O = O + 1
Loop
End Sub
Code:
Private Sub SnakeSort(ByRef plngArray() As Long)
Dim i As Long
Dim iMin As Long
Dim iMax As Long
Dim lngIndex() As Long
Dim lngLevel As Long
Dim lngOldLevel As Long
Dim lngNewLevel As Long
Dim varMirror As Variant
Dim lngDirection As Long
Dim blnMirror As Boolean
iMin = LBound(plngArray)
iMax = UBound(plngArray)
ReDim lngIndex((iMax - iMin + 3) \ 2)
lngIndex(0) = iMin
i = iMin
' Initial loop: locate cutoffs for each block
Do Until i >= iMax
Select Case lngDirection
Case 1
Do Until i = iMax
Compare aeSnakesort, i, i + 1
If plngArray(i) > plngArray(i + 1) Then Exit Do
i = i + 1
Loop
Case -1
Do Until i = iMax
Compare aeSnakesort, i, i + 1
If plngArray(i) < plngArray(i + 1) Then Exit Do
i = i + 1
Loop
Case Else
Do Until i = iMax
Compare aeSnakesort, i, i + 1
If plngArray(i) <> plngArray(i + 1) Then Exit Do
i = i + 1
Loop
If i = iMax Then lngDirection = 1
End Select
If lngDirection = 0 Then
Compare aeSnakesort, i, i + 1
If plngArray(i) > plngArray(i + 1) Then
lngDirection = -1
Else
lngDirection = 1
End If
Else
lngLevel = lngLevel + 1
lngIndex(lngLevel) = i * lngDirection
lngDirection = 0
End If
i = i + 1
Loop
If Abs(lngIndex(lngLevel)) < iMax Then
If lngDirection = 0 Then lngDirection = 1
lngLevel = lngLevel + 1
lngIndex(lngLevel) = i * lngDirection
End If
' If the list is already sorted, exit
If lngLevel <= 1 Then
' If sorted descending, reverse before exiting
If lngIndex(lngLevel) < 0 Then
For i = 0 To (iMax - iMin) \ 2
Exchange aeSnakesort, iMin + i, iMax - i
Next
End If
Erase lngIndex
Exit Sub
End If
' Main loop - merge section pairs together until only one section left
ReDim varMirror(iMin To iMax)
Do Until lngLevel = 1
lngOldLevel = lngLevel
For lngLevel = 1 To lngLevel - 1 Step 2
If blnMirror Then
SnakeSortMerge varMirror, lngIndex(lngLevel - 1), lngIndex(lngLevel), lngIndex(lngLevel + 1), plngArray
Else
SnakeSortMerge plngArray, lngIndex(lngLevel - 1), lngIndex(lngLevel), lngIndex(lngLevel + 1), varMirror
End If
lngNewLevel = lngNewLevel + 1
lngIndex(lngNewLevel) = Abs(lngIndex(lngLevel + 1))
Next
If lngOldLevel Mod 2 = 1 Then
If blnMirror Then
For i = lngIndex(lngNewLevel) + 1 To iMax
SnakeMerge aeSnakesort, i, varMirror(i), lngIndex(lngNewLevel) + 1, iMax
plngArray(i) = varMirror(i)
Next
Else
For i = lngIndex(lngNewLevel) + 1 To iMax
SnakeMerge aeSnakesort, i, plngArray(i), lngIndex(lngNewLevel) + 1, iMax
varMirror(i) = plngArray(i)
Next
End If
lngNewLevel = lngNewLevel + 1
lngIndex(lngNewLevel) = lngIndex(lngOldLevel)
End If
lngLevel = lngNewLevel
lngNewLevel = 0
blnMirror = Not blnMirror
Loop
' Copy back to main array if necessary
If blnMirror Then
For i = iMin To iMax
SnakeMerge aeSnakesort, i, varMirror(i), iMin, iMax
plngArray(i) = varMirror(i)
Next
End If
End Sub
Private Sub SnakeSortMerge(pvarSource As Variant, plngLeft As Long, plngMid As Long, plngRight As Long, pvarDest As Variant)
Dim L As Long
Dim LMin As Long
Dim LMax As Long
Dim LStep As Long
Dim R As Long
Dim RMin As Long
Dim RMax As Long
Dim RStep As Long
Dim O As Long
If plngLeft <> 0 Then O = Abs(plngLeft) + 1
If plngMid > 0 Then
LMin = O
LMax = Abs(plngMid)
LStep = 1
Else
LMin = Abs(plngMid)
LMax = O
LStep = -1
End If
If plngRight > 0 Then
RMin = Abs(plngMid) + 1
RMax = Abs(plngRight)
RStep = 1
Else
RMin = Abs(plngRight)
RMax = Abs(plngMid) + 1
RStep = -1
End If
L = LMin
R = RMin
Do
Compare aeSnakesort, Abs(plngLeft), Abs(plngRight)
If pvarSource(L) <= pvarSource(R) Then
SnakeMerge aeSnakesort, O, pvarSource(L), Abs(plngLeft), Abs(plngRight)
pvarDest(O) = pvarSource(L)
If L = LMax Then
For R = R To RMax Step RStep
O = O + 1
SnakeMerge aeSnakesort, O, pvarSource(R), Abs(plngLeft), Abs(plngRight)
pvarDest(O) = pvarSource(R)
Next
Exit Do
End If
L = L + LStep
Else
SnakeMerge aeSnakesort, O, pvarSource(R), Abs(plngLeft), Abs(plngRight)
pvarDest(O) = pvarSource(R)
If R = RMax Then
For L = L To LMax Step LStep
O = O + 1
SnakeMerge aeSnakesort, O, pvarSource(L), Abs(plngLeft), Abs(plngRight)
pvarDest(O) = pvarSource(L)
Next
Exit Do
End If
R = R + RStep
End If
O = O + 1
Loop
End Sub
Private Sub SnakeMerge(penGraph As AlgorithmEnum, plngIndex As Long, ByVal plngValue As Long, plngLeft As Long, plngRight As Long)
With grph(penGraph)
.Exchanges = .Exchanges + 1
End With
LogOperation penGraph, oeMerge, plngLeft, plngRight, plngIndex, plngValue
End Sub
The most interesting feature of snake sort is that the more ordered the array is initially, the faster it runs. Each alogorithm has its own unique worst case scenario. Quick sort's worst case appears to be a camel hump, such as:
.1
.....5
.........9
.......7
...3
This puts the first pivot in the worst possible place, and it goes downhill from there. To see this in action, add this to the end of the seAscending Case in the GenerateArray() function:
Code:
For i = 0 To 24
mlngLines(i) = i * 4 + 1
mlngLines(49 - i) = (i + 1) * 4 - 1
Next
It would be logical to conclude that snake sort's worst case is alternating blocks of two. To see this, add this to the end of the seDescending Case:
Code:
For i = 0 To 48 Step 2
mlngLines(i) = (i * 2) + 3
mlngLines(i + 1) = (i * 2) + 1
Next
Finally, rename the SnakeSort() function to HeapSort(), and rename HeapSort() to something like HeapSortOld().
Snakesort is far more efficient on already ordered lists; virtually equal to bubblesort. It really shines on descending lists, where it can transform the array by looping only halfway through it and swapping the ends. (Comment out the added code from above to see it on ascending and descending lists.)
Most importantly, it's absolute worst case scenario is light years faster than quicksort's worst case. (Both scenarios are, IMO, unlikely in the extreme.) Given that the Time numbers are a rough approximation, where exchanges are assumed to take twice as long as comparisons and non-array comparisons and assignments are ignored, these are the Time numbers from the graphical screen:
Best case (ascending):
Quicksort: 317
Snakesort: 50 (absolute minimum + 1)
Random shuffle:
Quckisort: (roughly) 500
Snakesort: (roughly) 560
As you can see, snake sort approaches quicksort efficiency on randomly ordered lists, but gets much faster the moment any order presents itself, unlike quicksort.
(I find it odd that snake sort seems to process its "worst case" faster than it handles an arbitrary random case, but whatever.)
Your graphical time numbers aren't comparable to the real performance, because processing of the log can add a lot of processing into a loop that otherwise would work very quickly. But when you add the logging code in, it slows down the function a lot.
So you can only take a look at what results you get without graphical display's shown results.
(And I'm waiting for you to update the first post, I'm all too lazy to start going through the code now and putting it together, and I assume so are many others.)
It'll be a couple weeks, but it will be worth the wait. I'm incorporating the graphical screen in a more fundamental way, plus several new algorithms. (Your new shaker, shear, my snake sort, leinad's insertion sort if I can get it to work for any type of array, plus the joke sorts like bogosort.) I also want to expand the starting conditions to include true worst case scenarios instead of just inverted.
Everybody is welcome to contribute any idea they have for an algorithm. It doesn't have to be fast or efficient; all it has to do is sort.
As for the timing numbers, they at least give you a feel for what's going on. Here's some true timing numbers, each with three different trials (sorting the same array in the same trial):
Random Array - 99 elements
Snake sort: 0.00074, 0.00076, 0.00076 (Average: 0.00075)
Quick sort: 0.00078, 0.00077, 0.00080 (Average: 0.00078) -4%
Random Array - 999 elements
Snake sort: 0.0117, 0.0115, 0.0114 (Average: 0.0115)
Quick sort: 0.0142, 0.0128, 0.0125 (Average: 0.0132) -15%
Random Array - 9,999 elements
Snake sort: 0.172, 0.173, 0.154 (Average: 0.166)
Quick sort: 0.166, 0.175, 0.165 (Average: 0.169) -2%
Random Array - 99,999 elements
Snake sort: 2.122, 2.129, 2.125 (Average: 2.125)
Quick sort: 2.136, 2.123, 2.131 (Average: 2.130) -2%
Random Array - 999,999 elements
Quick sort: 25.189, 25.628, 25.113 (Average: 25.310)
Snake sort: 26.635, 26.230, 26.322 (Average: 26.396) -4%
Ascending order - 10,000 elements
Snake sort: 0.033
Quick sort: 0.096 -191%
Descending order - 10,000 elements
Snake sort: 0.011
Quick sort: 0.102 -827%
It might be worth looking at the mathematical reason that some of these are faster than others.
Bubble Sort, Selection Sort, Insertion Sort and Shell Sort are all O(n2) algorithms. This means that as n (the number of items in the list) increases, the time it takes for the algorithm to run increases at a rate of n2.
For example, if a list with 10 items may be sorted in 100 ms; A list with 100 items will take 10 seconds. As such, O(n2) Algorithms are not a good choice for sets with large amounts of data. (Obviously these exact times are made up; we aren't trying to determine how long it will take for a certain time, but rather how it scales.)
I see that you gave Heap, Merge, and Quicksort 'A's, which is right on the money. These sorts are O(nlog(n)), which means that the time does not increase as quickly when the number of items increases.
For example (using log base 2), a list with 10 items might take 33 ms to sort; a list with 100 items will then take 664 ms. A list with 1000 items will take just under 10 seconds. You can see that this is a marked improvement over the other sorts.
This is not to say that the other sorts are useless; for example, some of these algorithms will run very very quickly if you know that a list is almost sorted, whereas a more complicated algorithm will take more time.
An interesting special-case sort is the counting/bucket sort -- It's an O(n) algorithm, which means that the time it takes to run scales linearly with the number of items in the list; it can only be used when you can make specific claims about the data, however. It works by first counting the number of occurrences of each value, and then generating an array of those values in order.
You can find VB Code here and probably better C++ code at wikipedia
Code:
#include <stdio.h>
#include <stdlib.h>
#include <inttypes.h>
#include <memory.h>
// data: an array of unsorted integers
// data_size: the number of integers in the 'data' array
// result: an OUT parameter: where to store the sorted array
// min: the minimum value of all elements in 'data'
// max: the maximum value of all elements in 'data'.
void counting_sort(int* data, size_t data_size, int* result, int min, int max)
{
size_t bucket_size = (max - min) + 1;
// create an array for each of the values between 'max' and 'min':
int bucket[bucket_size];
// set each item in the bucket aray to 0.
for(int i = 0; i < bucket_size; ++i)
{
bucket[i] = 0;
}
// for each item in the array
for(int i = 0; i < data_size; ++i)
{
// convert the value in the array to an index into 'bucket'
int index = data[i] - min;
// increment the count for this value.
bucket[index]++;
}
int result_index = 0;
// now, build our result array:
// for each value in the bucket:
for(int i = 0; i < bucket_size; ++i)
{
while(bucket[i]-- > 0)
result[result_index++] = i + min;
}
}
// test it out:
int main()
{
// array to sort
int s[] = {7, 7, 8, 5,
6, 3, 1, 2,
4, 5, 6, 7,
8, 1, 1, 3};
// result array
int r[12];
// print unsorted array
for(int i = 0; i < 12; ++i)
printf("%d ", s[i]);
printf("\n");
counting_sort(s, 12, r, 1, 8);
// print sorted array
for(int i = 0; i < 12; ++i)
printf("%d ", r[i]);
printf("\n");
}
Actually, if you go over the algorithm you'll see that the claim of O(n) is not exactly true; rather, the order is O(m+n) where m is the range of the data. With a small m and large n you can get good performance.
EDIT: I had to post using the code tag instead of the highlight tag because the highlight tag breaks the array notation making the code unreadable.
Last edited by sunburnt; Jul 11th, 2007 at 01:28 PM.
Every passing hour brings the Solar System forty-three thousand miles closer to Globular Cluster M13 in Hercules -- and still there are some misfits who insist that there is no such thing as progress.
i've never actually used an array in vb6. but i need to create an array with the numbers 1 to 25 and shuffle them into a random order in the array, then take each number from that array seperately
i've never actually used an array in vb6. but i need to create an array with the numbers 1 to 25 and shuffle them into a random order in the array, then take each number from that array seperately
This isn't really the proper forum for such a question; the CodeBank is a repository for generic code.
If you create a new thread in the Classic Visual Basic forum, I (and no doubt many others) would be happy to help with your specific question.
Quirky question - should a sort algorithm be defined as a Function returning an array as the result or a procedure altering the array passed by reference?
Re: Quirky question, You could argue either way.. As a function you can always reassign the passed array with the return of the function, so it's nice and versitile. Obviously this will use twice the memory so if that is a concern then a Sub and ByRef is better.
I used the QuickSort routine with an String array of 10000 with each element in sequential order (ex. String000000 - String049999) With these strings duplicated in the last 5000 entries. Now going thru the QuickSort I get Out Of Memory. This is definitely because of the recursiveness of the routine.
Did you know about this or is this the reason this routine is listed as Not Stable?
I used the QuickSort routine with an String array of 10000 with each element in sequential order (ex. String000000 - String049999) With these strings duplicated in the last 5000 entries. Now going thru the QuickSort I get Out Of Memory. This is definitely because of the recursiveness of the routine.
Did you know about this or is this the reason this routine is listed as Not Stable?
Well that's no good. Could you post some (non)functional code to reproduce the error?
I must warn you, though, that this may possibly be just a limitation of the algorithm itself.
EDIT: And no, "Not Stable" doesn't mean it occasionally fails. heh. Stable and unstable refer to how the algorithm handles duplicate keys. Stable algorithms retain the original order, while unstable ones may shuffle them around. This doesn't matter for single-dimension arrays.
Last edited by Ellis Dee; May 11th, 2008 at 05:28 PM.
I hate saying this, but that's a feature, not a bug. (Okay, I actually love saying that.)
This happens to be the worst-case scenario for quicksort, where it performs on par with bubble sort. And since it uses recursion, it's unsurprising that it runs out of stack space. (Incidentally, when it comes to stack space, I'm not sure it matters how much memory you have.)
For a graphical representation of what's happening, run this project and select "thatched" order on the toolbar. (I replaced the thatched order with your order.) Have it sort and it becomes clear what's happening.
The worst case scenario I coded for quicksort is called "Camel Hump." Try that order as well for comparison. To really get the effect, isolate quicksort by clicking it and clicking filter on the toolbar.
Note that I implemented yoru sort order as a quickie hack, so it messes up the line definitions a little. Correct them by changing the filter.
It's worth pointing out that QuickSort3 (median of 3 partition technique) is much better at handling these worst case scenarios. It ends up being roughly quivalent to heap sort, but median of 3 technique has its own unique worst case stack killers.
This weakness is why heap sort is so popular for mission critical implementations. Unlike quicksort, heap sort doesn't have a worst case scenario where it degenerates into exponential iterations.
Last edited by Ellis Dee; May 11th, 2008 at 11:03 PM.
Also note that as far as I can tell, the absolute best all-purpose sorting algorithm when it comes to reliability, scalability, and efficiency is smooth sort. Sadly, I need help debugging the algorithm, and would dearly love any help you could give. (The code is in basGraphical.bas.)
If you can afford the expense of spending 2.5 times the memory of the original array, snake sort is the best comparison algorithm I've seen.
Last edited by Ellis Dee; May 12th, 2008 at 11:27 AM.