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


Tip of the Day
Language: VB4,VB5,VB6,VBS
Expertise: Intermediate
Apr 27, 1999

ShellSort - Sort Arrays using the ShellSort Algorithm

' ShellSort an array of any type
'
' ShellSort behaves pretty well with arrays of any size, even
' if the array is already "nearly-sorted", even though in
' particular cases BubbleSort or QuickSort can be more efficient.
'
' LASTEL is the index of the last item to be sorted, and is
' useful if the array is only partially filled. This updated version accounts
' for arrays whose LBound is 0 and 1 (or whatever)
'
' Works with any kind of array, except UDTs and fixed-length
' strings, and including objects if your are sorting on their
' default property. String are sorted in case-sensitive mode.
'
' You can write faster procedures if you modify the first two lines
' to account for a specific data type, eg.
' Sub ShellSortS(arr() As Single, Optional lastEl As Variant,
'  Optional descending As Boolean)
'   Dim value As Single

Sub ShellSort(arr As Variant, Optional lastEl As Variant, _
    Optional descending As Boolean)
    Dim value As Variant
    Dim index As Long, index2 As Long
    Dim firstEl As Long
    Dim distance As Long
    Dim numEls As Long

    ' account for optional arguments
    If IsMissing(lastEl) Then lastEl = UBound(arr)
    firstEl = LBound(arr)
    
    numEls = lastEl - firstEl + 1
    ' find the best value for distance
    Do
        distance = distance * 3 + 1
    Loop Until distance > numEls

    Do
        distance = distance \ 3
        For index = distance + firstEl To lastEl
            value = arr(index)
            index2 = index
            Do While (arr(index2 - distance) > value) Xor descending
                arr(index2) = arr(index2 - distance)
                index2 = index2 - distance
                If index2 - distance < firstEl Then Exit Do
            Loop
            arr(index2) = value
        Next
    Loop Until distance = 1
End Sub
Francesco Balena
 
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