[AccessD] Sorting an array from a calback function

Neal Kling nkling at co.montgomery.ny.us
Wed May 21 11:22:56 CDT 2003


Here are various array sorting routines which I robbed from Neatcode.mdb
which is a sample database that has been floating around for years.
 
Neal Kling
Lotus, isn't that some kind of fancy flower?
 
Sub BubbleSort(A() As Integer)
'
' Slowest Sort: n^2 comparisons
'
' Calling convention:
'   Redim A(1 To 20) as Integer
'   BubbleSort A()
'
Dim i As Integer, J As Integer, Low As Integer, Hi As Integer, Temp As
Integer
  Low = LBound(A)
  Hi = UBound(A)
  For i = Low To Hi - 1
    For J = i + 1 To Hi
      If A(i) > A(J) Then
        Temp = A(i)
        A(i) = A(J)
        A(J) = Temp
      End If
    Next J
  Next i
End Sub
 
Sub BubbleSort2(A() As Integer)
'
' Slowest Sort: n^2 comparisons
' Implements early cut-off
'
' Calling convention:
'   Redim A(1 To 20) As Integer
'   BubbleSort2 A()
'
Dim i As Integer, J As Integer, Low As Integer, Hi As Integer
Dim Temp As Integer, Swapped As Integer
  Low = LBound(A)
  Hi = UBound(A)
  For i = Low To Hi - 1
    Swapped = False
    For J = i + 1 To Hi
      If A(i) > A(J) Then
        Temp = A(i)
        A(i) = A(J)
        A(J) = Temp
        Swapped = True
      End If
    Next J
    If Not Swapped Then Exit Sub
  Next i
End Sub
 

Sub QuickSort(A() As Integer, ByVal Low As Integer, ByVal Hi As Integer)
'
' Very fast sort: n Log n comparisons
'
' Calling convention:
'   Redim A(1 To 20) as Integer
'   QuickSort A(), 1, 20
'
Dim MidValue As Integer, i As Integer, J As Integer, Temp As Integer
  If Hi <= Low Then Exit Sub
  MidValue = A((Low + Hi) \ 2)
  i = Low
  J = Hi
  Do While i <= J
    If A(i) >= MidValue And A(J) <= MidValue Then
      Temp = A(i)
      A(i) = A(J)
      A(J) = Temp
      i = i + 1
      J = J - 1
    Else
      If A(i) < MidValue Then i = i + 1
      If A(J) > MidValue Then J = J - 1
    End If
  Loop
  QuickSort A(), Low, J
  QuickSort A(), i, Hi
End Sub
 
Sub ShellSort(A() As Integer)
'
' Very fast sort: 2n Log n comparisons
'
' Calling convention:
'   Redim A(1 To 20) as Integer
'   ShellSort A()
'
Dim i As Integer, J As Integer, Low As Integer, Hi As Integer
Dim Temp As Integer, Swapped As Integer
  Low = LBound(A)
  Hi = UBound(A)
  J = (Hi - Low + 1) \ 2
  Do While J > 0
    For i = Low To Hi - J
      If A(i) > A(i + J) Then
        Temp = A(i)
        A(i) = A(i + J)
        A(i + J) = Temp
      End If
    Next i
    For i = Hi - J To Low Step -1
      If A(i) > A(i + J) Then
        Temp = A(i)
        A(i) = A(i + J)
        A(i + J) = Temp
      End If
    Next i
    J = J \ 2
  Loop
End Sub
 
Sub TagBubbleSort(S() As String, A() As Integer)
'
' Slowest Sort: n^2 comparisons
'
' Calling convention:
'   Redim S(1 to 20) as String, A(1 To 20) as Integer
'   TagBubbleSort S(), A()
'
' Sorting strings is very inefficient on memory and fragments it
' greatly.  By using a tag sort, you are swapping pointers or tags
' into the string array.  The calling function also needs to understand
' that it needs to use tags.
'
' Tag sorts can be adopted to other sort types by using the tag in
comparisons
'
Dim i As Integer, J As Integer, Low As Integer, Hi As Integer, Temp As
Integer
  Low = LBound(A)
  Hi = UBound(A)
'
' Initialize Tag array
'
  For i = Low To Hi
    A(i) = i
  Next i
'
' Sort
'
  For i = Low To Hi - 1
    For J = i + 1 To Hi
      If S(A(i)) > S(A(J)) Then   ' Test String Array via tag
        Temp = A(i)               ' Swap tag values
        A(i) = A(J)
        A(J) = Temp
      End If
    Next J
  Next i
End Sub

-----Original Message-----
From: Don Elliker [mailto:delliker at hotmail.com]
Sent: Wednesday, May 21, 2003 12:16 PM
To: accessd at databaseadvisors.com
Subject: [AccessD] Sorting an array from a calback function



I am using a call back to populate a combo and I would like to sort the
resulting array. In particular I am using the Report objects Description
property as the displayed item in the combo. Column 1 is the report name
Column 2 is the report description, column 2 is the visible column.
Everythings very nice except the order - got any array sorting code out
there? 
TIA


_d



"Things are only free to the extent that you don't pay for them." 


  _____  

Protect your PC - Click here <http://g.msn.com/8HMEENUS/2755??PS=>  for
McAfee.com VirusScan Online 



More information about the AccessD mailing list