Need a sorting routine - Printable Version

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

Code: (Select All)

Screen _NewImage(800, 600, 32)



Type DATATYPE

    a As Integer

    b As Integer

    c As Integer

End Type



Const Limit = 1000000 'one million defalt limit



ReDim SortedList(1 To Limit) As DATATYPE



For i = 1 To Limit

    SortedList(i).a = Int(Rnd * 32767) + 1

    SortedList(i).b = Int(Rnd * 32767) + 1

    SortedList(i).c = Int(Rnd * 32767) + 1

Next



For i = 1 To 30

    Print SortedList(i).a, SortedList(i).b, SortedList(i).c

Next

Sleep



FakeSort SortedList()

Print

Print "=== Sorted ==="

Print

For i = 1 To 30

    Print SortedList(i).a, SortedList(i).b, SortedList(i).c

Next





Sub FakeSort (Array() As DATATYPE)

    Dim S(1 To 32767) As String

    Dim TempArray(1 To Limit) As DATATYPE

    For i = 1 To Limit 'build the sorted index in a single pass

        S(Array(i).a) = S(Array(i).a) + MKL$(i)

    Next



    Count = 0

    For i = 1 To 32767

        For J = 1 To Len(S(i)) Step 4 'we stored our index as long values

            Count = Count + 1

            t$ = Mid$(S(i), J, 4)

            index = CVL(t$)

            TempArray(Count) = Array(index)

        Next

    Next



    For i = 1 To Limit

        Array(i) = TempArray(i)

    Next

End Sub