# VBForums CodeBank > CodeBank - Visual Basic 6 and earlier >  VB6: Sorting algorithms (sort array, sorting arrays)

## Ellis Dee

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.


*Sort Name.........Stable..InPlace..Online..Recursive..Grade
----------------..------..-------..------..---------..-----
Bubble sort.......Yes.....Yes......No......No.........D-
Cocktail sort.....Yes.....Yes......No......No.........D-
Comb sort.........No......Yes......No......No.........B+
Gnome sort........Yes.....Yes......No......No.........C-
Heap sort.........No......Yes......No......No.........A-
Insertion sort....Yes.....Yes......Yes.....No.........C
JSort.............No......Yes......No......No.........C+
Jump sort.........No......Yes......No......No.........B-
Linked List sort..No......No.......Yes.....No.........C-
Merge sort........Yes.....No.......No......Yes........A-
Quick sort........No......Yes......No......Yes........A
Quicksort3........No......Yes......No......Yes........A+
Selection sort....No......Yes......No......No.........C-
Shaker sort.......Yes.....Yes......No......No.........B
Shear sort........No......Yes......No......No.........D
Shell sort........No......Yes......No......No.........B+
Smooth sort.......No......Yes......No......No.........A-
Snake sort........No......No.......No......No.........A*

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:

```
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.

----------


## Ellis Dee

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

----------


## Ellis Dee

*Bubble sort*

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

----------


## Ellis Dee

*Cocktail sort*

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

----------


## Ellis Dee

*Comb sort*

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

----------


## Ellis Dee

*Gnome sort*

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

----------


## Ellis Dee

*Heap sort*

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

----------


## Ellis Dee

*Insertion sort*

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

----------


## Ellis Dee

*JSort*

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)

----------


## Ellis Dee

*Jump sort* (written by Code Doc)

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

----------


## Ellis Dee

*Linked List sort*

Stable: No
In-Place: No
Online: Yes
Recursive: No
Grade: C-

(writeup and code not currently available)

----------


## Ellis Dee

*Merge sort*

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
                varSwap = pvarArray(plngLeft)
                pvarArray(plngLeft) = pvarArray(plngRight)
                pvarArray(plngRight) = varSwap
            End If
        Case Else
            lngMid = lngMid \ 2 + plngLeft
            MergeSort1 pvarArray, pvarMirror, plngLeft, lngMid
            MergeSort1 pvarArray, pvarMirror, lngMid + 1, plngRight
            ' Merge the resulting halves
            L = plngLeft ' start of first (left) half
            R = lngMid + 1 ' start of second (right) half
            O = plngLeft ' start of output (mirror array)
            Do
                If pvarArray(R) < pvarArray(L) Then
                    pvarMirror(O) = pvarArray(R)
                    R = R + 1
                    If R > plngRight Then
                        For L = L To lngMid
                            O = O + 1
                            pvarMirror(O) = pvarArray(L)
                        Next
                        Exit Do
                    End If
                Else
                    pvarMirror(O) = pvarArray(L)
                    L = L + 1
                    If L > lngMid Then
                        For R = R To plngRight
                            O = O + 1
                            pvarMirror(O) = pvarArray(R)
                        Next
                        Exit Do
                    End If
                End If
                O = O + 1
            Loop
            For O = plngLeft To plngRight
                pvarArray(O) = pvarMirror(O)
            Next
    End Select
End Sub

----------


## Ellis Dee

*Quick sort*

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

----------


## Ellis Dee

*Quicksort3*

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

----------


## Ellis Dee

*Selection sort*

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

----------


## Ellis Dee

*Shaker sort*

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

----------


## Ellis Dee

*Shear sort*

Stable: No
In-Place: Yes
Online: No
Recursive: No
Grade: D

(no writeup available)
vb 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
    
'    GnomeSort pvarArray ' Because I'm too lazy to debug the algorithm
End Function
 Private Sub ShearPart1(ByRef pvarArray As Variant, ByVal Lo As Long, ByVal Hi As Long, ByVal Nx As Long, ByVal Up As Boolean)
    Dim t As Long
    Dim j As Long
    Dim varSwap As Variant
    
    j = Lo
    If Up Then
        Do While j + Nx < Hi
            If pvarArray(j) > pvarArray(j + Nx) Then
                varSwap = pvarArray(j)
                pvarArray(j) = pvarArray(j + Nx)
                pvarArray(j + Nx) = varSwap
            End If
            j = j + 2 * Nx
        Loop
    Else
        Do While j + Nx < Hi
            If pvarArray(j) < pvarArray(j + Nx) Then
                varSwap = pvarArray(j)
                pvarArray(j) = pvarArray(j + Nx)
                pvarArray(j + Nx) = varSwap
            End If
            j = j + 2 * Nx
        Loop
    End If
End Sub
 Private Sub ShearPart2(ByRef pvarArray 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
    Dim varSwap As Variant
    
    j = Lo + Nx
    If Up Then
        Do While j + Nx < Hi
            If pvarArray(j) > pvarArray(j + Nx) Then
                varSwap = pvarArray(j)
                pvarArray(j) = pvarArray(j + Nx)
                pvarArray(j + Nx) = varSwap
            End If
            j = j + 2 * Nx
        Loop
    Else
        Do While j + Nx < Hi
            If pvarArray(j) < pvarArray(j + Nx) Then
                varSwap = pvarArray(j)
                pvarArray(j) = pvarArray(j + Nx)
                pvarArray(j + Nx) = varSwap
            End If
            j = j + 2 * Nx
        Loop
    End If
End Sub

----------


## Ellis Dee

*Shell sort*

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

----------


## Ellis Dee

*Smooth sort*

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

----------


## Ellis Dee

*Snake Sort*

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
    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

----------


## Merri

Did something just because I thought it looks cool. Not fast, but cool:


```
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
```



```
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
```

----------


## Ellis Dee

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_.

----------


## Ellis Dee

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.)

```
----------------------
|   Copy to Mirror   |
----------------------
(0)=73...Level(0)=0
(1)=69
(2)=49
(3)=15...Level(1)=-3
(4)=91
(5)=1...Level(2)=-5
(6)=47
(7)=23...Level(3)=-7
(8)=53
(9)=13...Level(4)=-9
(10)=81
(11)=79
(12)=55...Level(5)=-12
(13)=57
(14)=9...Level(6)=-14
(15)=31
(16)=39...Level(7)=16
(17)=7
(18)=33
(19)=63
(20)=97...Level(8)=20
(21)=83
(22)=11...Level(9)=-22
(23)=25
(24)=59
(25)=89...Level(10)=25
(26)=35
(27)=37
(28)=67...Level(11)=28
(29)=3
(30)=21...Level(12)=30
(31)=17
(32)=75...Level(13)=32
(33)=61
(34)=51...Level(14)=-34
(35)=71
(36)=29
(37)=27
(38)=5...Level(15)=-38
(39)=85
(40)=87...Level(16)=40
(41)=41
(42)=95...Level(17)=42
(43)=77
(44)=43...Level(18)=-44
(45)=45
(46)=99...Level(19)=46
(47)=19
(48)=93...Level(20)=48
(49)=65...Level(21)=49
----------------------
|  Copy to Original  |
----------------------
(0)=1...Level(0)=0
(1)=15
(2)=49
(3)=69
(4)=73
(5)=91...Level(1)=5
(6)=13
(7)=23
(8)=47
(9)=53...Level(2)=9
(10)=9
(11)=55
(12)=57
(13)=79
(14)=81...Level(3)=14
(15)=7
(16)=31
(17)=33
(18)=39
(19)=63
(20)=97...Level(4)=20
(21)=11
(22)=25
(23)=59
(24)=83
(25)=89...Level(5)=25
(26)=3
(27)=21
(28)=35
(29)=37
(30)=67...Level(6)=30
(31)=17
(32)=51
(33)=61
(34)=75...Level(7)=34
(35)=5
(36)=27
(37)=29
(38)=71
(39)=85
(40)=87...Level(8)=40
(41)=41
(42)=43
(43)=77
(44)=95...Level(9)=44
(45)=19
(46)=45
(47)=93
(48)=99...Level(10)=48
(49)=65...Level(11)=49
----------------------
|   Copy to Mirror   |
----------------------
(0)=1...Level(0)=0
(1)=13
(2)=15
(3)=23
(4)=47
(5)=49
(6)=53
(7)=69
(8)=73
(9)=91...Level(1)=9
(10)=7
(11)=9
(12)=31
(13)=33
(14)=39
(15)=55
(16)=57
(17)=63
(18)=79
(19)=81
(20)=97...Level(2)=20
(21)=3
(22)=11
(23)=21
(24)=25
(25)=35
(26)=37
(27)=59
(28)=67
(29)=83
(30)=89...Level(3)=30
(31)=5
(32)=17
(33)=27
(34)=29
(35)=51
(36)=61
(37)=71
(38)=75
(39)=85
(40)=87...Level(4)=40
(41)=19
(42)=41
(43)=43
(44)=45
(45)=77
(46)=93
(47)=95
(48)=99...Level(5)=48
(49)=65...Level(6)=49
----------------------
|  Copy to Original  |
----------------------
(0)=1...Level(0)=0
(1)=7
(2)=9
(3)=13
(4)=15
(5)=23
(6)=31
(7)=33
(8)=39
(9)=47
(10)=49
(11)=53
(12)=55
(13)=57
(14)=63
(15)=69
(16)=73
(17)=79
(18)=81
(19)=91
(20)=97...Level(1)=20
(21)=3
(22)=5
(23)=11
(24)=17
(25)=21
(26)=25
(27)=27
(28)=29
(29)=35
(30)=37
(31)=51
(32)=59
(33)=61
(34)=67
(35)=71
(36)=75
(37)=83
(38)=85
(39)=87
(40)=89...Level(2)=40
(41)=19
(42)=41
(43)=43
(44)=45
(45)=65
(46)=77
(47)=93
(48)=95
(49)=99...Level(3)=49
----------------------
|   Copy to Mirror   |
----------------------
(0)=1...Level(0)=0
(1)=3
(2)=5
(3)=7
(4)=9
(5)=11
(6)=13
(7)=15
(8)=17
(9)=21
(10)=23
(11)=25
(12)=27
(13)=29
(14)=31
(15)=33
(16)=35
(17)=37
(18)=39
(19)=47
(20)=49
(21)=51
(22)=53
(23)=55
(24)=57
(25)=59
(26)=61
(27)=63
(28)=67
(29)=69
(30)=71
(31)=73
(32)=75
(33)=79
(34)=81
(35)=83
(36)=85
(37)=87
(38)=89
(39)=91
(40)=97...Level(1)=40
(41)=19
(42)=41
(43)=43
(44)=45
(45)=65
(46)=77
(47)=93
(48)=95
(49)=99...Level(2)=49
----------------------
|  Copy to Original  |
----------------------
(0)=1
(1)=3
(2)=5
(3)=7
(4)=9
(5)=11
(6)=13
(7)=15
(8)=17
(9)=19
(10)=21
(11)=23
(12)=25
(13)=27
(14)=29
(15)=31
(16)=33
(17)=35
(18)=37
(19)=39
(20)=41
(21)=43
(22)=45
(23)=47
(24)=49
(25)=51
(26)=53
(27)=55
(28)=57
(29)=59
(30)=61
(31)=63
(32)=65
(33)=67
(34)=69
(35)=71
(36)=73
(37)=75
(38)=77
(39)=79
(40)=81
(41)=83
(42)=85
(43)=87
(44)=89
(45)=91
(46)=93
(47)=95
(48)=97
(49)=99
----------------------
|   Sort Complete    |
----------------------
```

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.)

----------


## Ellis Dee

```
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
```



```
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
```

----------


## Ellis Dee

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:

```
            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:

```
            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)

Descending:
Quicksort: 368
Snakesort: 100

Quicksort's worst case: (camel hump)
Quicksort: 884
Snakesort: 199

Snakesort's worst case: (thatched)
Quicksort: 408
Snakesort: 510

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.)

----------


## Merri

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.)

----------


## Ellis Dee

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%

5% unsorted - 10,000 elements
Snake sort: 0.122
Quick sort: 0.130 -7%

Snake sort would appear to be competitive with quick sort.

----------


## sunburnt

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 


```
#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.

----------


## AC_AC_AC187

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

----------


## Ellis Dee

> 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.

----------


## AC_AC_AC187

sorry about that, i followed a link from the forum and didn't realise i was in the codebank...

could you please help me out here

----------


## Ellis Dee

> sorry about that, i followed a link from the forum and didn't realise i was in the codebank...
> 
> could you please help me out here


It would appear that I already did last month. Ask any followup questions you have in that thread.

----------


## NeedSomeAnswers

The application no longer appears to be attached to the post !!??

----------


## swinster

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?

----------


## Milk

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. 

Horses for courses

----------


## randem

Ellis Dee,

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?

----------


## Ellis Dee

> Ellis Dee,
> 
> 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.

----------


## randem

Here ya go. Just press the command button to start... When it starts to sort the array, it will look not busy for a while then crash...

I am running 1.5ghz Intel, 2gb RAM with 1.5 gb free RAM and 47 gb free hard disk space

----------


## Ellis Dee

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.

----------


## Ellis Dee

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.

----------


## Ellis Dee

Never mind about debugging smooth sort; Doogle figured it out.

I could still use some help with Shear sort if anyone wants to hook me up.

----------


## cbrow

Hello Dee Ellis,
You do great work, I have been searching for a working implementation of smooth sort for a long time because I do not understand Dijkstra's pseudo code.  I hope to understand the sort now soon.

I think you are too hard on QuickSort.  I plan to do some maths and leap to the defence of QuickSort in the near future. :Smilie:  

In any case, I have done some VB coding of "In Place" (ie only needing O(logN) extra space), "Stable" sorting.  One is "In-Place Merge Sort", which I borrowed someone elses algorithm.  The other is "Stable Quick Sort", which I worked out myself but am sure that other people have done before me because the algorithm isn't all that novel.

The both perform well, but not as well as the original quick or merge sorts because maintaining stability without using O(n) extra storage is hard.

You can find them here:  http://www.codeproject.com/KB/recipe...QuickSort.aspx
Craig

----------


## Ellis Dee

Thanks for the link; that looks like a nice resource.


> I have been searching for a working implementation of smooth sort for a long time because I do not understand Dijkstra's pseudo code.  I hope to understand the sort now soon.


Tell me about it. I'm trying to rename all the variables to be more meaningful, and I have to admit it's slow going. It's helpful seeing the graphical representation of exactly what's going on, but even with that I find myself scratching my head a lot.

I think I'm going to go ahead and post the project as is and revamp the writeups just to get it out there. As I improve the program I'll update the attachments.

----------


## cbrow

I am working on understanding Smoothsort.  I understand q, b, c, R and r2 variables.  I am working on the p variable.  I know what it does, I just don't know how!  It is some subtle mathematical thing.  I will post an explanation of how it works when I get there.

----------


## Ellis Dee

> I am working on understanding Smoothsort.  I understand q, b, c, R and r2 variables.  I am working on the p variable.  I know what it does, I just don't know how!  It is some subtle mathematical thing.  I will post an explanation of how it works when I get there.


Please do; any insight into what the variables are would be most appreciated.

----------


## Edgemeal

Is it possible to make Quick Sort (post #13) so it sorts in descending order?

----------


## anhn

> Is it possible to make Quick Sort (post #13) so it sorts in descending order?




```
Public Sub QuickRevSort(ByRef vArray As Variant, _
                        Optional ByVal Lower As Long = 0, _
                        Optional ByVal Upper As Long = -1)
    Dim iFirst As Long, iLast As Long
    Dim vMiddle As Variant, vTemp As Variant
    
    If Lower = 0 And Upper = -1 Then
        Lower = LBound(vArray)
        Upper = UBound(vArray)
    End If
    If Lower >= Upper Then Exit Sub
    iFirst = Lower
    iLast = Upper
    vMiddle = vArray((Lower + Upper) \ 2)
    Do
        Do While vArray(iFirst) > vMiddle And iFirst < Upper
            iFirst = iFirst + 1
        Loop
        Do While vMiddle > vArray(iLast) And iLast > Lower
            iLast = iLast - 1
        Loop
        If iFirst <= iLast Then
            vTemp = vArray(iFirst)
            vArray(iFirst) = vArray(iLast)
            vArray(iLast) = vTemp
            iFirst = iFirst + 1
            iLast = iLast - 1
        End If
    Loop Until iFirst > iLast
    If Lower < iLast Then QuickRevSort vArray, Lower, iLast
    If iFirst < Upper Then QuickRevSort vArray, iFirst, Upper
End Sub
```

----------


## Ellis Dee

Knowing *anhn*, I'm going to just assume his code works flawlessly without bothering to test it. But there are other considerations when it comes to using one of these algorithms to sort descending. 

First and foremost is that quicksort is unstable. Any unstable algorithm will "shuffle" items with equal keys. Stable algorithms retain the original order of equal keys. Stable algorithms are nice for achieving multi-column sorts by simply re-running the algorithm on the different key. Say, for instance, you wanted to sort by State then by City. You could do the following:

MergeSort SomeArray, CityColumn
MergeSort SomeArray, StateColumn

Your array will now be sorted primarily by state, since that was the last pass. Within each state, the array will be sorted by City. If you tried to do the same thing with Quicksort, it would end up _only_ sorted by state; the cities would end up in an undefined order.

Because of this, I honestly don't see any point to ever coding a descending sort for an unstable algorithm. Because the only order achieved is a single primary key, you can always simply iterate the array in reverse to display results in descending order.

Even if I wanted to end up with a descending order for some reason, I would simple use an ArrayReverse() function to do it afterward. Reversing an array is quite simple and extremely fast, at least compared to sorting it. Here's the ArrayReverse() function:
vb Code:
Private Sub ArrayReverse(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 = 0 To (iMax - iMin) \ 2
        varSwap = pvarArray(iMin + i)
        pvarArray(iMin + i) = pvarArray(iMax - i)
        pvarArray(iMax - i) = varSwap
    Next
End Sub

----------


## anhn

> Knowing anhn, I'm going to just assume his code works flawlessly without bothering to test it. But there are other considerations when it comes to using one of these algorithms to sort descending. 
> 
> First and foremost is that quicksort is unstable.


Thanks for your trusting on me but becareful my codes sometimes "causes disasters" same as everyone else's.

Actually, that is your code (sorry I didn't mention in the post). I did modify it last month from ascending to descending (took less than 2 minutes) to use in one of my project. To quickly answer Edgemeal's question particularly on QuickSort, I just copied and pasted there without comment.

About "unstable" and "stable" sort algorithms: Not many people know or care about this unless they have to work on more complicated array. 
The word "unstable" may cause misunderstanding and people may think the algorithm is "unreliable".

There is a disadvantage of QuickSort is it uses recursive calls, this may cause stack memory problem with large array in some particular orders.

----------


## Merri

Stable and unstable are confusing, coming back and forth having long periods in between I always forget what it is about in this context. So I'd suggest to use more descriptive words, or anything else than "stable". Most of the time it either tells me either "the code doesn't crash, it is very mature" or "place where you can find horses"  :Big Grin: 

Multidimension safe?

----------


## Ellis Dee

> There is a disadvantage of QuickSort is it uses recursive calls, this may cause stack memory problem with large array in some particular orders.


Yep, *randem* ran into that very issue back in post 36. Quicksort3 is much more reliable in avoiding stack overruns.

As for the stable vs unstable, the main point I was making is that I don't see any need to use a descending order for an unstable algorithm. For example, Let's say you want to populate a listbox descending instead of ascending using the standard ascending sort function:
vb Code:
QuickSort MyArray
ListBox1.Clear
For i = LBound(MyArray) To UBound(MyArray)
    If blnDescending Then
        ListBox1.AddItem 0
    Else
        ListBox1.AddItem
    End If
Next
That technique uses a quirk of ListBoxes that allows easy reversing of the order. For other uses, you can simply Step -1 backwards through the array to get descending order.

----------


## Ellis Dee

> Stable and unstable are confusing


Agreed, but Stability is the actual official term.

----------


## anhn

> *Quicksort3*
> 
> Stable: No
> In-Place: Yes
> Online: No
> Recursive: No
> Grade: A+


Ellis, one question: That says "Recursive: No" but actually the code uses recursive calls?


```
Private Sub MedianThreeQuickSort1(ByRef pvarArray As Variant, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
    ... ...
    If plngLeft < lngLast Then MedianThreeQuickSort1 pvarArray, plngLeft, lngLast
    If lngFirst < plngRight Then MedianThreeQuickSort1 pvarArray, lngFirst, plngRight
End Sub
```

----------


## Ellis Dee

My bad. I fixed it.

----------


## cbrow

Hello All,
I have finally worked out how SmoothSort works in detail.  I have attached a documented version to this post.
Craig

----------


## Ellis Dee

Dude, seriously, that's the greatest explanation ever. Mad props to you.

Did you do this for school, or just personal edification?

----------


## cbrow

I did it for personal edification.  But mostly because I didn't know what I was getting in to.  I am now working on a defence of QuickSort and then a commentary on SnakeSort.

----------


## Ellis Dee

Cool. And welcome to the boards.

----------


## Edgemeal

> Even if I wanted to end up with a descending order for some reason, I would simple use an ArrayReverse() function to do it afterward. Reversing an array is quite simple and extremely fast, at least compared to sorting it. Here's the ArrayReverse() function:


Yes I thought about using the ArrayReverse routine (already had it thanks) but didn't expect it to be so fast, I just started testing some sorting options.  

I was playing around with the grade B and better algorithms with a string array. When the string array has numbers instead of characters none of the algorithms sorted the numbers correctly (logical order) except MedianThreeQuickSort1, but it errors when the string array passed to it is characters. 

I have a sort (posted by MrMac? in the vb6 forum) that can do both alpha and numeric correctly but its so sloooow compared to these QuickSorts!

btw, *Thanks anhn*, hope you didn't go through too much trouble.

----------


## Ellis Dee

> I was playing around with the grade B and better algorithms with a string array. When the string array has numbers instead of characters none of the algorithms sorted the numbers correctly (logical order) except MedianThreeQuickSort1, but it errors when the string array passed to it is characters.


Strings are different from numbers. For example, "123" comes before "20" in a string sort. This is as it should be.

What do you mean that Quicksort3 errors on characters? As a guess, if you are running into case issues, you have to remember to put Option Compare Text at the top of the module where any of the listed sorting algorithms reside.

----------


## Edgemeal

> What do you mean that Quicksort3 errors on characters? As a guess, if you are running into case issues, you have to remember to put Option Compare Text at the top of the module where any of the listed sorting algorithms reside.


Just to make it more clear, here is a test I did,

Module1.bas with a Public Sub MedianThreeQuickSort1 in it. (a.k.a. Quicksort3 POST #14).


```
Option Compare Text
Public mList(0 To 2) As String
```

Form Code, sort error,


```
    mList(0) = "C"
    mList(1) = "B"
    mList(2) = "A"
    MedianThreeQuickSort1 mList ' Error Type Mismatch see *  below
    Debug.Print mList(0) ' Returns C 

' * If I change lngMid to a Variant it doesn't error.
```


Form Code, no errors,


```
    mList(0) = "120"
    mList(1) = "12"
    mList(2) = "119"
    MedianThreeQuickSort1 mList ' no errors returned
    Debug.Print mList(0) ' Returns 12
```

----------


## Ellis Dee

> ' * If I change lngMid to a Variant it doesn't error.


That is indeed the fix. I have edited the code posted to reflect this fix, as well as changed the function prototype to Public.

Thanks much for the bug report. It's always nice when the bug report includes the fix, so thanks for that as well.

----------


## Edgemeal

> That is indeed the fix. I have edited the code posted to reflect this fix, as well as changed the function prototype to Public.


I may just keep a copy of the original Quicksort3 for sorting string arrays that contain only numbers since it sorts logically and seems pretty fast, unless there is a better/faster way to accomplish that task? Thanks.

----------


## Ellis Dee

> I may just keep a copy of the original Quicksort3 for sorting string arrays that contain only numbers since it sorts logically and seems pretty fast, unless there is a better/faster way to accomplish that task? Thanks.


I'm not aware of any finished solution for sorting that way. Basically, every comparison would require checking the Val() value before comparing the strings directly. 

Maybe a mirror array holding the Val()s would be the most efficient approach, where you compare the mirror array values first, and if they're equal then compare the actual array values.

----------


## Edgemeal

> I'm not aware of any finished solution for sorting that way. Basically, every comparison would require checking the Val() value before comparing the strings directly.


Ya thats what I figured, I made a few changes to Quick Sort(#13) to do numbers and it seems to be a hair faster then the original Quicksort3. Good enough,Thanks.

----------


## anhn

Ellis, I have a very minor suggestion:

Due to VB6 allows negative index for array such as: Dim myArray(-10, 0) As Long

This may come up with a call later such as: MedianThreeQuickSort1 myArray, -7, 0
or QuickSort myArray, -7, 0

In this case plngLeft and plngRight will be reset to LBound()=-10 and UBound()=0.

To avoid that, as in post#47, I suggest to give plngLeft a default value of 0 and plngRight a default value of -1.
Then you can test: If plngLeft > plngRight Then ... instead of: If plngRight = 0 Then ...

----------


## cbrow

QuickSort often gets a bad rap from people because in its worst case, it could take N squared operations to sort N elements.  This fear is entirely undeserved because in practice, a good implementation of QuickSort just isnt going to do it.  For example, if 1024 elements are being sorted, the probability of achieving the worst case scenario is:

P(worst case) = 2/1024 * 2/512 * 2/512 * 2/256 * 2/256 * 2/256 * 2/256 * 2/128
	= 2/1024 * (2/512)^2 * (2/256)^4 * (2/128)^8 * (2/64)^16 * (2/32)^32 * 
	= (2^-9)^1 * (2^-8)^2 * (2^-7)^4 * (2^-6)^8 * (2^-5)^16 * (2^-4)^32 * (2^-3)^64 * (2^-2)^128 * (2^-1)^256
	= 2^-9 * 2^-16 * 2^-28 * 2^-48 * 2^-80 * 2^-128 * 2^-192 * 2^-256 * 2^-256
	= 2^(-9-16-28-48-80-128-192-256-256)
	= 2^(-1013)

The probability of this is so low that if every computer on Earth was sorting using quicksort until the universe ends, it is still unlikely to happen.  This is staggeringly unlikely.

But this is only the worst case, there are still a lot of very-bad-cases.  The mathematics of this is beyond me but it is not too difficult to simulate the performance of QuickSort.  I wrote a simulator and simulated sorting 128, 1024 and 65536 elements, 150,000 times each.  This is a graph of the results:



When sorting 65536 elements, Quicksort performs an average of 1,420,143 comparisons.  After doing 150,000 sorts, the best performance was 92% of the average while the worst performance was 120% of the average.  

From the simulated numbers, I estimate that the chances of Quicksort taking more than 10% more than the average to be <0.005, more than 15% than the average to be <0.0003 and more than 20% more than the average to be <0.000007.  If you wanted to guess the probability of Quicksort taking twice as long as its average case then you need to think about lots and lots more zeros in the probability.  At this point, you are still looking at performance of order NlogN.

If you refer back to the graph again, it is apparent that the more data that is being sorted, the narrower the range of performance. 

Another related problem for QuickSort is the exploding stack.  Once again, unexpected large usage of the stack is unlikely, but if your stack space is limited, you may have a problem.  There is a solution.

The exploding stack problem occurs when the partitions created by QuickSort are uneven and the stack fills up with details about lots of small partitions.  The solution is to put the larger partition on the stack first and process the smaller partition first.  This way, the stack contains details of large partition and there can not be many of these.  In this case, the worst case number of partitions on the stack is logN.

If the likelihood of a bad case of QuickSort is so extreme, why have many people experienced it?  The answer is that there are lots of bad ways to implement QuickSort.  The golden rule is that the choice of the pivot value must always, always, always be independent and uncorrelated to the data.  The best way to achieve this is to choose a random pivot.  Do this always, always, always.  

In addition, if your random number generator is predictable then your selection of the pivot is predictable and someone can engineer the worst case set of data  do not seed your random number generator in a predictable way if you are concerned about security.

With these thoughts in mind, the QuickSort routine in the application uses a poor method of choosing the pivot value.  As Dee acknowledges, this will perform poorly when the data has a camel-hump in the middle.  This will probably explode the stack with any reasonable amount of camel-hump data.

The MedianThreeQuickSort routine in the application is much much better.  It is a good implementation of QuickSort.  The random method of choosing the pivot value means that it is extremely unlikely that any given set of data will break it.  The likelihood of it being broken is staggeringly small.  The fact that this routine uses a median of three means that the pivot value is likely to be closer to the middle of the data, this actually speeds up the sort and makes it less likely to have a bad case.

The MedianThreeQuickSort routine could be improved by replacing the last two lines with:



```
If lngLast  plngLeft < plngRight  lngFirst Then
    If plngLeft < lngLast Then QuickSort plngArray, plngLeft, lngLast
    If lngFirst < plngRight Then QuickSort plngArray, lngFirst, plngRight
Else
    If lngFirst < plngRight Then QuickSort plngArray, lngFirst, plngRight
    If plngLeft < lngLast Then QuickSort plngArray, plngLeft, lngLast
End If
```

This will guarantee that the stack depth is never more than logN.

In summary, go ahead and use QuickSort.  It is fast.  Just make sure that you choose your pivot randomly.

----------


## Ellis Dee

> VB6 allows negative index for array


My head hurts just contemplating handling for this. I need to think about whether it's worth the added complexity, or if it's better in the long run to just ignore this ill-advised "feature".

Anything I do at the array level has to be implemented 54 times: 18 graphical algorithms, 18 one-dimensional algorithms, and 18 two-dimensional algorithms. So even minor changes tend to seem daunting.

----------


## Ellis Dee

> The MedianThreeQuickSort routine could be improved by replacing the last two lines with:
> 
> 
> 
> ```
> If lngLast  plngLeft < plngRight  lngFirst Then
>     If plngLeft < lngLast Then QuickSort plngArray, plngLeft, lngLast
>     If lngFirst < plngRight Then QuickSort plngArray, lngFirst, plngRight
> Else
> ...


Good suggestion. I implemented it in the posted code on the first page.

----------


## anhn

> My head hurts just contemplating handling for this. I need to think about whether it's worth the added complexity, or if it's better in the long run to just ignore this ill-advised "feature".


Oh!Oh! Forget about that if you think that is an "ill-advised", but that is a real thing I had to deal with in the past, so I just suggested. Never mind!

----------


## cbrow

Hello Ellis Dee,
I have looked at Snake Sort and like it.  I agree with what you say that it is about as fast as QuickSort on random data and much faster on sorted or partially sorted data.  Other people call this sort a "Natural Merge Sort" but your implementation is about as fast as they get on randomly ordered data.  It is possible to make it faster for partially sorted data but the added complexity will probably slow it when sorting random data.  

I wouldnt change it but there are a couple of things that are interesting to think about**:

1.  The buffer of ordered section details (lngIndex) only needs to be size logN.  There is an elegant way to merge the sections in a binary pattern to achieve the exact same result as you have.  It is marginally slower than your approach.

2.  Consider the scenario when you have a lot of data that has been previously processed and is therefore in order.  Then you get some new data added to the end that is not sorted.  Say you look for your ordered sections and get:
	Section 0:  1,000,000 elements in order
	Section 1:  2 elements in reverse order
	Section 2:  5 elements in order
	Section 3:  7 elements in reverse order.

The binary approach that SnakeSort uses (and my suggestion above) would merge sections 0 & 1 (cost 1,000,002), then sections 2 and 3 (cost 12) and then the two results for a total cost of (1,000,002 + 12 + 1,000,014) = 2,000,028 operations.

A smarter approach would be to merge sections 1 and 2 (cost 7), then merge this with secion 3 (cost 14) and then merge this with section 0 (cost 1,000,014).  The total cost of this is (7 + 14 + 1,000,014) = 1,000,035 operations.

It is most efficient to merge the smaller sections together first.

The problem is that these two ideas make the algorithm more complicated and therefore slower on random data.  Unless you can think of anything.

----------


## Ellis Dee

> I have looked at Snake Sort and like it.  I agree with what you say that it is about as fast as QuickSort on random data and much faster on sorted or partially sorted data.  Other people call this sort a "Natural Merge Sort"


Boooo. I thought I'd come up with an original idea, but googling does turn up references to and descriptions of natural mergesort, and it is indeed snake sort. Oh well.

Oddly, the only references I see to it are in messageboard discussions. There is no mention of this variation in the wikipedia entry for merge sort. (Wikipedia was my primary reference in this whole endeavor.) I also posted the snake sort algorithm along with a description on a heavily trafficked general interest board, claiming it as my own and asking if anyone had heard of anything similar. Nobody had; in fact, several people thought it was smooth sort. (ha!)

But after a day of mourning I'll go through and remove the self-credits in the Natural Mergesort algorithm, along with giving it its proper name. Again: Boooo!

As far as your points of consideration, particularly for an already-ordered list with new random elements. That situation calls for either an online algorithm like insertion sort or the unbelievably efficient smooth sort. That is what impresses me the most about smooth sort: it is an offline algorithm that handles "online data" as efficiently as any online algorithm. That's beyond impressive; it's pure genius.

I've also always been on the fence about what the term "nearly sorted" really means. If you use the utility attached to the OP and select "5% Shuffled", that techincally qualifies as "nearly sorted" because every element starts out near its final sorted position. And yet, this yields one of snake sort's worst performances, while smooth sort flies through it like greased lightning.

To really put it in perspective, select snake sort, smooth sort and insertion sort by clicking them, hit the Filter button and then the 5% Shuffled button. Watch smooth sort kick all kinds of ass. The higher your screen resolution the more obvious the difference will be. Even though this is Insertion sort's best case, smooth sort still wins.

----------


## Ellis Dee

> 2.  Consider the scenario when you have a lot of data that has been previously processed and is therefore in order.  Then you get some new data added to the end that is not sorted.  Say you look for your ordered sections and get:
> 	Section 0:  1,000,000 elements in order
> 	Section 1:  2 elements in reverse order
> 	Section 2:  5 elements in order
> 	Section 3:  7 elements in reverse order.


In the previous post I claimed that insertion sort or smooth sort would be the better choice for such a scenario, but I appear to be mistaken. To see it in action, change the following code from the OrderArray function in basGraphical.bas:

```
        Case oeWeave
            ShellSort1 plngArray
            For i = iMax To iMax - 5 Step -1
                plngArray(i) = Int((iMax - iMin + 1) * Rnd) + iMin
            Next
'            WeaveArray plngArray, iMin, iMax
```

To get the full effect you really need to filter so that each algorithm fills the entire vertical space of the screen. Note that Weave order is called Thatched in the tooltip balloons on the toolbar.

Crazy as this seems, after a quick glance it would appear that even changing it to be one single out-of-place element at the end of the array -- the very definition of what an online algorithm is supposed to excel at -- the order of fastest to slowest seems to go snake sort, smooth sort, insertion sort.

----------


## cbrow

Hello Ellis Dee,
I have looked at Shear Sort and have read up on it.  Don't expect this sort to work very fast because it is meant to run on N parallel processors.  In any case I have found the problem:

There are three for loops that look like:
        For j = 0 To Cols \ 2 - 1
or      For j = 0 To Rows \ 2 - 1

When rows or columns are odd, these numbers need to round up like:
        For j = 0 To CLng(Cols / 2) - 1
and      For j = 0 To CLng(Rows / 2) - 1

or      For j = 0 To (Cols + 1)  \ 2 - 1
or      For j = 0 To (Rows + 1) \ 2 - 1

The other thing is that this sort is especially bad if the number N is prime or if N has a large prime root.

Craig

----------


## Ellis Dee

> I have looked at Shear Sort [...] I have found the problem


Sweet, that looks like a winner.

I can't thank you enough for all your help.

----------


## cbrow

Sorry, Something bizarre is happening:
The CLng in:   For j = 0 To CLng(Cols / 2) - 1
is rounding down.

This form works though: For j = 0 To (Cols + 1) \ 2 - 1

----------


## Ellis Dee

> Sorry, Something bizarre is happening:
> The CLng in:   For j = 0 To CLng(Cols / 2) - 1
> is rounding down.
> 
> This form works though: For j = 0 To (Cols + 1) \ 2 - 1


That's the one I used anyway, since \ is significantly faster than /.

I just learned in another thread that Mod is slow, which is unfortunate for smooth sort. I'll be interested to see how it performs when I get the benchmark logic implemented.

----------


## cbrow

Hello Ellis,
Just looking at SmoothSort, the mods seem to be Mod 8, Mod 4 and Mod 2.

N Mod 8  is the same as  N And 7
N Mod 4  is the same as  N And 3
N Mod 2  is the same as  N And 1

Also if VB had bit-wise shift operators these are much faster than \ 2, \ 4 and \ 8.

The And operator is much faster.
Craig

----------


## Milk

At risk of drifting a little off topic, here's what I have found about *Mod* vs *And* in VB6.

Just to be clear *And* can be used in place of *Mod* when the divider is a power of 2.

In the IDE *And* is much quicker than *Mod* but when compiled with optimizations on it can appear to run at exactly the same speed. Further tinkering reveals that *And* is still much quicker but the compiler is clever enough to convert *N Mod Power2* into *N And (Power2-1)* if the divider is hard coded. This can be further shown by comparing *N Mod Power2* with *N Mod NotPower2* where the power2 version runs at 10x the speed. This only happens when the optimize for speed compile option is selected and where the divider is hard coded.

It's a real shame VB does not have bit shift operators, they are really useful. However... Again if optimize for speed is selected try comparing *N \ Power2* with *N \ Not Power2* with a variety of different numbers. *N \ Power2* works out 3x faster, so not as fast as a bit shift but something good is going on.

______________________________________________
Edit: Partly in reference to Merri's post below, as safearrays are at the core of this.

I while ago I started working on a UDT array sorter. It's still not ready (It's a back burner project) but I'm getting re-interested in it again. There's a tricky issue of sorting 8 byte datatypes in UDT's where the element size does not align to multiples of 8 but multiples of 4. All other types are quite easy as they always align thanks to the padding used. I've resolved the 8 byte issue by treating it as two arrays which are sorted separately and then recombined, it still needs a lot of tidying and optimising. At it's core are to be several different versions (one for every data type) of one of the algorithms here, at this stage it's just bubble sort (to keep it simple) but that will change. Not sure which one yet though, it seems like a toss up between Stability and Speed. 

These are the parameters as it stands

```
Public Function SortArrayX(ByVal ArrayPtr As Long, SortFieldElement As Variant, Optional Descending As Boolean = False) as boolean
```

I'm not super happy with this as the return of *VarPtrArray* has to be passed rather than the array itself, I can't think of any other way to do it. Thankfully it's fairly easy to check that it is a valid array structure and that the passed element does reside in arrays range so it should be safe to use. One of the bonuses of it is that it could in theory sort any one dimensional array (not sub type variant or object) UDT or not, and it should be quicker than a general algorithm that uses a variant to carry the array. Progress is slow for me as this is on the edge of my ability, but I take it this would be something of interest, yes?




> <snip>[*]Create a new identical header that changes to zero base (if I recall correctly you simply change one value!)


Yes, the array structure stores the lowerbound and the number of elements, the upperbound is calculated.

----------


## Merri

Ellis Dee: if you do some learning on SafeArrays, you could make your code only work on zero base simply by replacing the array's header with a zero based one during processing of the array. This would also speed up the processing of all sorting no matter what base the array is in. The problem is of course that you'd need to learn how to handle all the cases properly with the technique and how to do it in the first place, but once you get it you only need to account for one base in sorting code (the zero base), the safe array tricking should perfectly take care of all the negative and positive bases.

In short the code would work something like this:Read existing array headerCreate a new identical header that changes to zero base (if I recall correctly you simply change one value!)Replace the array's headerSorting code runs here, no need to check LBound because it is always zero and UBound returns the correct value!Restore the old header & clean up

Of course a bit of the stuff depends on how the sorting code is done in the first place, I didn't take a look into that.

----------


## Ellis Dee

> Not sure which one yet though, it seems like a toss up between Stability and Speed. 
> 
> These are the parameters as it stands
> 
> ```
> Public Function SortArrayX(ByVal ArrayPtr As Long, SortFieldElement As Variant, Optional Descending As Boolean = False) as boolean
> ```


Merge sort is both stable and fast, plus it has the bonus of having no worst case; it's always fast. And as I discussed upthread, if you're going to include a Descending option, you pretty much have to use a stable algorithm. (There is just no relevance to the direction of an unstable sort; ascending and descending don't matter. Just change the direction you iterate the array after sorting.) I really can't see using any other algorithm if your going to create a one-stop sorting function. The code sprawl is annoying, but whaddya gonna do?

A generic UDT array sorter would be one of the most impressive things I could imagine in VB6, but I'm not sure of the utility of it. I have in the past used sorted UDT arrays, but as comfortable as I am with sorting code, even I didn't physically sort the UDT array. Instead, I built two-dimensional variant index arrays and sorted those. That's pretty much always going to be faster than sorting a UDT directly, even if you write a specific sorting function devoted to that particular UDT.

----------


## Milk

Because sorting involves much swapping internally it sorts a long array of indexes which refer back to the original UDT. Comparisons are a little slower but it only needs to swap a 4 byte element instead of say a 54 byte element. Once the index array is sorted it then moves each of the UDT elements to their new positions, if descending is selected then this is just done back to front. Moving the elements at the end is relatively slow per move but each element only needs to be moved once. It has occurred to me that simply returning the index array could be more efficient and certainly quicker. Another function could be written which takes an index array and a pointer to a UDT array that could reorder the UDT if that is required.

I have other issues to look at first  :Smilie:  and bearing in mind I started playing with it 12 months ago it might not be finished so soon.

----------


## Ellis Dee

Yeah, that's a solid approach.

----------


## Floady

Ellis, just here to say, great work on this thread, real good to see you compare them and the new algorithms

also i can find myself in this statement:
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 love demo`s like these: and im gonna make one with all the algorithms in here ;p
http://www.cs.rit.edu/~atk/Java/Sorting/sorting.html

Greetz and keep it up!

----------


## oddperfect

```
Public Sub MedianThreeQuickSort1(ByRef pvarArray As Variant, Optional
...
        If plngLeft < lngLast Then MedianThreeQuickSort1 plngArray, plngLeft, lngLast
        If lngFirst < plngRight Then MedianThreeQuickSort1 plngArray, lngFirst, plngRight
    Else
        If lngFirst < plngRight Then MedianThreeQuickSort1 plngArray, lngFirst, plngRight
        If plngLeft < lngLast Then MedianThreeQuickSort1 plngArray, plngLeft, lngLast
```

A minor bug in this and related quicksort routines:

the recursive calls use "plngArray", which is undefined.  It should be pvarArray.

Except for this, thanks for the clean and quick code example.

----------


## Ellis Dee

Nice catch, thanks much.

----------


## saed

both QuickSort1 and QuickSort3 have the same speed: 10000 elements are sorted in 31 ms.
SnakeSort is a little bit slower: 10000 elements are sorted in about 80 ms

----------


## Ellis Dee

That's a small sample size; most algorithms will handle 10k pretty well.

----------


## Merri

I guess people may have a need for speed? Here is an optimized median three quicksort. Usage is only a little harder than when using Ellis Dee's functions:

QSort Not Not YourArrayVariable

The odd Not Not call is used to get the safe array header's pointer. This allows to avoid the use of Variant datatype so it is a requirement. VB6 does not allow declaring it's own procedures As Any so this is a workaround.


Supports following datatypes: Boolean, Byte, Currency, Date, Double, Integer, Long, Single & String.

Note that it uses countsort for Boolean, Byte & Integer. Also, Dates are sorted as Double (this should make no difference however, Dates are the same as Double, only a bit slower to access).

The module includes Ellis Dee's MedianThreeQuickSort1 for comparison.


*Edit!*
QSort is safe with negative arrays (Dim MyArray(-6 To 0) is not a problem). It modifies the array to zero base temporarily, which means the rest of the code does not need to account for negative indexes (QSort handles the array as Dim MyArray(0 To 6)).

----------


## Merri

Just to let you know I've also taken a look at Ellis Dee's SnakeSort. From what I can see I can't just go on and duplicate the behavior, the extra memory usage is too much imo. I think I can use a few tricks to reduce the memory requirements. I already know how to do it with lngIndex() with a very acceptable level of speed decrease.

The greater challenge is to limit the memory use of the mirror array. Whether my ideas work require a deeper look into how it all works. In general if you can reduce overall memory usage you also gain some speed, because all memory handling does slow things down. This is also why I guess SnakeSort seems to be so slow compared to QuickSort in timed benchmarks: the mirror array as it is currently does not do any good for how much stuff happens in memory. Especially strings will multiply the memory use much more than needs to happen thanks to new string allocations.

Note that I haven't yet taken any timed benchmarks of my own! I've mostly focused in getting things to work in the first place. I guess QSort could be optimized further. As QuickSort and SnakeSort seem to be the strongest competitors for the moment, I think they both need attention to get the speed & memory optimized solutions out so that better benchmarking can be done. The name I'll use for my own version of SnakeSort will be SSort. Just to keep it all nice & short  :Smilie:

----------


## Ellis Dee

Snake sort is actually a slightly modified Natural Merge Sort, so I'd just go with that name. It of course has the same memory-hogging pitfall of the standard Merge sort. I believe there are ways to reduce the memory overhead for merge sort, so one assumes that same optimization could be applied to the natural merge sort. I don't actually know what it is, but have seen it mentioned in passing.

I posted an explanation of exactly how it works in this thread over on the Straight Dope. That was before *cbrow* identified the algorithm as a Natural Merge Sort in this post, which also includes some ideas for making it more efficient.

----------


## Merri

In that case I'll name SnakeSort1 as NaturalMergeSort1 and use NSort as the short function name for optimized version. I'll also take a look at the efficiency post. I don't need to read the explaining post to understand how it works, I think I understand stuff via code much better. I'm not so good when it comes to talking about which algorithm is better and why, but I can tell when I see inefficiency and I sure can benchmark  :Smilie:  So here I'm trying to pick the ones that make sense to optimize for speed. For my own interest, for general good and for finding out how Natural Merge Sort can truly perform versus Quick Sort when both have been tweaked closer to the optimal performance.

Can you fix your posts here to use Natural Merge Sort instead of Snake Sort? (Of course it is a good idea to leave a note in the main function post that the name has been changed and why it has been done so.)

----------


## masheen

Hi guys i just need a quick help with bubble sort i got from this thread. can anyone help me simply this piece of code further? Is function will sort either asc or desc. Is there any other way to simply the code below? especially on the part marked in red.


vb Code:
Function Sort(ByRef str() As String, ByVal flag As Boolean) Dim iLower As Integer, iUpper As Integer, iCount As Integer, Temp As String Dim str2 As String        iUpper = UBound(str)       iLower = 1        Dim bSorted As Boolean       bSorted = False       Do While Not bSorted            bSorted = True            For iCount = iLower To iUpper - 1               [COLOR="Red"] If flag Then                    str2 = StrComp(str(iCount + 1), str(iCount), vbTextCompare)                Else                    str2 = StrComp(str(iCount), str(iCount + 1), vbTextCompare)                End If                     If str2 = 1 Then                           Temp = str(iCount + 1)                           str(iCount + 1) = str(iCount)                           str(iCount) = Temp                           bSorted = False                     End If[/COLOR]            Next iCount         iUpper = iUpper - 1       LoopEnd Function

----------


## Perry Miller

A Few More Sorts:

This is a String Sort I invented once. I call it PH91 (Pigeon Hole 91)
Fairly quick - comparable to Quick Sort in speed, but uses up a lot of stack space because it is recurrsive.
Could be unstable the same as Quicksort, if it runs out of stack space.

 It uses a method I haven't seen before. At least I don't know that I reinvented the wheel.
 Imagine several desks, each with 91 pigeon holes. Each pigeon hole is labeled  [ Space ] & punctuation, then 0-9, then A-Z caps, then a-z Lower case.

 You recieve an unsorted list in an Array.

 Take the items 1 at a time and place them in the pigeon holes based on their first character. Some holes will hold 0 items and some will hold multiple Items.
 When that is finished return to the first hole. proceed through the holes in order till you find the first hole that is filled. If it contains only 1 Item, then that item is finished sorting. place it in the final "sorted" stack to be returned by the rutine. If it contains more than 1 item, take the entire hole's contents to the desk #2 (Recurrsion).

 Going through the same steps as just outlined, pigeonhole these Items also, but placed in their holes according to the second character of the item. Again check the pigeonholes. All holes that contain single items are finished sorting. All holes that contain more that 1 Item, take to desk #3 (Recurrsion).

 New desks are created with each recurrsion till all items in the present desk are pigeonholed with only 1 item each hole. At this point there is no need to make a new desk and the present items now sorted may be returned to the former desk. Proceed through the remaining pigeonholes in this desk creating new desks as needed and returning the sorted results, until all pigeon holes in this desk have been processed. Return these sorted results to the formeer desk, and process the remaining pigeon holes. Return these sorted result to the former desk also. ect...

 Finally you will arrive at the inital desk with all items sorted.
 Since the  Array list is passed to the rutine ByRef, the original list is now sorted. The rutine now ends & the calling rutine can now use the sorted array.

 The rutine as it stands can crash if a word list contains a character asc value below 31 or above 122, but these chararcters are not normal text input, and if care is used not to accept these characters as input, then it's integrity is safe.

 Without a doubt some wizard will find a way to speed this up even more, but it's aleady very fast.
 Here it is.


```
 
Public Sub PH91(ByRef L$(), ByVal S&)
'Recursive
'Initial call with S = 1
Dim A$(), T$(), K&, P&, I&, J&, C&, B&(91), D&
Const Q& = 31

K& = UBound(B&):P& = UBound(L$):ReDim A$(K&, 0)
For I& = 0 To P&
    If S& <= Len(L$(I&)) Then
        J& = AscW(Mid$(L$(I&), S&, 1)) - Q&:D& = B&(J&)
        If D& > UBound(A$, 2) Then ReDim Preserve A$(K&, D&)
        A$(J&, D&) = L$(I&):B&(J&) = D& + 1
    Else
        L$(C&) = L$(I&): C& = C& + 1
    End If
Next I&

K& = UBound(A$, 1)
For I& = 1 To K&
    If B&(I&) Then
        If B&(I&) > 1 Then
            P& = B&(I&) - 1: ReDim T$(P&)
            For J& = 0 To P&
                T$(J&) = A$(I&, J&)
            Next J&
            S& = S& + 1:Call PH91(T$, S&):P& = UBound(T$)
            For J& = 0 To P&
                L$(C&) = T$(J&): C& = C& + 1
            Next J&
            S& = S& - 1
        Else
            L$(C&) = A$(I&, 0): C& = C& + 1
        End If
    End If
Next I&

End Sub
```



  A Binary Search is very fast. I wondered why nobody thought to write a Binary Sort. Maybe they exist but I don't see them listed in any list of fast sorts.

  I thought to experiment and write one .

  I made it so you recieve the unsorted list as an array. I thought then that the quickest way to sort this list was to create a new one (sorted), then return it.

  I used the Binary search method to find each word's new place in the sorted list,  but I couldn't figure out another way to create the new list except by insertion.

  Aaah!  Thats' why it has never turned up in a list of fast sorts. It does great on small lists. The search to find it's new place in the list is very fast even with lists of 1 million entrys.  BUT!  To insert that item in the new list is a big drag if you must use insertion. It's much faster though than a bubble sort. ( Not saying much there )

  I later saw some selection sort rutines, and they are similar in method though not quite the same. I suppose though this should be listed as another selection sort variation.

  Well here it is. It is non-recursive.



```
Private Sub BinSort(ByRef LST$())
Dim L$(), I&, J&, LT&, P&, A$, Q&, LP&, HP&

LT& = UBound(LST$)
ReDim L$(LT& + 1)
For I& = 0 To LT&
    A$ = LST(I&):LP& = 0:HP& = I&:P& = 0
    Do
        Q& = P&
        If A$ > L$(P&) Then
            LP& = P&
        ElseIf A$ < L$(P&) Then
            HP& = P&
        End If
        P& = Int((LP& + HP&) / 2)
    Loop While P& <> Q&
    If A$ > L$(P&) And L$(P&) <> "" Then P& = P& + 1
    If I& > P& Then
	'  ********* The Loop below here is the time killer ***********
        For J& = I& To P& Step -1
           L$(J& + 1) = L$(J&)
        Next J&
        DoEvents
    End If
    L$(P&) = A$
Next I&
Redim Preserve L$(LT&)
   LST$() = L$()

   End Sub
```


  This Insertion drag on the rutine is something that irritates me to no end.

  I thought why can't we chunk it up, then combine the chunks after each chunk is sorted?

  So I set about to write that too.

  This rutine is designed to write a long list with sorted chunks within it. It creates pointers to the beginning of each chunk, so that it can properly assemble them later into a final sorted list.

  If the initial list is under the established chunk size then the rutine sorts without chunking, but if over that threshold, it will chunk it up and feed it back into the rutine in smaller list sizes.

  I did a lot of experimenting with the chunk size along with various list sizes, then established the best chunk size as a constant.

  The Chunking rutine increased the speed of the sort 9 times faster on large lists ( 5000 - 100000 )

  I used the Binary Sort rutine listed above, but Chunking should increase the speed of any sort that uses the insertion method. It will not increase the speed of Quicksort, or Shellsort since they do not use the insertion method. The insertion method is slow because of chunk size and this should allieviate that bottleneck somewhat.

  It became longer than I wanted, and I suppose some Genius may be able to improve it as well.
  It is recursive, but it is not capable of compounded recersion, so it can be used on systems where stack space is limited.
  Here it is with the above Binary Sort included.


```
  
Private Sub ChunkSort(ByRef LST$())
Dim I&, J&, LS&, P&, A$, Q&, LP&, HP&
Dim L$(), SL$(), B&()
Const R& = 512  '******** The Chunk size is stored in a constant **********

LS& = UBound(LST$)::ReDim L$(LS& + 1)

'******** Below here is Chunking Rutine **********
If LS& > R& Then
    HP& = LS& \ R&:ReDim B&(HP&):ReDim SL$(R& - 1)
    Q& = R&
    For I& = 0 To LS& Step Q&
        If I& + Q& > LS& Then
            Q& = LS& - I& + 1: ReDim SL$(Q& - 1)
        End If
        For J& = 0 To Q& - 1
            SL$(J&) = LST$(I& + J&)
        Next J&
        ChunkSort SL$()
        For J& = 0 To Q& - 1
            L$(I& + J& + 1) = SL$(J&)
        Next J&
        B&(I& \ R&) = 0
    Next I&
    For I& = 1 To LS& + 1
        A$ = ""
        For J& = 0 To HP&
          If B&(J&) < R& Then
            P& = J& * R& + B&(J&) + 1
            If P& <= LS& + 1 Then
              If Trim(L(P&)) <> "" Then
                If L$(P&) < A$ Or A$ = "" Then
                    A$ = L$(P&): LP& = J&
                End If
              End If
            End If
          End If
        Next J&
        B&(LP&) = B&(LP&) + 1:LST$(I& - 1) = A$
	DoEvents
    Next I&
    Exit Sub
End If

'********Below is the Binary Sort Rutine **********
For I& = 0 To LS&
    A$ = LST(I&): LP& = 0:HP& = I&:: P& = 0
    Do
        Q& = P&
        If A$ > L$(P&) Then
            LP& = P&
        ElseIf A$ < L$(P&) Then
            HP& = P&
        End If
        P& = Int((LP& + HP&) / 2)
    Loop While P& <> Q&
    If A$ > L$(P&) And L$(P&) <> "" Then P& = P& + 1
    If I& > P& Then
        For J& = I& To P& Step -1
           L$(J& + 1) = L$(J&)
        Next J&
        DoEvents
    End If
    L$(P&) = A$
Next I&
ReDim Preserve L$(LS&)
LST$() = L$()

End Sub
```

----------


## Merri

> The rutine as it stands can crash if a word list contains a character asc value below 31 or above 122, but these chararcters are not normal text input, and if care is used not to accept these characters as input, then it's integrity is safe.


I don't visit here much at all anymore, but I have to drop in to say that statement above is far too ignorant. You'll run out of normal text input immediately when you start dealing with stuff like surnames. Take Müller or Selänne. In the internationalized world of today it is not safe to assume 91 characters to be enough for anything.

And in any case whatever code you write you better write it so that unexpected input doesn't crash it. There will always be unexpected input. Some people do unexpected input by purpose. They are called NSA.

----------


## Perry Miller

Merri;
Thanks for your input.
Of course it is not suitable for every application in it's present version, but see how easily it can be changed to allow for other input that would not normally be expected.
In the revision below to accept characters 0 - 255, I simply changed 1 array variable, and the constant.

B&(255), & Const Q& = 0

This is all it takes to allow more varied input, and there should be no crash on non-standard input.
There are some situations where the input is more controlable however, and where that is possible, and  
due care is taken, one could use a version which can be Optimized for your particular application.



```
Public Sub PH91(ByRef L$(), ByVal S&)
'Recursive
'Initial call with S = 1
Dim A$(), T$(), K&, P&, I&, J&, C&, B&(255), D&
Const Q& = 0

K& = UBound(B&):P& = UBound(L$):ReDim A$(K&, 0)
For I& = 0 To P&
    If S& <= Len(L$(I&)) Then
        J& = AscW(Mid$(L$(I&), S&, 1)) - Q&:D& = B&(J&)
        If D& > UBound(A$, 2) Then ReDim Preserve A$(K&, D&)
        A$(J&, D&) = L$(I&):B&(J&) = D& + 1
    Else
        L$(C&) = L$(I&): C& = C& + 1
    End If
Next I&

K& = UBound(A$, 1)
For I& = 1 To K&
    If B&(I&) Then
        If B&(I&) > 1 Then
            P& = B&(I&) - 1: ReDim T$(P&)
            For J& = 0 To P&
                T$(J&) = A$(I&, J&)
            Next J&
            S& = S& + 1:Call PH91(T$, S&):P& = UBound(T$)
            For J& = 0 To P&
                L$(C&) = T$(J&): C& = C& + 1
            Next J&
            S& = S& - 1
        Else
            L$(C&) = A$(I&, 0): C& = C& + 1
        End If
    End If
Next I&

End Sub
```




> I don't visit here much at all anymore, but I have to drop in to say that statement above is far too ignorant.


I can't plead Ignorance, I did think of it, but chose not to make it initially in the above variation, so I will admit that I am unaccomodating at times. Please accept my apology.

----------


## Thot

Fantastic thread Ellis Thank you!

Quick question, in Comb sort, why the line:
If lngGap = 10 Or lngGap = 9 Then lngGap = 11

Thanks

----------


## SFPKuba

I use VB as a macro of Excel 2016. 
I wrote one application to make a registry of people for my work purposes. After loading all the registered names into one array, I want them to get organized alphabetically. This sorting algorithm proved itself the most useful, simple and quick combined, comparing to the others Ive tested so far. However, there seems to be some logical bug that I just cant see: The names get sorted starting with "W..." continuing to "Z...." and only then it continues to "A..." 
Note: The list of names is about 1000 large, but increasing, and I count that in the end it may operate with approximately 30 000 registers.

----------


## chandan

what would be in the form window
can you post this selection sorting along with the form window

----------


## Shaggy Hiker

This thread was started almost 10 years ago. It's an interesting thread in that it has come back to life every year, or so, since inception. Normally, once a few months have passed, a form doesn't get revived, but this one has more lives than a cat.

Still, most of the people who participated in the thread have since moved on to new things. I'm not sure if any of them are still active. Therefore, i would be best to start a new thread with a new question, as that is more likely to get a good answer than hoping that somebody still follows this one....though in the case of this particular thread, you never know.

----------

