dcsimg
Login | Register   
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX

By submitting your information, you agree that devx.com may send you DevX offers via email, phone and text message, as well as email offers about other products and services that DevX believes may be of interest to you. DevX will process your information in accordance with the Quinstreet Privacy Policy.


Tip of the Day
Language: VB5, VB6
Expertise: Advanced
Jan 13, 2003

WEBINAR:

On-Demand

Application Security Testing: An Integral Part of DevOps


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 String
Dim P1(L To R) As Long
Dim L1(L To R) As Long
 
For I = L To R
    S1(I) = GetRandomString()
    P1(I) = I
    L1(I) = GetRandomLong()
Next I

pCombSortS L, R, S1, P1
CombSortL 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 > 1
End Sub

Sub 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 > 1
End Sub

David B. Ring
 
Comment and Contribute

 

 

 

 

 


(Maximum characters: 1200). You have 1200 characters left.

 

 

Sitemap
Thanks for your registration, follow us on our social networks to keep up-to-date