CombSort – A compact routine that sorts data in place

' CombSort.  A compact routine that sorts data in place (no extra memory needed)'  and runs in approximately O(N log N) time.  Not stable (does not preserve ' original order of records with equal keys).  Like InsertionSort,'  works by taking a key from the right side of the list and comparing it with ' keys to the left until the correct position is found to insert it.  Differs ' from InsertionSort (and resembles ShellSort) by moving leftward by interval ' GAP instead of one key at a time.  GAP is initially large (to move keys close ' to their final position rapidly) and is repeatedly reduced until it equals 1 ' and the list is sorted.  Rare sequences of keys may not fit the series of GAP ' values, leading to slow sorting.  Two versions are given.  pCombSortS is an ' indirect (pointerized) version for strings, which can be adapted to doubles ' by changing the declaration of A().  CombSortL is a direct version for longs,'  which can be adapted to integers.'' Reference:  Stephen Lacy and Richard Box, "A Fast, Easy Sort", Byte,'  April 1991, p.315 ff.'' Speed:  pCombSortS sorts 500,000 random strings in 100 sec; sorts 100186 ' library call numbers in 16.5 sec; sorts 25479 dictionary words in 3.5 sec ' (random order), 2.7 sec (presorted) or 2.9 sec (reverse sorted).  CombSortL ' sorts 500,000 random longs in 52 seconds.  Timed in Excel 2001 on an 800 mhz ' PowerBook.'' Bottom line:  about as fast as HeapSort, but lacks HeapSort's guarantee of O' (NlogN) worst case speed.' Usage:  Dim S1(L To R) As StringDim P1(L To R) As LongDim L1(L To R) As Long For I = L To R    S1(I) = GetRandomString()    P1(I) = I    L1(I) = GetRandomLong()Next IpCombSortS L, R, S1, P1CombSortL L, R, L1' CODE:Sub CombSortS(L As Long, R As Long, A() As String, P() As Long)    Dim GAP As Long    Dim SWAPPED As Boolean    Dim I As Long    Dim J As Long    Dim TMP As Long    'Initialize GAP to length of list.    GAP = CLng(1 + R - L)    Do    'For each pass, divide GAP by 1.3.        GAP = (10 * GAP)  13    'The most efficient series of final GAP values starts with 11.        If GAP = 0 Then            GAP = 1        ElseIf GAP = 9 Or GAP = 10 Then            GAP = 11        End If    'Use SWAPPED to tell whether we made a pass without any exchanges.        SWAPPED = False    'Compare and possibly swap values/pointers separated by GAP.        For I = L To R - GAP            J = I + GAP            If A(P(I)) > A(P(J)) Then                TMP = P(I)                P(I) = P(J)                P(J) = TMP                SWAPPED = True            End If        Next I    'If GAP = 1 and we didn't move anything, we're done.    Loop While SWAPPED Or GAP > 1End SubSub CombSortL(L As Long, R As Long, A() As Long)    Dim GAP As Long    Dim SWAPPED As Boolean    Dim I As Long    Dim J As Long    Dim TMP As Long    GAP = CLng(1 + R - L)    Do        GAP = (10 * GAP)  13        If GAP = 0 Then            GAP = 1        ElseIf GAP = 9 Or GAP = 10 Then            GAP = 11        End If        SWAPPED = False        For I = L To R - GAP            J = I + GAP            If A(I) > A(J) Then                TMP = A(I)                A(I) = A(J)                A(J) = TMP                SWAPPED = True            End If        Next I    Loop While SWAPPED Or GAP > 1End Sub

Share the Post:
Share on facebook
Share on twitter
Share on linkedin

Overview

Recent Articles: