Browse DevX
Sign up for e-mail newsletters from DevX

Tip of the Day
Language: VB4,VB5,VB6
Expertise: Intermediate
Sep 4, 1999



Building the Right Environment to Support AI, Machine Learning and Deep Learning

NdxShellSort -Sort Indexed Arrays using ShellSort

' Indexed ShellSort of an array of any type
' Indexed Sorts are sort procedures that sort an index array
' instead of the main array. You can then list the items in
' sorted member by simply scanning the index, as in
'   For i = 1 To numEls: Print arr(ndx(i)): Next
' NUMELS is the index of the last item to be sorted, and is
' useful if the array is only partially filled.
' 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 NdxShellSortS(arr() As Single, ndx() As Long,
'  '   Optional numEls As Variant, Optional descending As Boolean)
'   Dim value As Single

Sub NdxShellSort(arr As Variant, ndx() As Long, Optional numEls As Variant, _
    Optional descending As Boolean)

    Dim value As Variant
    Dim index As Long, index2 As Long
    Dim firstItem As Long
    Dim distance As Long
    Dim tempNdx As Long

    ' account for optional arguments
    If IsMissing(numEls) Then numEls = UBound(arr)
    firstItem = LBound(arr)
    ' init index array if necessary
    If ndx(firstItem) = 0 And ndx(UBound(ndx)) = 0 Then
        For index = firstItem To UBound(ndx)
            ndx(index) = index
    End If
    ' find the best value for distance
        distance = distance * 3 + 1
    Loop Until distance > numEls
        distance = distance \ 3
        For index = distance + 1 To numEls
            tempNdx = ndx(index)
            value = arr(tempNdx)
            index2 = index
            Do While (arr(ndx(index2 - distance)) > value) Xor descending
                ndx(index2) = ndx(index2 - distance)
                index2 = index2 - distance
                If index2 <= distance Then Exit Do
            ndx(index2) = tempNdx
    Loop Until distance = 1
End Sub

Francesco Balena
Comment and Contribute






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



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