Need a sorting routine

[TerryRitchie]

Does anyone have a sorting algorithm laying around I could use? Nothing fancy but something faster than a bubble sort.

I have the following I need to sort:

TYPE DATATYPE
    a AS INTEGER
    b AS INTEGER
    c AS INTEGER
END TYPE

REDIM SortedList(0) AS DATATYPE

The sort will only be done on the value of 'a' (SortedList().a) and the values can range from 1 to 32767.

The Index of SortedList() can also be from 1 to 32767.

The first thing you're probably thinking is why not have the index value equal the value in 'a'... There can be multiple duplicate values in 'a'.

A bubble sort will probably do fine for the array if less than 1000 indexes but I need a sort that will be faster than bubble for cases where the index surpasses 32000+

QuickSort? MergeSort? InsertionSort? Anyone?

[mnrvovrfc]

QB64 Wiki is your friend.

https://qb64phoenix.com/qb64wiki/index.php/SWAP

(Example #3)

[mdijkens]

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

[bplus]

+1 Exactly how I'd do it!

[RhoSigma]

There's CodeGuy's sorting library in the old archived .org forum:
https://qb64forum.alephc.xyz/index.php?t...30#msg3830

[SMcNeill]

How essential is speed to this process?  With such a limited dataset, I imagine a counting routine would blaze through the process in a single pass.  (Which would be useful when dealing with data sets with millions of elements in it.)

Process would work like this:

DIM A_String_Array(1 TO Array_Max_Limit) AS STRING

Then you simply read the array in one loop and add the index to the proper array element.

FOR I = 1 TO Array_Max_Limit
   A_String_Array(My_Data(I).a) = A_String_Array(My_Data(I).a) + MKL$(I)
NEXT

^  That just built you an indexed array in one single pass.  Now to "Sort" it, you can just read that array and rebuild your data from it.


Count = 0
FOR I = 1 TO Array_Max_Limit
FOR J = 1 TO LEN( A_String_Array(I)) STEP 4 'we stored our index as long values
Count = Count + 1
index = CLV(MID$(A_String_Array(I), J, 4))
    SWAP My_Data(Count), My_Data(index)
NEXT
NEXT

There may be some glitchness in the above as I haven't tested it (I'm not at a PC with QB64 on it at the moment), but the concept is sound. It's the same process as what I use in my MemSort routines for integers and bytes -- the fastest "sort" isn't any sort routine. It's a simple count routine.

Sorting is a process of take this, swap with that... repeat an excessive number of times.

This is just a case of: Read the value, store the index in an array large enough to hold all our values. Our SWAP of information only comes once for each index. There's no repetition involved.

And you can't get any faster than that!

[TerryRitchie]

QB64 Wiki is your friend.

https://qb64phoenix.com/qb64wiki/index.php/SWAP

(Example #3)

I didn't even think to look in the Wiki. I need to remember that thing contains more than just command information. Thank you.

@mdijkens - Thank you for the code. I'll give it a whirl.

@RhoSigma - I knew codeguy did this work some time back and have a text file with some of his work in it. This link is much better than what I have. Thank you.

@SMcNeill - Speed is crucial in my use case. This may need to be done up to 60 times per second depending on the implementation. However keeping it to once per second is the goal. I'll give your method a whirl and see what the result is.

Thanks for the replies everyone.

[SMcNeill]

@TerryRitchie A working example for you:

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

[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.

[SMcNeill]

Give my example above a run and let me know how it performs in comparison for you.  https://staging.qb64phoenix.com/showthre...6#pid14066