VB6: Sorting algorithms (sort array, sorting arrays)-VBForums
Page 1 of 3 123 LastLast
Results 1 to 40 of 96

Thread: VB6: Sorting algorithms (sort array, sorting arrays)

  1. #1

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    VB6: Sorting algorithms (sort array, sorting arrays)

    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:
    Code:
    Option Explicit
    Option Compare Text
    
    ' Omit plngLeft & plngRight; they are used internally during recursion
    Public Sub QuickSort(ByRef pvarArray As Variant, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
        Dim lngFirst As Long
        Dim lngLast As Long
        Dim varMid As Variant
        Dim varSwap As Variant
        
        If plngRight = 0 Then
            plngLeft = LBound(pvarArray)
            plngRight = UBound(pvarArray)
        End If
        lngFirst = plngLeft
        lngLast = plngRight
        varMid = pvarArray((plngLeft + plngRight) \ 2)
        Do
            Do While pvarArray(lngFirst) < varMid And lngFirst < plngRight
                lngFirst = lngFirst + 1
            Loop
            Do While varMid < pvarArray(lngLast) And lngLast > plngLeft
                lngLast = lngLast - 1
            Loop
            If lngFirst <= lngLast Then
                varSwap = pvarArray(lngFirst)
                pvarArray(lngFirst) = pvarArray(lngLast)
                pvarArray(lngLast) = varSwap
                lngFirst = lngFirst + 1
                lngLast = lngLast - 1
            End If
        Loop Until lngFirst > lngLast
        If plngLeft < lngLast Then QuickSort pvarArray, plngLeft, lngLast
        If lngFirst < plngRight Then QuickSort pvarArray, lngFirst, plngRight
    End Sub
    
    ' Simple binary search. Be sure array is sorted first.
    ' Returns index of first match, or -1 if no match found
    Public Function BinarySearch(pvarArray As Variant, pvarFind As Variant) As Long
        Dim lngFirst As Long
        Dim lngMid As Long
        Dim lngLast As Long
    
        BinarySearch = -1
        lngMid = -1
        lngFirst = LBound(pvarArray)
        lngLast = UBound(pvarArray)
        Do While lngFirst <= lngLast
            lngMid = (lngFirst + lngLast) \ 2
            If pvarArray(lngMid) > pvarFind Then
                lngLast = lngMid - 1
            ElseIf pvarArray(lngMid) < pvarFind Then
                lngFirst = lngMid + 1
            Else
                Exit Do
            End If
        Loop
        ' Make sure this is the first match in array
        Do While lngMid > lngFirst
            If pvarArray(lngMid - 1) <> pvarFind Then Exit Do
            lngMid = lngMid - 1
        Loop
        ' Set return value if match was found
        If pvarArray(lngMid) = pvarFind Then BinarySearch = lngMid
    End Function
    
    ' Knuth shuffle (very fast)
    Public Function ShuffleArray(pvarArray As Variant)
        Dim i As Long
        Dim iMin As Long
        Dim iMax As Long
        Dim lngReplace As Long
        Dim varSwap As Variant
        
        iMin = LBound(pvarArray)
        iMax = UBound(pvarArray)
        For i = iMax To iMin + 1 Step -1
            lngReplace = Int((i - iMin + 1) * Rnd + iMin)
            varSwap = pvarArray(i)
            pvarArray(i) = pvarArray(lngReplace)
            pvarArray(lngReplace) = varSwap
        Next
    End Function
    Attached is the current state of the sorting program. It is still a work in progress; it currently only does the graphical representation of the algorithms. Double-click an algorithm to see detailed information on it.
    Attached Files Attached Files
    Last edited by Ellis Dee; May 26th, 2008 at 04:02 PM.

  2. #2

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    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:
    1. ' Simple binary search. Be sure array is sorted first.
    2. ' Returns index of first match, or -1 if no match found
    3. Public Function BinarySearch1(pvarArray As Variant, pvarFind As Variant) As Long
    4.     Dim lngFirst As Long
    5.     Dim lngMid As Long
    6.     Dim lngLast As Long
    7.  
    8.     BinarySearch1 = -1
    9.     lngMid = -1
    10.     lngFirst = LBound(pvarArray)
    11.     lngLast = UBound(pvarArray)
    12.     Do While lngFirst <= lngLast
    13.         lngMid = (lngFirst + lngLast) \ 2
    14.         If pvarArray(lngMid) > pvarFind Then
    15.             lngLast = lngMid - 1
    16.         ElseIf pvarArray(lngMid) < pvarFind Then
    17.             lngFirst = lngMid + 1
    18.         Else
    19.             Exit Do
    20.         End If
    21.     Loop
    22.     ' Make sure this is the first match in array
    23.     Do While lngMid > lngFirst
    24.         If pvarArray(lngMid - 1) <> pvarFind Then Exit Do
    25.         lngMid = lngMid - 1
    26.     Loop
    27.     ' Set return value if match was found
    28.     If pvarArray(lngMid) = pvarFind Then BinarySearch1 = lngMid
    29. 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:
    1. ' Knuth shuffle (very fast)
    2. Public Function ShuffleArray1(pvarArray As Variant)
    3.     Dim i As Long
    4.     Dim iMin As Long
    5.     Dim iMax As Long
    6.     Dim lngReplace As Long
    7.     Dim varSwap As Variant
    8.    
    9.     iMin = LBound(pvarArray)
    10.     iMax = UBound(pvarArray)
    11.     For i = iMax To iMin + 1 Step -1
    12.         lngReplace = Int((i - iMin + 1) * Rnd + iMin)
    13.         varSwap = pvarArray(i)
    14.         pvarArray(i) = pvarArray(lngReplace)
    15.         pvarArray(lngReplace) = varSwap
    16.     Next
    17. End Function
    Last edited by Ellis Dee; May 20th, 2008 at 10:44 AM.

  3. #3

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    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:
    1. Public Sub BubbleSort1(ByRef pvarArray As Variant)
    2.     Dim i As Long
    3.     Dim iMin As Long
    4.     Dim iMax As Long
    5.     Dim varSwap As Variant
    6.     Dim blnSwapped As Boolean
    7.    
    8.     iMin = LBound(pvarArray)
    9.     iMax = UBound(pvarArray) - 1
    10.     Do
    11.         blnSwapped = False
    12.         For i = iMin To iMax
    13.             If pvarArray(i) > pvarArray(i + 1) Then
    14.                 varSwap = pvarArray(i)
    15.                 pvarArray(i) = pvarArray(i + 1)
    16.                 pvarArray(i + 1) = varSwap
    17.                 blnSwapped = True
    18.             End If
    19.         Next
    20.         iMax = iMax - 1
    21.     Loop Until Not blnSwapped
    22. End Sub
    Last edited by Ellis Dee; May 20th, 2008 at 11:10 AM.

  4. #4

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    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:
    1. Public Sub CocktailSort1(ByRef pvarArray As Variant)
    2.     Dim i As Long
    3.     Dim iMin As Long
    4.     Dim iMax As Long
    5.     Dim varSwap As Variant
    6.     Dim blnSwapped As Boolean
    7.    
    8.     iMin = LBound(pvarArray)
    9.     iMax = UBound(pvarArray) - 1
    10.     Do
    11.         blnSwapped = False
    12.         For i = iMin To iMax
    13.             If pvarArray(i) > pvarArray(i + 1) Then
    14.                 varSwap = pvarArray(i)
    15.                 pvarArray(i) = pvarArray(i + 1)
    16.                 pvarArray(i + 1) = varSwap
    17.                 blnSwapped = True
    18.             End If
    19.         Next
    20.         iMax = iMax - 1
    21.         If Not blnSwapped Then Exit Do
    22.         For i = iMax To iMin Step -1
    23.             If pvarArray(i) > pvarArray(i + 1) Then
    24.                 varSwap = pvarArray(i)
    25.                 pvarArray(i) = pvarArray(i + 1)
    26.                 pvarArray(i + 1) = varSwap
    27.                 blnSwapped = True
    28.             End If
    29.         Next
    30.         iMin = iMin + 1
    31.     Loop Until Not blnSwapped
    32. End Sub
    Last edited by Ellis Dee; May 20th, 2008 at 11:10 AM.

  5. #5

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    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:
    1. Public Sub CombSort1(ByRef pvarArray As Variant)
    2.     Const ShrinkFactor = 1.3
    3.     Dim lngGap As Long
    4.     Dim i As Long
    5.     Dim iMin As Long
    6.     Dim iMax As Long
    7.     Dim varSwap As Variant
    8.     Dim blnSwapped As Boolean
    9.    
    10.     iMin = LBound(pvarArray)
    11.     iMax = UBound(pvarArray)
    12.     lngGap = iMax - iMin + 1
    13.     Do
    14.         If lngGap > 1 Then
    15.             lngGap = Int(lngGap / ShrinkFactor)
    16.             If lngGap = 10 Or lngGap = 9 Then lngGap = 11
    17.         End If
    18.         blnSwapped = False
    19.         For i = iMin To iMax - lngGap
    20.             If pvarArray(i) > pvarArray(i + lngGap) Then
    21.                 varSwap = pvarArray(i)
    22.                 pvarArray(i) = pvarArray(i + lngGap)
    23.                 pvarArray(i + lngGap) = varSwap
    24.                 blnSwapped = True
    25.             End If
    26.         Next
    27.     Loop Until lngGap = 1 And Not blnSwapped
    28. End Sub
    Last edited by Ellis Dee; May 20th, 2008 at 11:13 AM.

  6. #6

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    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:
    1. Public Sub GnomeSort1(ByRef pvarArray As Variant)
    2.     Dim i As Long
    3.     Dim j As Long
    4.     Dim iMin As Long
    5.     Dim iMax As Long
    6.     Dim varSwap As Variant
    7.    
    8.     iMin = LBound(pvarArray) + 1
    9.     iMax = UBound(pvarArray)
    10.     i = iMin
    11.     j = i + 1
    12.     Do While i <= iMax
    13.         If pvarArray(i) < pvarArray(i - 1) Then
    14.             varSwap = pvarArray(i)
    15.             pvarArray(i) = pvarArray(i - 1)
    16.             pvarArray(i - 1) = varSwap
    17.             If i > iMin Then i = i - 1
    18.         Else
    19.             i = j
    20.             j = j + 1
    21.         End If
    22.     Loop
    23. End Sub
    Last edited by Ellis Dee; May 20th, 2008 at 11:14 AM.

  7. #7

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    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:
    1. Public Sub HeapSort1(ByRef pvarArray As Variant)
    2.     Dim i As Long
    3.     Dim iMin As Long
    4.     Dim iMax As Long
    5.     Dim varSwap As Variant
    6.    
    7.     iMin = LBound(pvarArray)
    8.     iMax = UBound(pvarArray)
    9.     For i = (iMax + iMin) \ 2 To iMin Step -1
    10.         Heap1 pvarArray, i, iMin, iMax
    11.     Next i
    12.     For i = iMax To iMin + 1 Step -1
    13.         varSwap = pvarArray(i)
    14.         pvarArray(i) = pvarArray(iMin)
    15.         pvarArray(iMin) = varSwap
    16.         Heap1 pvarArray, iMin, iMin, i - 1
    17.     Next i
    18. End Sub
    19.  
    20. Private Sub Heap1(ByRef pvarArray As Variant, ByVal i As Long, iMin As Long, iMax As Long)
    21.     Dim lngLeaf As Long
    22.     Dim varSwap As Variant
    23.    
    24.     Do
    25.         lngLeaf = i + i - (iMin - 1)
    26.         Select Case lngLeaf
    27.             Case Is > iMax: Exit Do
    28.             Case Is < iMax: If pvarArray(lngLeaf + 1) > pvarArray(lngLeaf) Then lngLeaf = lngLeaf + 1
    29.         End Select
    30.         If pvarArray(i) > pvarArray(lngLeaf) Then Exit Do
    31.         varSwap = pvarArray(i)
    32.         pvarArray(i) = pvarArray(lngLeaf)
    33.         pvarArray(lngLeaf) = varSwap
    34.         i = lngLeaf
    35.     Loop
    36. End Sub
    Last edited by Ellis Dee; May 20th, 2008 at 11:17 AM.

  8. #8

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    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:
    1. Public Sub InsertionSort1(ByRef pvarArray As Variant)
    2.     Dim i As Long
    3.     Dim j As Long
    4.     Dim iMin As Long
    5.     Dim iMax As Long
    6.     Dim varSwap As Variant
    7.    
    8.     iMin = LBound(pvarArray) + 1
    9.     iMax = UBound(pvarArray)
    10.     For i = iMin To iMax
    11.         varSwap = pvarArray(i)
    12.         For j = i To iMin Step -1
    13.             If varSwap < pvarArray(j - 1) Then pvarArray(j) = pvarArray(j - 1) Else Exit For
    14.         Next j
    15.         pvarArray(j) = varSwap
    16.     Next i
    17. End Sub
    Last edited by Ellis Dee; May 20th, 2008 at 11:18 AM.

  9. #9

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    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)
    Last edited by Ellis Dee; May 20th, 2008 at 12:56 PM.

  10. #10

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    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:
    1. Public Sub JumpSort1(ByRef pvarArray As Variant)
    2.     Dim lngJump As Long
    3.     Dim i As Long
    4.     Dim iMin As Long
    5.     Dim iMax As Long
    6.     Dim varSwap As Variant
    7.     Dim blnSwapped As Boolean
    8.    
    9.     iMin = LBound(pvarArray)
    10.     iMax = UBound(pvarArray)
    11.     lngJump = iMax - iMin
    12.     If lngJump < 2 Then lngJump = 2
    13.     Do
    14.         lngJump = lngJump \ 2
    15.         Do
    16.             blnSwapped = False
    17.             For i = iMin To iMax - lngJump
    18.                 If pvarArray(i) > pvarArray(i + lngJump) Then
    19.                     varSwap = pvarArray(i)
    20.                     pvarArray(i) = pvarArray(i + lngJump)
    21.                     pvarArray(i + lngJump) = varSwap
    22.                     blnSwapped = True
    23.                 End If
    24.             Next
    25.         Loop Until Not blnSwapped
    26.     Loop Until lngJump = 1
    27. End Sub
    Last edited by Ellis Dee; May 20th, 2008 at 12:53 PM.

  11. #11

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    Linked List sort

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

    (writeup and code not currently available)
    Last edited by Ellis Dee; May 20th, 2008 at 12:53 PM.

  12. #12

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    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:
    1. ' Omit pvarMirror, plngLeft & plngRight; they are used internally during recursion
    2. Public Sub MergeSort1(ByRef pvarArray As Variant, Optional pvarMirror As Variant, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
    3.     Dim lngMid As Long
    4.     Dim L As Long
    5.     Dim R As Long
    6.     Dim O As Long
    7.     Dim varSwap As Variant
    8.  
    9.     If plngRight = 0 Then
    10.         plngLeft = LBound(pvarArray)
    11.         plngRight = UBound(pvarArray)
    12.         ReDim pvarMirror(plngLeft To plngRight)
    13.     End If
    14.     lngMid = plngRight - plngLeft
    15.     Select Case lngMid
    16.         Case 0
    17.         Case 1
    18.             If pvarArray(plngLeft) > pvarArray(plngRight) Then
    19.                 varSwap = pvarArray(plngLeft)
    20.                 pvarArray(plngLeft) = pvarArray(plngRight)
    21.                 pvarArray(plngRight) = varSwap
    22.             End If
    23.         Case Else
    24.             lngMid = lngMid \ 2 + plngLeft
    25.             MergeSort1 pvarArray, pvarMirror, plngLeft, lngMid
    26.             MergeSort1 pvarArray, pvarMirror, lngMid + 1, plngRight
    27.             ' Merge the resulting halves
    28.             L = plngLeft ' start of first (left) half
    29.             R = lngMid + 1 ' start of second (right) half
    30.             O = plngLeft ' start of output (mirror array)
    31.             Do
    32.                 If pvarArray(R) < pvarArray(L) Then
    33.                     pvarMirror(O) = pvarArray(R)
    34.                     R = R + 1
    35.                     If R > plngRight Then
    36.                         For L = L To lngMid
    37.                             O = O + 1
    38.                             pvarMirror(O) = pvarArray(L)
    39.                         Next
    40.                         Exit Do
    41.                     End If
    42.                 Else
    43.                     pvarMirror(O) = pvarArray(L)
    44.                     L = L + 1
    45.                     If L > lngMid Then
    46.                         For R = R To plngRight
    47.                             O = O + 1
    48.                             pvarMirror(O) = pvarArray(R)
    49.                         Next
    50.                         Exit Do
    51.                     End If
    52.                 End If
    53.                 O = O + 1
    54.             Loop
    55.             For O = plngLeft To plngRight
    56.                 pvarArray(O) = pvarMirror(O)
    57.             Next
    58.     End Select
    59. End Sub
    Last edited by Ellis Dee; May 26th, 2008 at 04:01 PM.

  13. #13

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    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:
    1. ' Omit plngLeft & plngRight; they are used internally during recursion
    2. Public Sub QuickSort1(ByRef pvarArray As Variant, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
    3.     Dim lngFirst As Long
    4.     Dim lngLast As Long
    5.     Dim varMid As Variant
    6.     Dim varSwap As Variant
    7.    
    8.     If plngRight = 0 Then
    9.         plngLeft = LBound(pvarArray)
    10.         plngRight = UBound(pvarArray)
    11.     End If
    12.     lngFirst = plngLeft
    13.     lngLast = plngRight
    14.     varMid = pvarArray((plngLeft + plngRight) \ 2)
    15.     Do
    16.         Do While pvarArray(lngFirst) < varMid And lngFirst < plngRight
    17.             lngFirst = lngFirst + 1
    18.         Loop
    19.         Do While varMid < pvarArray(lngLast) And lngLast > plngLeft
    20.             lngLast = lngLast - 1
    21.         Loop
    22.         If lngFirst <= lngLast Then
    23.             varSwap = pvarArray(lngFirst)
    24.             pvarArray(lngFirst) = pvarArray(lngLast)
    25.             pvarArray(lngLast) = varSwap
    26.             lngFirst = lngFirst + 1
    27.             lngLast = lngLast - 1
    28.         End If
    29.     Loop Until lngFirst > lngLast
    30.     If plngLeft < lngLast Then QuickSort1 pvarArray, plngLeft, lngLast
    31.     If lngFirst < plngRight Then QuickSort1 pvarArray, lngFirst, plngRight
    32. End Sub
    Last edited by Ellis Dee; May 20th, 2008 at 12:37 PM.

  14. #14

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    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:
    1. ' Omit plngLeft & plngRight; they are used internally during recursion
    2. Public Sub MedianThreeQuickSort1(ByRef pvarArray As Variant, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
    3.     Dim lngFirst As Long
    4.     Dim lngLast As Long
    5.     Dim varMid As Variant
    6.     Dim lngIndex As Long
    7.     Dim varSwap As Variant
    8.     Dim a As Long
    9.     Dim b As Long
    10.     Dim c As Long
    11.    
    12.     If plngRight = 0 Then
    13.         plngLeft = LBound(pvarArray)
    14.         plngRight = UBound(pvarArray)
    15.     End If
    16.     lngFirst = plngLeft
    17.     lngLast = plngRight
    18.     lngIndex = plngRight - plngLeft + 1
    19.     a = Int(lngIndex * Rnd) + plngLeft
    20.     b = Int(lngIndex * Rnd) + plngLeft
    21.     c = Int(lngIndex * Rnd) + plngLeft
    22.     If pvarArray(a) <= pvarArray(b) And pvarArray(b) <= pvarArray(c) Then
    23.         lngIndex = b
    24.     Else
    25.         If pvarArray(b) <= pvarArray(a) And pvarArray(a) <= pvarArray(c) Then
    26.             lngIndex = a
    27.         Else
    28.             lngIndex = c
    29.         End If
    30.     End If
    31.     varMid = pvarArray(lngIndex)
    32.     Do
    33.         Do While pvarArray(lngFirst) < varMid And lngFirst < plngRight
    34.             lngFirst = lngFirst + 1
    35.         Loop
    36.         Do While varMid < pvarArray(lngLast) And lngLast > plngLeft
    37.             lngLast = lngLast - 1
    38.         Loop
    39.         If lngFirst <= lngLast Then
    40.             varSwap = pvarArray(lngFirst)
    41.             pvarArray(lngFirst) = pvarArray(lngLast)
    42.             pvarArray(lngLast) = varSwap
    43.             lngFirst = lngFirst + 1
    44.             lngLast = lngLast - 1
    45.         End If
    46.     Loop Until lngFirst > lngLast
    47.     If lngLast – plngLeft < plngRight – lngFirst Then
    48.         If plngLeft < lngLast Then MedianThreeQuickSort1 pvarArray, plngLeft, lngLast
    49.         If lngFirst < plngRight Then MedianThreeQuickSort1 pvarArray, lngFirst, plngRight
    50.     Else
    51.         If lngFirst < plngRight Then MedianThreeQuickSort1 pvarArray, lngFirst, plngRight
    52.         If plngLeft < lngLast Then MedianThreeQuickSort1 pvarArray, plngLeft, lngLast
    53.     End If
    54. End Sub
    Last edited by Ellis Dee; Sep 11th, 2009 at 07:15 AM.

  15. #15

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    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:
    1. Public Sub SelectionSort1(ByRef pvarArray As Variant)
    2.     Dim i As Long
    3.     Dim j As Long
    4.     Dim iMin As Long
    5.     Dim iMax As Long
    6.     Dim varSwap As Variant
    7.  
    8.     iMin = LBound(pvarArray)
    9.     iMax = UBound(pvarArray)
    10.     For i = iMin To iMax - 1
    11.         iMin = i
    12.         For j = (i + 1) To iMax
    13.             If pvarArray(j) < pvarArray(iMin) Then iMin = j
    14.         Next
    15.         varSwap = pvarArray(i)
    16.         pvarArray(i) = pvarArray(iMin)
    17.         pvarArray(iMin) = varSwap
    18.     Next
    19. End Sub
    Last edited by Ellis Dee; May 20th, 2008 at 12:17 PM.

  16. #16

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    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:
    1. Public Function ShakerSort1(ByRef pvarArray As Variant)
    2.     Dim i As Long
    3.     Dim j As Long
    4.     Dim k As Long
    5.     Dim iMin As Long
    6.     Dim iMax As Long
    7.     Dim varSwap As Variant
    8.     Dim blnSwapped As Boolean
    9.    
    10.     iMin = LBound(pvarArray)
    11.     iMax = UBound(pvarArray)
    12.     i = (iMax - iMin) \ 2 + iMin
    13.     Do While i > iMin
    14.         j = i
    15.         Do While j > iMin
    16.             For k = iMin To i - j
    17.                 If pvarArray(k) > pvarArray(k + j) Then
    18.                     varSwap = pvarArray(k)
    19.                     pvarArray(k) = pvarArray(k + j)
    20.                     pvarArray(k + j) = varSwap
    21.                 End If
    22.             Next
    23.             j = j \ 2
    24.         Loop
    25.         i = i \ 2
    26.     Loop
    27.     iMax = iMax - 1
    28.     Do
    29.         blnSwapped = False
    30.         For i = iMin To iMax
    31.             If pvarArray(i) > pvarArray(i + 1) Then
    32.                 varSwap = pvarArray(i)
    33.                 pvarArray(i) = pvarArray(i + 1)
    34.                 pvarArray(i + 1) = varSwap
    35.                 blnSwapped = True
    36.             End If
    37.         Next i
    38.         If blnSwapped Then
    39.             blnSwapped = False
    40.             iMax = iMax - 1
    41.             For i = iMax To iMin Step -1
    42.                 If pvarArray(i) > pvarArray(i + 1) Then
    43.                     varSwap = pvarArray(i)
    44.                     pvarArray(i) = pvarArray(i + 1)
    45.                     pvarArray(i + 1) = varSwap
    46.                     blnSwapped = True
    47.                 End If
    48.             Next i
    49.             iMin = iMin + 1
    50.         End If
    51.     Loop Until Not blnSwapped
    52. End Function
    Last edited by Ellis Dee; May 20th, 2008 at 12:16 PM.

  17. #17

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    Shear sort

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

    (no writeup available)
    vb Code:
    1. Public Function ShearSort1(ByRef pvarArray As Variant)
    2.     Dim Log As Long, Rows As Long, Cols As Long
    3.     Dim pow As Long, div As Long
    4.     Dim h() As Long
    5.     Dim i As Long, k As Long, j As Long
    6.     Dim LMax As Long, LMin As Long
    7.    
    8.     LMax = UBound(pvarArray) + 1
    9.     LMin = LBound(pvarArray)
    10.     pow = 1
    11.     div = 1
    12.     Do While i * i <= LMax
    13.         If i > 0 Then
    14.             If LMax Mod i = 0 Then div = i
    15.         Else
    16.             div = i
    17.         End If
    18.         i = i + 1
    19.     Loop
    20.     Rows = div
    21.     Cols = LMax \ div
    22.     Do While pow <= Rows
    23.         pow = pow * 2
    24.         Log = Log + 1
    25.     Loop
    26.     ReDim h(Rows)
    27.     For i = 0 To Rows
    28.         h(i) = i * Cols
    29.     Next i
    30.    
    31.     For k = 0 To Log - 1
    32.         For j = 0 To Cols \ 2 - 1
    33.             For i = 0 To Rows - 1
    34.                 ShearPart1 pvarArray, h(i), h(i + 1), 1, i Mod 2 = 0
    35.             Next i
    36.             For i = 0 To Rows - 1
    37.                 ShearPart2 pvarArray, h(i), h(i + 1), 1, i Mod 2 = 0
    38.             Next i
    39.         Next j
    40.         For j = 0 To Rows \ 2 - 1
    41.             For i = 0 To Cols - 1
    42.                 ShearPart1 pvarArray, i, Rows * Cols + i, Cols, True
    43.             Next i
    44.             For i = 0 To Cols - 1
    45.                 ShearPart2 pvarArray, i, Rows * Cols + i, Cols, True
    46.             Next i
    47.         Next j
    48.     Next k
    49.  
    50.     For j = 0 To Cols \ 2 - 1
    51.         For i = 0 To Rows - 1
    52.             ShearPart1 pvarArray, h(i), h(i + 1), 1, True
    53.         Next i
    54.         For i = 0 To Rows - 1
    55.             ShearPart2 pvarArray, h(i), h(i + 1), 1, True
    56.         Next i
    57.     Next j
    58.  
    59.     For i = 0 To Rows - 1
    60.         h(i) = -1
    61.     Next i
    62.    
    63. '    GnomeSort pvarArray ' Because I'm too lazy to debug the algorithm
    64. End Function
    65.  
    66. Private Sub ShearPart1(ByRef pvarArray As Variant, ByVal Lo As Long, ByVal Hi As Long, ByVal Nx As Long, ByVal Up As Boolean)
    67.     Dim t As Long
    68.     Dim j As Long
    69.     Dim varSwap As Variant
    70.    
    71.     j = Lo
    72.     If Up Then
    73.         Do While j + Nx < Hi
    74.             If pvarArray(j) > pvarArray(j + Nx) Then
    75.                 varSwap = pvarArray(j)
    76.                 pvarArray(j) = pvarArray(j + Nx)
    77.                 pvarArray(j + Nx) = varSwap
    78.             End If
    79.             j = j + 2 * Nx
    80.         Loop
    81.     Else
    82.         Do While j + Nx < Hi
    83.             If pvarArray(j) < pvarArray(j + Nx) Then
    84.                 varSwap = pvarArray(j)
    85.                 pvarArray(j) = pvarArray(j + Nx)
    86.                 pvarArray(j + Nx) = varSwap
    87.             End If
    88.             j = j + 2 * Nx
    89.         Loop
    90.     End If
    91. End Sub
    92.  
    93. Private Sub ShearPart2(ByRef pvarArray As Variant, ByVal Lo As Long, ByVal Hi As Long, ByVal Nx As Long, ByVal Up As Boolean)
    94.     Dim t As Variant
    95.     Dim j As Long
    96.     Dim varSwap As Variant
    97.    
    98.     j = Lo + Nx
    99.     If Up Then
    100.         Do While j + Nx < Hi
    101.             If pvarArray(j) > pvarArray(j + Nx) Then
    102.                 varSwap = pvarArray(j)
    103.                 pvarArray(j) = pvarArray(j + Nx)
    104.                 pvarArray(j + Nx) = varSwap
    105.             End If
    106.             j = j + 2 * Nx
    107.         Loop
    108.     Else
    109.         Do While j + Nx < Hi
    110.             If pvarArray(j) < pvarArray(j + Nx) Then
    111.                 varSwap = pvarArray(j)
    112.                 pvarArray(j) = pvarArray(j + Nx)
    113.                 pvarArray(j + Nx) = varSwap
    114.             End If
    115.             j = j + 2 * Nx
    116.         Loop
    117.     End If
    118. End Sub
    Last edited by Ellis Dee; May 20th, 2008 at 12:06 PM.

  18. #18

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    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:
    1. Public Sub ShellSort1(ByRef pvarArray As Variant)
    2.     Dim lngHold As Long
    3.     Dim lngGap As Long
    4.     Dim i As Long
    5.     Dim iMin As Long
    6.     Dim iMax As Long
    7.     Dim varSwap As Variant
    8.    
    9.     iMin = LBound(pvarArray)
    10.     iMax = UBound(pvarArray)
    11.     lngGap = iMin
    12.     Do
    13.         lngGap = 3 * lngGap + 1
    14.     Loop Until lngGap > iMax
    15.     Do
    16.         lngGap = lngGap \ 3
    17.         For i = lngGap + iMin To iMax
    18.             varSwap = pvarArray(i)
    19.             lngHold = i
    20.             Do While pvarArray(lngHold - lngGap) > varSwap
    21.                 pvarArray(lngHold) = pvarArray(lngHold - lngGap)
    22.                 lngHold = lngHold - lngGap
    23.                 If lngHold < iMin + lngGap Then Exit Do
    24.             Loop
    25.             pvarArray(lngHold) = varSwap
    26.         Next i
    27.     Loop Until lngGap = 1
    28. End Sub
    Last edited by Ellis Dee; May 26th, 2008 at 04:01 PM.

  19. #19

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    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:
    1. ' This code is not mine; converted from java code
    2. Public Sub SmoothSort1(ByRef pvarArray As Variant)
    3.     Dim q As Long
    4.     Dim R As Long
    5.     Dim p As Long
    6.     Dim b As Long
    7.     Dim c As Long
    8.     Dim temp As Long
    9.    
    10.     q = 1
    11.     p = 1
    12.     b = 1
    13.     c = 1
    14.     Do While q <> UBound(pvarArray) + 1
    15.         If p Mod 8 = 3 Then
    16.             SmoothSift pvarArray, R, b, c
    17.             p = (p + 1) \ 4
    18.             SmoothUp b, c
    19.             SmoothUp b, c
    20.         ElseIf p Mod 4 = 1 Then
    21.             If q + c < UBound(pvarArray) + 1 Then
    22.                 SmoothSift pvarArray, R, b, c
    23.             Else
    24.                 SmoothTrinkle pvarArray, R, p, b, c
    25.             End If
    26.             Do
    27.                 SmoothDown b, c
    28.                 p = p * 2
    29.             Loop While b <> 1
    30.             p = p + 1
    31.         End If
    32.         q = q + 1
    33.         R = R + 1
    34.     Loop
    35.     SmoothTrinkle pvarArray, R, p, b, c
    36.     Do While q <> 1
    37.         q = q - 1
    38.         If b = 1 Then
    39.             R = R - 1
    40.             p = p - 1
    41.             Do While p Mod 2 = 0
    42.                 p = p / 2
    43.                 SmoothUp b, c
    44.             Loop
    45.         ElseIf b >= 3 Then
    46.             p = p - 1
    47.             R = R + c - b
    48.             If p <> 0 Then SmoothSemiTrinkle pvarArray, R, p, b, c
    49.             SmoothDown b, c
    50.             p = p * 2 + 1
    51.             R = R + c
    52.             SmoothSemiTrinkle pvarArray, R, p, b, c
    53.             SmoothDown b, c
    54.             p = p * 2 + 1
    55.         End If
    56.     Loop
    57. End Sub
    58.  
    59. Private Sub SmoothUp(b As Long, c As Long)
    60.     Dim temp As Long
    61.    
    62.     temp = b + c + 1
    63.     c = b
    64.     b = temp
    65. End Sub
    66.  
    67. Private Sub SmoothDown(b As Long, c As Long)
    68.     Dim temp As Long
    69.    
    70.     temp = b - c - 1
    71.     b = c
    72.     c = temp
    73. End Sub
    74.  
    75. Private Sub SmoothSift(ByRef pvarArray As Variant, ByVal R As Long, ByVal b As Long, ByVal c As Long)
    76.     Dim r2 As Long
    77.     Dim varSwap As Variant
    78.    
    79.     Do While b >= 3
    80.         r2 = R - b + c
    81.         If pvarArray(r2) < pvarArray(R - 1) Then
    82.             r2 = R - 1
    83.             SmoothDown b, c
    84.         End If
    85.         If pvarArray(R) >= pvarArray(r2) Then
    86.             b = 1
    87.         Else
    88.             varSwap = pvarArray(R)
    89.             pvarArray(R) = pvarArray(r2)
    90.             pvarArray(r2) = varSwap
    91.             R = r2
    92.             SmoothDown b, c
    93.         End If
    94.     Loop
    95. End Sub
    96.  
    97. Private Sub SmoothTrinkle(pvarArray As Variant, ByVal R As Long, ByVal p As Long, ByVal b As Long, ByVal c As Long)
    98.     Dim r2 As Long
    99.     Dim r3 As Long
    100.     Dim varSwap As Variant
    101.    
    102.     Do While p > 0
    103.         Do While p Mod 2 = 0
    104.             p = p \ 2
    105.             SmoothUp b, c
    106.         Loop
    107.         r3 = R - b
    108.         If p = 1 Then
    109.             p = 0
    110.         ElseIf pvarArray(r3) <= pvarArray(R) Then
    111.             p = 0
    112.         Else
    113.             p = p - 1
    114.             If b = 1 Then
    115.                 varSwap = pvarArray(R)
    116.                 pvarArray(R) = pvarArray(r3)
    117.                 pvarArray(r3) = varSwap
    118.                 R = r3
    119.             ElseIf b >= 3 Then
    120.                 r2 = R - b + c
    121.                 If pvarArray(r2) < pvarArray(R - 1) Then
    122.                     r2 = R - 1
    123.                     SmoothDown b, c
    124.                     p = p * 2
    125.                 End If
    126.                 If pvarArray(r3) >= pvarArray(r2) Then
    127.                     varSwap = pvarArray(R)
    128.                     pvarArray(R) = pvarArray(r3)
    129.                     pvarArray(r3) = varSwap
    130.                     R = r3
    131.                 Else
    132.                     varSwap = pvarArray(R)
    133.                     pvarArray(R) = pvarArray(r2)
    134.                     pvarArray(r2) = varSwap
    135.                     R = r2
    136.                     SmoothDown b, c
    137.                     p = 0
    138.                 End If
    139.             End If
    140.         End If
    141.     Loop
    142.     SmoothSift pvarArray, R, b, c
    143. End Sub
    144.  
    145. Private Sub SmoothSemiTrinkle(pvarArray As Variant, ByVal R As Long, ByVal p As Long, ByVal b As Long, ByVal c As Long)
    146.     Dim r1 As Long
    147.     Dim varSwap As Variant
    148.    
    149.     r1 = R - c
    150.     If pvarArray(r1) > pvarArray(R) Then
    151.         varSwap = pvarArray(R)
    152.         pvarArray(R) = pvarArray(r1)
    153.         pvarArray(r1) = varSwap
    154.         SmoothTrinkle pvarArray, r1, p, b, c
    155.     End If
    156. End Sub
    Last edited by Ellis Dee; May 20th, 2008 at 12:07 PM.

  20. #20

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Sorting algorithms (sort array, sorting arrays)

    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:
    1. Public Sub SnakeSort1(ByRef pvarArray As Variant)
    2.     Dim i As Long
    3.     Dim iMin As Long
    4.     Dim iMax As Long
    5.     Dim lngIndex() As Long
    6.     Dim lngLevel As Long
    7.     Dim lngOldLevel As Long
    8.     Dim lngNewLevel As Long
    9.     Dim varMirror As Variant
    10.     Dim lngDirection As Long
    11.     Dim blnMirror As Boolean
    12.     Dim varSwap As Variant
    13.    
    14.     iMin = LBound(pvarArray)
    15.     iMax = UBound(pvarArray)
    16.     ReDim lngIndex((iMax - iMin + 3) \ 2)
    17.     lngIndex(0) = iMin
    18.     i = iMin
    19.     ' Initial loop: locate cutoffs for each ordered section
    20.     Do Until i >= iMax
    21.         Select Case lngDirection
    22.             Case 1
    23.                 Do Until i = iMax
    24.                     If pvarArray(i) > pvarArray(i + 1) Then Exit Do
    25.                     i = i + 1
    26.                 Loop
    27.             Case -1
    28.                 Do Until i = iMax
    29.                     If pvarArray(i) < pvarArray(i + 1) Then Exit Do
    30.                     i = i + 1
    31.                 Loop
    32.             Case Else
    33.                 Do Until i = iMax
    34.                     If pvarArray(i) <> pvarArray(i + 1) Then Exit Do
    35.                     i = i + 1
    36.                 Loop
    37.                 If i = iMax Then lngDirection = 1
    38.         End Select
    39.         If lngDirection = 0 Then
    40.             If pvarArray(i) > pvarArray(i + 1) Then
    41.                 lngDirection = -1
    42.             Else
    43.                 lngDirection = 1
    44.             End If
    45.         Else
    46.             lngLevel = lngLevel + 1
    47.             lngIndex(lngLevel) = i * lngDirection
    48.             lngDirection = 0
    49.         End If
    50.         i = i + 1
    51.     Loop
    52.     If Abs(lngIndex(lngLevel)) < iMax Then
    53.         If lngDirection = 0 Then lngDirection = 1
    54.         lngLevel = lngLevel + 1
    55.         lngIndex(lngLevel) = i * lngDirection
    56.     End If
    57.     ' If the list is already sorted, exit
    58.     If lngLevel <= 1 Then
    59.         ' If sorted descending, reverse before exiting
    60.         If lngIndex(lngLevel) < 0 Then
    61.             For i = 0 To (iMax - iMin) \ 2
    62.                 varSwap = pvarArray(iMin + i)
    63.                 pvarArray(iMin + i) = pvarArray(iMax - i)
    64.                 pvarArray(iMax - i) = varSwap
    65.             Next
    66.         End If
    67.         Exit Sub
    68.     End If
    69.     ' Main loop - merge section pairs together until only one section left
    70.     ReDim varMirror(iMin To iMax)
    71.     Do Until lngLevel = 1
    72.         lngOldLevel = lngLevel
    73.         For lngLevel = 1 To lngLevel - 1 Step 2
    74.             If blnMirror Then
    75.                 SnakeSortMerge varMirror, lngIndex(lngLevel - 1), lngIndex(lngLevel), lngIndex(lngLevel + 1), pvarArray
    76.             Else
    77.                 SnakeSortMerge pvarArray, lngIndex(lngLevel - 1), lngIndex(lngLevel), lngIndex(lngLevel + 1), varMirror
    78.             End If
    79.             lngNewLevel = lngNewLevel + 1
    80.             lngIndex(lngNewLevel) = Abs(lngIndex(lngLevel + 1))
    81.         Next
    82.         If lngOldLevel Mod 2 = 1 Then
    83.             If blnMirror Then
    84.                 For i = lngIndex(lngNewLevel) + 1 To iMax
    85.                     pvarArray(i) = varMirror(i)
    86.                 Next
    87.             Else
    88.                 For i = lngIndex(lngNewLevel) + 1 To iMax
    89.                     varMirror(i) = pvarArray(i)
    90.                 Next
    91.             End If
    92.             lngNewLevel = lngNewLevel + 1
    93.             lngIndex(lngNewLevel) = lngIndex(lngOldLevel)
    94.         End If
    95.         lngLevel = lngNewLevel
    96.         lngNewLevel = 0
    97.         blnMirror = Not blnMirror
    98.     Loop
    99.     ' Copy back to main array if necessary
    100.     If blnMirror Then
    101.         For i = iMin To iMax
    102.             pvarArray(i) = varMirror(i)
    103.         Next
    104.     End If
    105. End Sub
    106.  
    107. Private Sub SnakeSortMerge(pvarSource As Variant, plngLeft As Long, plngMid As Long, plngRight As Long, pvarDest As Variant)
    108.     Dim L As Long
    109.     Dim LMin As Long
    110.     Dim LMax As Long
    111.     Dim LStep As Long
    112.     Dim R As Long
    113.     Dim RMin As Long
    114.     Dim RMax As Long
    115.     Dim RStep As Long
    116.     Dim O As Long
    117.    
    118.     If plngLeft <> 0 Then O = Abs(plngLeft) + 1
    119.     If plngMid > 0 Then
    120.         LMin = O
    121.         LMax = Abs(plngMid)
    122.         LStep = 1
    123.     Else
    124.         LMin = Abs(plngMid)
    125.         LMax = O
    126.         LStep = -1
    127.     End If
    128.     If plngRight > 0 Then
    129.         RMin = Abs(plngMid) + 1
    130.         RMax = Abs(plngRight)
    131.         RStep = 1
    132.     Else
    133.         RMin = Abs(plngRight)
    134.         RMax = Abs(plngMid) + 1
    135.         RStep = -1
    136.     End If
    137.     L = LMin
    138.     R = RMin
    139.     Do
    140.         If pvarSource(L) <= pvarSource(R) Then
    141.             pvarDest(O) = pvarSource(L)
    142.             If L = LMax Then
    143.                 For R = R To RMax Step RStep
    144.                     O = O + 1
    145.                     pvarDest(O) = pvarSource(R)
    146.                 Next
    147.                 Exit Do
    148.             End If
    149.             L = L + LStep
    150.         Else
    151.             pvarDest(O) = pvarSource(R)
    152.             If R = RMax Then
    153.                 For L = L To LMax Step LStep
    154.                     O = O + 1
    155.                     pvarDest(O) = pvarSource(L)
    156.                 Next
    157.                 Exit Do
    158.             End If
    159.             R = R + RStep
    160.         End If
    161.         O = O + 1
    162.     Loop
    163. End Sub
    Last edited by Ellis Dee; May 20th, 2008 at 12:08 PM.

  21. #21
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: Sorting algorithms (sort array, sorting arrays) - UPDATED

    Did something just because I thought it looks cool. Not fast, but cool:
    Code:
    Public Function ShearSort1(ByRef pvarArray As Variant)
        Dim Log As Long, Rows As Long, Cols As Long
        Dim pow As Long, div As Long
        Dim h() As Long
        Dim i As Long, k As Long, j As Long
        
        Dim lMax As Long, lMin As Long
        lMax = UBound(pvarArray) + 1
        lMin = LBound(pvarArray)
        pow = 1
        div = 1
        Do While i * i <= lMax
            If i > 0 Then
                If lMax Mod i = 0 Then div = i
            Else
                div = i
            End If
            i = i + 1
        Loop
        Rows = div
        Cols = lMax \ div
        Do While pow <= Rows
            pow = pow * 2
            Log = Log + 1
        Loop
        ReDim h(Rows)
        For i = 0 To Rows
            h(i) = i * Cols
        Next i
        
        For k = 0 To Log - 1
            For j = 0 To Cols \ 2 - 1
                For i = 0 To Rows - 1
                    ShearPart1 pvarArray, h(i), h(i + 1), 1, i Mod 2 = 0
                Next i
                For i = 0 To Rows - 1
                    ShearPart2 pvarArray, h(i), h(i + 1), 1, i Mod 2 = 0
                Next i
            Next j
            For j = 0 To Rows \ 2 - 1
                For i = 0 To Cols - 1
                    ShearPart1 pvarArray, i, Rows * Cols + i, Cols, True
                Next i
                For i = 0 To Cols - 1
                    ShearPart2 pvarArray, i, Rows * Cols + i, Cols, True
                Next i
            Next j
        Next k
    
        For j = 0 To Cols \ 2 - 1
            For i = 0 To Rows - 1
                ShearPart1 pvarArray, h(i), h(i + 1), 1, True
            Next i
            For i = 0 To Rows - 1
                ShearPart2 pvarArray, h(i), h(i + 1), 1, True
            Next i
        Next j
    
        For i = 0 To Rows - 1
            h(i) = -1
        Next i
    End Function
    
    Private Sub ShearPart1(ByRef a As Variant, ByVal Lo As Long, ByVal Hi As Long, ByVal Nx As Long, ByVal Up As Boolean)
        Dim t As Variant
        Dim j As Long
        j = Lo
        If Up Then
            Do While j + Nx < Hi
                If a(j) > a(j + Nx) Then
                    t = a(j)
                    a(j) = a(j + Nx)
                    a(j + Nx) = t
                End If
                j = j + 2 * Nx
            Loop
        Else
            Do While j + Nx < Hi
                If a(j) < a(j + Nx) Then
                    t = a(j)
                    a(j) = a(j + Nx)
                    a(j + Nx) = t
                End If
                j = j + 2 * Nx
            Loop
        End If
    End Sub
    
    Private Sub ShearPart2(ByRef a As Variant, ByVal Lo As Long, ByVal Hi As Long, ByVal Nx As Long, ByVal Up As Boolean)
        Dim t As Variant
        Dim j As Long
        j = Lo + Nx
        If Up Then
            Do While j + Nx < Hi
                If a(j) > a(j + Nx) Then
                    t = a(j)
                    a(j) = a(j + Nx)
                    a(j + Nx) = t
                End If
                j = j + 2 * Nx
            Loop
        Else
            Do While j + Nx < Hi
                If a(j) < a(j + Nx) Then
                    t = a(j)
                    a(j) = a(j + Nx)
                    a(j + Nx) = t
                End If
                j = j + 2 * Nx
            Loop
        End If
    End Sub
    Code:
    Public Function ShearSort(ByRef plngArray() As Long)
        Dim Log As Long, Rows As Long, Cols As Long
        Dim pow As Long, div As Long
        Dim h() As Long
        Dim i As Long, k As Long, j As Long
        
        Dim lMax As Long, lMin As Long
        lMax = UBound(plngArray) + 1
        lMin = LBound(plngArray)
        pow = 1
        div = 1
        Do While i * i <= lMax
            If i > 0 Then
                If lMax Mod i = 0 Then div = i
            Else
                div = i
            End If
            i = i + 1
        Loop
        Rows = div
        Cols = lMax \ div
        Do While pow <= Rows
            pow = pow * 2
            Log = Log + 1
        Loop
        ReDim h(Rows)
        For i = 0 To Rows
            h(i) = i * Cols
        Next i
        
        For k = 0 To Log - 1
            For j = 0 To Cols \ 2 - 1
                For i = 0 To Rows - 1
                    ShearPart1 plngArray, h(i), h(i + 1), 1, i Mod 2 = 0
                Next i
                For i = 0 To Rows - 1
                    ShearPart2 plngArray, h(i), h(i + 1), 1, i Mod 2 = 0
                Next i
            Next j
            For j = 0 To Rows \ 2 - 1
                For i = 0 To Cols - 1
                    ShearPart1 plngArray, i, Rows * Cols + i, Cols, True
                Next i
                For i = 0 To Cols - 1
                    ShearPart2 plngArray, i, Rows * Cols + i, Cols, True
                Next i
            Next j
        Next k
    
        For j = 0 To Cols \ 2 - 1
            For i = 0 To Rows - 1
                ShearPart1 plngArray, h(i), h(i + 1), 1, True
            Next i
            For i = 0 To Rows - 1
                ShearPart2 plngArray, h(i), h(i + 1), 1, True
            Next i
        Next j
    
        For i = 0 To Rows - 1
            h(i) = -1
        Next i
    End Function
    
    Private Sub ShearPart1(ByRef a() As Long, ByVal Lo As Long, ByVal Hi As Long, ByVal Nx As Long, ByVal Up As Boolean)
        Dim t As Long
        Dim j As Long
        j = Lo
        If Up Then
            Do While j + Nx < Hi
                Compare aeShakersort, j, j + Nx
                If a(j) > a(j + Nx) Then
                    Exchange aeShakersort, j, j + Nx
                End If
                j = j + 2 * Nx
            Loop
        Else
            Do While j + Nx < Hi
                Compare aeShakersort, j, j + Nx
                If a(j) < a(j + Nx) Then
                    Exchange aeShakersort, j, j + Nx
                End If
                j = j + 2 * Nx
            Loop
        End If
    End Sub
    
    Private Sub ShearPart2(ByRef a As Variant, ByVal Lo As Long, ByVal Hi As Long, ByVal Nx As Long, ByVal Up As Boolean)
        Dim t As Variant
        Dim j As Long
        j = Lo + Nx
        If Up Then
            Do While j + Nx < Hi
                Compare aeShakersort, j, j + Nx
                If a(j) > a(j + Nx) Then
                    Exchange aeShakersort, j, j + Nx
                End If
                j = j + 2 * Nx
            Loop
        Else
            Do While j + Nx < Hi
                Compare aeShakersort, j, j + Nx
                If a(j) < a(j + Nx) Then
                    Exchange aeShakersort, j, j + Nx
                End If
                j = j + 2 * Nx
            Loop
        End If
    End Sub

  22. #22

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Re: Sorting algorithms (sort array, sorting arrays) - UPDATED

    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.

  23. #23

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Snake sort

    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.)
    Code:
    ----------------------
    |   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.)
    Last edited by Ellis Dee; Jul 10th, 2007 at 03:54 AM.

  24. #24

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Re: Sorting algorithms (sort array, sorting arrays) - UPDATED

    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 block
    Do Until i >= iMax
        Select Case lngDirection
            Case 1
                Do Until i = iMax
                    If pvarArray(i) > pvarArray(i + 1) Then Exit Do
                    i = i + 1
                Loop
            Case -1
                Do Until i = iMax
                    If pvarArray(i) < pvarArray(i + 1) Then Exit Do
                    i = i + 1
                Loop
            Case Else
                Do Until i = iMax
                    If pvarArray(i) <> pvarArray(i + 1) Then Exit Do
                    i = i + 1
                Loop
                If i = iMax Then lngDirection = 1
        End Select
        If lngDirection = 0 Then
            If pvarArray(i) > pvarArray(i + 1) Then
                lngDirection = -1
            Else
                lngDirection = 1
            End If
        Else
            lngLevel = lngLevel + 1
            lngIndex(lngLevel) = i * lngDirection
            lngDirection = 0
        End If
        i = i + 1
    Loop
    If Abs(lngIndex(lngLevel)) < iMax Then
        If lngDirection = 0 Then lngDirection = 1
        lngLevel = lngLevel + 1
        lngIndex(lngLevel) = i * lngDirection
    End If
    ' If the list is already sorted, exit
    If lngLevel <= 1 Then
        ' If sorted descending, reverse before exiting
        If lngIndex(lngLevel) < 0 Then
            For i = 0 To (iMax - iMin) \ 2
                varSwap = pvarArray(iMin + i)
                pvarArray(iMin + i) = pvarArray(iMax - i)
                pvarArray(iMax - i) = varSwap
            Next
        End If
        Exit Sub
    End If
    ' Main loop - merge section pairs together until only one section left
    ReDim varMirror(iMin To iMax)
    Do Until lngLevel = 1
        lngOldLevel = lngLevel
        For lngLevel = 1 To lngLevel - 1 Step 2
            If blnMirror Then
                SnakeSortMerge varMirror, lngIndex(lngLevel - 1), lngIndex(lngLevel), lngIndex(lngLevel + 1), pvarArray
            Else
                SnakeSortMerge pvarArray, lngIndex(lngLevel - 1), lngIndex(lngLevel), lngIndex(lngLevel + 1), varMirror
            End If
            lngNewLevel = lngNewLevel + 1
            lngIndex(lngNewLevel) = Abs(lngIndex(lngLevel + 1))
        Next
        If lngOldLevel Mod 2 = 1 Then
            If blnMirror Then
                For i = lngIndex(lngNewLevel) + 1 To iMax
                    pvarArray(i) = varMirror(i)
                Next
            Else
                For i = lngIndex(lngNewLevel) + 1 To iMax
                    varMirror(i) = pvarArray(i)
                Next
            End If
            lngNewLevel = lngNewLevel + 1
            lngIndex(lngNewLevel) = lngIndex(lngOldLevel)
        End If
        lngLevel = lngNewLevel
        lngNewLevel = 0
        blnMirror = Not blnMirror
    Loop
    ' Copy back to main array if necessary
    If blnMirror Then
        For i = iMin To iMax
            pvarArray(i) = varMirror(i)
        Next
    End If
    End Sub
    
    Private Sub SnakeSortMerge(pvarSource As Variant, plngLeft As Long, plngMid As Long, plngRight As Long, pvarDest As Variant)
    Dim L As Long
    Dim LMin As Long
    Dim LMax As Long
    Dim LStep As Long
    Dim R As Long
    Dim RMin As Long
    Dim RMax As Long
    Dim RStep As Long
    Dim O As Long
    
    If plngLeft <> 0 Then O = Abs(plngLeft) + 1
    If plngMid > 0 Then
        LMin = O
        LMax = Abs(plngMid)
        LStep = 1
    Else
        LMin = Abs(plngMid)
        LMax = O
        LStep = -1
    End If
    If plngRight > 0 Then
        RMin = Abs(plngMid) + 1
        RMax = Abs(plngRight)
        RStep = 1
    Else
        RMin = Abs(plngRight)
        RMax = Abs(plngMid) + 1
        RStep = -1
    End If
    L = LMin
    R = RMin
    Do
        If pvarSource(L) <= pvarSource(R) Then
            pvarDest(O) = pvarSource(L)
            If L = LMax Then
                For R = R To RMax Step RStep
                    O = O + 1
                    pvarDest(O) = pvarSource(R)
                Next
                Exit Do
            End If
            L = L + LStep
        Else
            pvarDest(O) = pvarSource(R)
            If R = RMax Then
                For L = L To LMax Step LStep
                    O = O + 1
                    pvarDest(O) = pvarSource(L)
                Next
                Exit Do
            End If
            R = R + RStep
        End If
        O = O + 1
    Loop
    End Sub
    Code:
    Private Sub SnakeSort(ByRef plngArray() As Long)
    Dim i As Long
    Dim iMin As Long
    Dim iMax As Long
    Dim lngIndex() As Long
    Dim lngLevel As Long
    Dim lngOldLevel As Long
    Dim lngNewLevel As Long
    Dim varMirror As Variant
    Dim lngDirection As Long
    Dim blnMirror As Boolean
    
    iMin = LBound(plngArray)
    iMax = UBound(plngArray)
    ReDim lngIndex((iMax - iMin + 3) \ 2)
    lngIndex(0) = iMin
    i = iMin
    ' Initial loop: locate cutoffs for each block
    Do Until i >= iMax
        Select Case lngDirection
            Case 1
                Do Until i = iMax
                    Compare aeSnakesort, i, i + 1
                    If plngArray(i) > plngArray(i + 1) Then Exit Do
                    i = i + 1
                Loop
            Case -1
                Do Until i = iMax
                    Compare aeSnakesort, i, i + 1
                    If plngArray(i) < plngArray(i + 1) Then Exit Do
                    i = i + 1
                Loop
            Case Else
                Do Until i = iMax
                    Compare aeSnakesort, i, i + 1
                    If plngArray(i) <> plngArray(i + 1) Then Exit Do
                    i = i + 1
                Loop
                If i = iMax Then lngDirection = 1
        End Select
        If lngDirection = 0 Then
            Compare aeSnakesort, i, i + 1
            If plngArray(i) > plngArray(i + 1) Then
                lngDirection = -1
            Else
                lngDirection = 1
            End If
        Else
            lngLevel = lngLevel + 1
            lngIndex(lngLevel) = i * lngDirection
            lngDirection = 0
        End If
        i = i + 1
    Loop
    If Abs(lngIndex(lngLevel)) < iMax Then
        If lngDirection = 0 Then lngDirection = 1
        lngLevel = lngLevel + 1
        lngIndex(lngLevel) = i * lngDirection
    End If
    ' If the list is already sorted, exit
    If lngLevel <= 1 Then
        ' If sorted descending, reverse before exiting
        If lngIndex(lngLevel) < 0 Then
            For i = 0 To (iMax - iMin) \ 2
                Exchange aeSnakesort, iMin + i, iMax - i
            Next
        End If
        Erase lngIndex
        Exit Sub
    End If
    ' Main loop - merge section pairs together until only one section left
    ReDim varMirror(iMin To iMax)
    Do Until lngLevel = 1
        lngOldLevel = lngLevel
        For lngLevel = 1 To lngLevel - 1 Step 2
            If blnMirror Then
                SnakeSortMerge varMirror, lngIndex(lngLevel - 1), lngIndex(lngLevel), lngIndex(lngLevel + 1), plngArray
            Else
                SnakeSortMerge plngArray, lngIndex(lngLevel - 1), lngIndex(lngLevel), lngIndex(lngLevel + 1), varMirror
            End If
            lngNewLevel = lngNewLevel + 1
            lngIndex(lngNewLevel) = Abs(lngIndex(lngLevel + 1))
        Next
        If lngOldLevel Mod 2 = 1 Then
            If blnMirror Then
                For i = lngIndex(lngNewLevel) + 1 To iMax
                    SnakeMerge aeSnakesort, i, varMirror(i), lngIndex(lngNewLevel) + 1, iMax
                    plngArray(i) = varMirror(i)
                Next
            Else
                For i = lngIndex(lngNewLevel) + 1 To iMax
                    SnakeMerge aeSnakesort, i, plngArray(i), lngIndex(lngNewLevel) + 1, iMax
                    varMirror(i) = plngArray(i)
                Next
            End If
            lngNewLevel = lngNewLevel + 1
            lngIndex(lngNewLevel) = lngIndex(lngOldLevel)
        End If
        lngLevel = lngNewLevel
        lngNewLevel = 0
        blnMirror = Not blnMirror
    Loop
    ' Copy back to main array if necessary
    If blnMirror Then
        For i = iMin To iMax
            SnakeMerge aeSnakesort, i, varMirror(i), iMin, iMax
            plngArray(i) = varMirror(i)
        Next
    End If
    End Sub
    
    Private Sub SnakeSortMerge(pvarSource As Variant, plngLeft As Long, plngMid As Long, plngRight As Long, pvarDest As Variant)
    Dim L As Long
    Dim LMin As Long
    Dim LMax As Long
    Dim LStep As Long
    Dim R As Long
    Dim RMin As Long
    Dim RMax As Long
    Dim RStep As Long
    Dim O As Long
    
    If plngLeft <> 0 Then O = Abs(plngLeft) + 1
    If plngMid > 0 Then
        LMin = O
        LMax = Abs(plngMid)
        LStep = 1
    Else
        LMin = Abs(plngMid)
        LMax = O
        LStep = -1
    End If
    If plngRight > 0 Then
        RMin = Abs(plngMid) + 1
        RMax = Abs(plngRight)
        RStep = 1
    Else
        RMin = Abs(plngRight)
        RMax = Abs(plngMid) + 1
        RStep = -1
    End If
    L = LMin
    R = RMin
    Do
        Compare aeSnakesort, Abs(plngLeft), Abs(plngRight)
        If pvarSource(L) <= pvarSource(R) Then
            SnakeMerge aeSnakesort, O, pvarSource(L), Abs(plngLeft), Abs(plngRight)
            pvarDest(O) = pvarSource(L)
            If L = LMax Then
                For R = R To RMax Step RStep
                    O = O + 1
                    SnakeMerge aeSnakesort, O, pvarSource(R), Abs(plngLeft), Abs(plngRight)
                    pvarDest(O) = pvarSource(R)
                Next
                Exit Do
            End If
            L = L + LStep
        Else
            SnakeMerge aeSnakesort, O, pvarSource(R), Abs(plngLeft), Abs(plngRight)
            pvarDest(O) = pvarSource(R)
            If R = RMax Then
                For L = L To LMax Step LStep
                    O = O + 1
                    SnakeMerge aeSnakesort, O, pvarSource(L), Abs(plngLeft), Abs(plngRight)
                    pvarDest(O) = pvarSource(L)
                Next
                Exit Do
            End If
            R = R + RStep
        End If
        O = O + 1
    Loop
    End Sub
    
    Private Sub SnakeMerge(penGraph As AlgorithmEnum, plngIndex As Long, ByVal plngValue As Long, plngLeft As Long, plngRight As Long)
    With grph(penGraph)
        .Exchanges = .Exchanges + 1
    End With
    LogOperation penGraph, oeMerge, plngLeft, plngRight, plngIndex, plngValue
    End Sub

  25. #25

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Re: Sorting algorithms (sort array, sorting arrays) - UPDATED

    The most interesting feature of snake sort is that the more ordered the array is initially, the faster it runs. Each alogorithm has its own unique worst case scenario. Quick sort's worst case appears to be a camel hump, such as:

    .1
    .....5
    .........9
    .......7
    ...3

    This puts the first pivot in the worst possible place, and it goes downhill from there. To see this in action, add this to the end of the seAscending Case in the GenerateArray() function:
    Code:
                For i = 0 To 24
                    mlngLines(i) = i * 4 + 1
                    mlngLines(49 - i) = (i + 1) * 4 - 1
                Next
    It would be logical to conclude that snake sort's worst case is alternating blocks of two. To see this, add this to the end of the seDescending Case:
    Code:
                For i = 0 To 48 Step 2
                    mlngLines(i) = (i * 2) + 3
                    mlngLines(i + 1) = (i * 2) + 1
                Next
    Finally, rename the SnakeSort() function to HeapSort(), and rename HeapSort() to something like HeapSortOld().

    Snakesort is far more efficient on already ordered lists; virtually equal to bubblesort. It really shines on descending lists, where it can transform the array by looping only halfway through it and swapping the ends. (Comment out the added code from above to see it on ascending and descending lists.)

    Most importantly, it's absolute worst case scenario is light years faster than quicksort's worst case. (Both scenarios are, IMO, unlikely in the extreme.) Given that the Time numbers are a rough approximation, where exchanges are assumed to take twice as long as comparisons and non-array comparisons and assignments are ignored, these are the Time numbers from the graphical screen:

    Best case (ascending):
    Quicksort: 317
    Snakesort: 50 (absolute minimum + 1)

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

  26. #26
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: Sorting algorithms (sort array, sorting arrays) - UPDATED

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

  27. #27

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Re: Sorting algorithms (sort array, sorting arrays) - UPDATED

    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.

  28. #28
    PowerPoster sunburnt's Avatar
    Join Date
    Feb 2001
    Location
    Boulder, Colorado
    Posts
    1,403

    Re: Sorting algorithms (sort array, sorting arrays) - UPDATED

    It might be worth looking at the mathematical reason that some of these are faster than others.

    Bubble Sort, Selection Sort, Insertion Sort and Shell Sort are all O(n2) algorithms. This means that as n (the number of items in the list) increases, the time it takes for the algorithm to run increases at a rate of n2.


    For example, if a list with 10 items may be sorted in 100 ms; A list with 100 items will take 10 seconds. As such, O(n2) Algorithms are not a good choice for sets with large amounts of data. (Obviously these exact times are made up; we aren't trying to determine how long it will take for a certain time, but rather how it scales.)

    I see that you gave Heap, Merge, and Quicksort 'A's, which is right on the money. These sorts are O(nlog(n)), which means that the time does not increase as quickly when the number of items increases.

    For example (using log base 2), a list with 10 items might take 33 ms to sort; a list with 100 items will then take 664 ms. A list with 1000 items will take just under 10 seconds. You can see that this is a marked improvement over the other sorts.

    This is not to say that the other sorts are useless; for example, some of these algorithms will run very very quickly if you know that a list is almost sorted, whereas a more complicated algorithm will take more time.


    An interesting special-case sort is the counting/bucket sort -- It's an O(n) algorithm, which means that the time it takes to run scales linearly with the number of items in the list; it can only be used when you can make specific claims about the data, however. It works by first counting the number of occurrences of each value, and then generating an array of those values in order.


    You can find VB Code here and probably better C++ code at wikipedia
    Code:
    #include <stdio.h>
    #include <stdlib.h>
    #include <inttypes.h>
    #include <memory.h>
    
    // data:  an array of unsorted integers
    // data_size:  the number of integers in the 'data' array
    // result:  an OUT parameter: where to store the sorted array
    // min:  the minimum value of all elements in 'data'
    // max:  the maximum value of all elements in 'data'.
    void counting_sort(int* data, size_t data_size, int* result, int min, int max)
    {
       size_t bucket_size = (max - min) + 1;
       
       // create an array for each of the values between 'max' and 'min':
       int bucket[bucket_size];
    
       // set each item in the bucket aray to 0.
       for(int i = 0; i < bucket_size; ++i)
       {
          bucket[i] = 0;
       }
       
       // for each item in the array
       for(int i = 0; i < data_size; ++i)
       {
          // convert the value in the array to an index into 'bucket'
          int index = data[i] - min;
          // increment the count for this value.
          bucket[index]++;
       }
    
       int result_index = 0;
       
       // now, build our result array:
       // for each value in the bucket:
       for(int i = 0; i < bucket_size; ++i)
       {     
          while(bucket[i]-- > 0)
    	 result[result_index++] = i + min;
       }
    }
    
    // test it out:
    int main()
    {
       // array to sort
       int s[] = {7, 7, 8, 5,
    	      6, 3, 1, 2,
    	      4, 5, 6, 7,
    	      8, 1, 1, 3};
    
       // result array
       int r[12];
    
       // print unsorted array
       for(int i = 0; i < 12; ++i)
          printf("%d ", s[i]);
    
       printf("\n");
    
       counting_sort(s, 12, r, 1, 8);
    
       // print sorted array
       for(int i = 0; i < 12; ++i)
          printf("%d ", r[i]);
    
       printf("\n");
    }
    Actually, if you go over the algorithm you'll see that the claim of O(n) is not exactly true; rather, the order is O(m+n) where m is the range of the data. With a small m and large n you can get good performance.


    EDIT: I had to post using the code tag instead of the highlight tag because the highlight tag breaks the array notation making the code unreadable.
    Last edited by sunburnt; Jul 11th, 2007 at 01:28 PM.
    Every passing hour brings the Solar System forty-three thousand miles closer to Globular Cluster M13 in Hercules -- and still there are some misfits who insist that there is no such thing as progress.

  29. #29
    Lively Member
    Join Date
    Oct 2006
    Location
    Wauchope, NSW, Australia
    Posts
    92

    Unhappy http://www.vbforums.com/showthread.php?t=480591

    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

  30. #30

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Re: http://www.vbforums.com/showthread.php?t=480591

    Quote Originally Posted by 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
    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.

  31. #31
    Lively Member
    Join Date
    Oct 2006
    Location
    Wauchope, NSW, Australia
    Posts
    92

    Re: VB6: Sorting algorithms (sort array, sorting arrays)

    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

  32. #32

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Re: VB6: Sorting algorithms (sort array, sorting arrays)

    Quote Originally Posted by 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
    It would appear that I already did last month. Ask any followup questions you have in that thread.

  33. #33
    Frenzied Member NeedSomeAnswers's Avatar
    Join Date
    Jun 2002
    Location
    Top of the Perch
    Posts
    1,285

    Re: VB6: Sorting algorithms (sort array, sorting arrays)

    The application no longer appears to be attached to the post !!??
    Please Mark your Thread "Resolved", if the query is solved & Rate those who have helped you



  34. #34
    New Member
    Join Date
    Feb 2008
    Posts
    1

    Re: VB6: Sorting algorithms (sort array, sorting arrays)

    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?

  35. #35
    Cumbrian Milk's Avatar
    Join Date
    Jan 2007
    Location
    0xDEADBEEF
    Posts
    2,428

    Re: VB6: Sorting algorithms (sort array, sorting arrays)

    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

  36. #36
    Banned randem's Avatar
    Join Date
    Oct 2002
    Location
    Maui, Hawaii
    Posts
    11,385

    Re: VB6: Sorting algorithms (sort array, sorting arrays)

    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?

  37. #37

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Re: VB6: Sorting algorithms (sort array, sorting arrays)

    Quote Originally Posted by 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?
    Well that's no good. Could you post some (non)functional code to reproduce the error?

    I must warn you, though, that this may possibly be just a limitation of the algorithm itself.

    EDIT: And no, "Not Stable" doesn't mean it occasionally fails. heh. Stable and unstable refer to how the algorithm handles duplicate keys. Stable algorithms retain the original order, while unstable ones may shuffle them around. This doesn't matter for single-dimension arrays.
    Last edited by Ellis Dee; May 11th, 2008 at 05:28 PM.

  38. #38
    Banned randem's Avatar
    Join Date
    Oct 2002
    Location
    Maui, Hawaii
    Posts
    11,385

    Re: VB6: Sorting algorithms (sort array, sorting arrays)

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

  39. #39

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Re: VB6: Sorting algorithms (sort array, sorting arrays)

    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.
    Attached Files Attached Files
    Last edited by Ellis Dee; May 11th, 2008 at 11:03 PM.

  40. #40

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,438

    Re: VB6: Sorting algorithms (sort array, sorting arrays)

    Also note that as far as I can tell, the absolute best all-purpose sorting algorithm when it comes to reliability, scalability, and efficiency is smooth sort. Sadly, I need help debugging the algorithm, and would dearly love any help you could give. (The code is in basGraphical.bas.)

    If you can afford the expense of spending 2.5 times the memory of the original array, snake sort is the best comparison algorithm I've seen.
    Last edited by Ellis Dee; May 12th, 2008 at 11:27 AM.

Page 1 of 3 123 LastLast

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.