Results 1 to 40 of 100

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

Threaded View

  1. #1

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

    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.

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
  •  



Click Here to Expand Forum to Full Width