Need a sorting routine

[TerryRitchie]

Code: (Select All)

Type DATATYPE
  a As Integer
  b As Integer
  c As Integer
End Type

ReDim Shared SortedList(32767) As DATATYPE

Randomize Timer
For x% = 0 To UBound(SortedList)
  SortedList(x%).a = Int(Rnd * 32768)
Next x%
t# = Timer(.001)
QSort 0, UBound(SortedList)
t2# = Timer(.001)
For x% = 0 To UBound(SortedList)
  Print SortedList(x%).a;
Next x%
Print: Print Using "#.### sec"; t2# - t#
End


Sub QSort (leftN As Long, rightN As Long)
  Dim pivot As Long, leftNIdx As Long, rightNIdx As Long
  leftNIdx = leftN
  rightNIdx = rightN
  If (rightN - leftN) > 0 Then
    pivot = (leftN + rightN) / 2
    While (leftNIdx <= pivot) And (rightNIdx >= pivot)
      While SortedList(leftNIdx).a < SortedList(pivot).a And (leftNIdx <= pivot)
        leftNIdx = leftNIdx + 1
      Wend
      While SortedList(rightNIdx).a > SortedList(pivot).a And (rightNIdx >= pivot)
        rightNIdx = rightNIdx - 1
      Wend
      Swap SortedList(leftNIdx), SortedList(rightNIdx)
      leftNIdx = leftNIdx + 1
      rightNIdx = rightNIdx - 1
      If (leftNIdx - 1) = pivot Then
        rightNIdx = rightNIdx + 1
        pivot = rightNIdx
      ElseIf (rightNIdx + 1) = pivot Then
        leftNIdx = leftNIdx - 1
        pivot = leftNIdx
      End If
    Wend
    QSort leftN, pivot - 1
    QSort pivot + 1, rightN
  End If
End Sub

Holy heck this routine is fast! It takes 5000 values before it even begins to show a time of .001 sec to complete.