About Sorting Algos

[Theo Gottwald]

Even the smallest fractions of a second count when sorting through 10,000,000 items. But once you reach a whopping 100,000,000 items, a few seconds' difference becomes noticeable. 🧐 Fascinating, though not exactly game-changing!

Turns out Quick sort paired with a different technique for small partitions can be intriguingly efficient! For partitions of about 25 items or fewer, an alternative method is actually more apt. 🔄 While bubble sort gets the job done, selection sort edges it out by a hair.

Here's a cool tidbit – just testing for two-item scenarios and swapping them if needed offers a noticeable little speed boost! 🚀

Now, while these differences might seem trivial, they're larger than you'd think. Ditching the extra code, the classic coded Quick sort is actually slower than the state-of-the-art PB sort crafted in assembly language.

🆕 Update Alert: We've introduced insertion sort as the alternative and bumped the alternative sort threshold to 25 items. On an impressive count of 100,000,000 items, it makes a clear cut – about 6 seconds speedier than the PB sort! Not crucial, but undeniably cool. 😎✨

#SortingAlgorithms #QuickSort #Efficiency #Coding #InsertionSort #ProgrammingInsights #TechTalk #SpeedOptimization #BigData 🚀👨�💻📊🔢💡

Code Select Expand

#Option LargeMem32
#Dim All
#Compile Exe "Sort Test.exe"
'public domain, use at own risk

Macro doalternativesort = 25
Macro testcount = 10000000

Function PBMain()
    Register i As Long
    Local pb() As Long
    Local a() As Long
    Local value As Long
    Local s As WString
    Local d As Double

    Randomize

    Dim pb(1 To testcount)
    Dim a(1 To testcount)
    For i = 1 To testcount
        value = Rnd(-29999999, 29999999)
        'value = Rnd(1, 1000)
        'value = i
        'value = testcount - 1
        'value = 9
        pb(i) = value
        a(i) = value
    Next i

    s += "sort test count = " + Format$(testcount,"#,") + $CrLf

    'PB sort
    d = Timer
    Array Sort pb()
    s += "PB sort time = " + Format$(Timer - d,"000.000") + " seconds" + $CrLf

    'code sort
    d = Timer
    CodeSort(a(), 1, testcount)
    s += "code sort time = " + Format$(Timer - d,"000.000") + " seconds" + $CrLf

    For i = 1 To testcount
        If a(i) <> pb(i) Then
            ? "code sort fail"
            Exit Function
        End If
    Next i

    ? s
End Function

Sub CodeSort(a() As Long, ByVal leftindex As Long, ByVal rightindex As Long)
    Register i As Long
    Register j As Long
    Local items, k As Long
    Local value As Long

    items = rightindex - leftindex + 1
    If items > 1 Then
        If items = 2 Then
            'SORT TWO VALUE
            If a(rightindex) < a(leftindex) Then Swap a(rightindex), a(leftindex)
        ElseIf items <= doalternativesort Then
            'DO ALTERNATIVE SORT
            InsertionSort(a(), leftindex, rightindex)
        Else
            'QUICK SORT
            i = leftIndex : j = rightIndex : k = i + j : Shift Right k, 1: value = a(k)
            While i <= j
                While a(i) < value
                    Incr i
                Wend
                While a(j) > value
                    Decr j
                Wend
                If i <= j Then
                    Swap a(i), a(j) : Incr i : Decr j
                End If
            Wend
            If leftIndex < j Then CodeSort(a(), leftIndex, j)
            If i < rightIndex Then CodeSort(a(), i, rightIndex)
        End If
    End If
End Sub

Sub InsertionSort(a() As Long, ByVal leftindex As Long, ByVal rightindex As Long)
    Register i As Long
    Register j As Long
    Local value As Long

    For i = leftindex + 1 To rightindex
        value = a(i)
        j = i - 1
        While j >= leftindex And a(j) > value
            a(j + 1) = a(j)
            Decr j
        Wend
        a(j + 1) = value
    Next i
End Sub

Sub SelectionSort(a() As Long, ByVal leftindex As Long, ByVal rightindex As Long)
    Register i As Long
    Register j As Long

    For i = leftindex To rightindex - 1
        For j = i + 1 To rightindex
            If a(j) < a(i) Then Swap a(j), a(i)
        Next i
    Next i
End Sub

Sub BubbleSort(a() As Long, ByVal leftindex As Long, ByVal rightindex As Long)
    Register i As Long
    Local swapped As Byte

    swapped = 1
    While swapped
        swapped = 0
        For i = leftindex To rightindex - 1
            If a(i + 1) < a(i) Then
                Swap a(i + 1), a(i)
                swapped = 1
            End If
        Next i
    Wend
End Sub

' Quicksort - non-recursive
SUB Quicksort (arr() AS LONG) 'change type to suit
    LOCAL pivot,tmp AS LONG   'change type to suit
    REGISTER i AS LONG
    REGISTER j AS LONG
    LOCAL stackptr,l,r,stack(),x,y AS LONG
    DIM stack (100,2)  '100 probably overkill,  never seen it exceed low 20's with 100,000,000 elements
    stack (1, 1) = LBOUND(arr()): stack (1, 2) = UBOUND(arr())
    stackptr = 1
    WHILE stackptr
        l  = stack (stackptr , 1): r  = stack (stackptr , 2):DECR stackptr 'pop stack
        DO
            i  = l : j  = r
            pivot  = arr(INT((l  + r ) / 2))
            DO
                WHILE arr(i) < pivot :INCR i:WEND
                WHILE arr(j) > pivot :DECR j:WEND
                IF i>j  THEN EXIT LOOP
                tmp = arr(i): arr(i) = arr(j): arr(j) = tmp
                INCR i:DECR j
            LOOP UNTIL i>j

            x = j-l:y = r-i
            IF x<y AND i<r  THEN INCR stackptr: stack(stackptr,1)=i: stack(stackptr,2)=r
            IF x>=y AND l<j THEN INCR stackptr: stack(stackptr,1)=l: stack(stackptr,2)=j
            IF x<y THEN r=j ELSE l=i
        LOOP UNTIL l>=r
    WEND
END SUB  �



Code Select Expand

#DIM ALL
#COMPILE EXE "Sorts"

MACRO vtype = LONG

MACRO testcount = 5000000
MACRO doalternativesort = 5

FUNCTION PBMAIN()
    REGISTER i AS LONG
    LOCAL pb(),a(),b(),value AS vtype
    LOCAL s AS WSTRING
    LOCAL d AS DOUBLE

    RANDOMIZE

    DIM pb(1 TO testcount)
    DIM a(1 TO testcount)
    DIM b(1 TO testcount)
    FOR i = 1 TO testcount
        value = RND(-99999, 99999)
        'value = Rnd(-1000, 1000)
        'value =  -i
        'value = rnd(1,testcount/10)
        'value = testcount - 1
        'value = 9
        pb(i) = value
        a(i) = value
        b(i) = value
    NEXT i

    s += "sort test count = " + FORMAT$(testcount,"#,") + $CRLF


    'PB sort
    d = TIMER
    ARRAY SORT pb()
    s += "PB sort time = " + FORMAT$(TIMER - d,"000.000") + " seconds" + $CRLF

    'code sort
    d = TIMER
    codesort(b(),1,testcount)

    s += "code sort time = " + FORMAT$(TIMER - d,"000.000") + " seconds" + $CRLF
    'code sort
    d = TIMER
    quicksort(a())

    s += "quick sort time = " + FORMAT$(TIMER - d,"000.000") + " seconds" + $CRLF


    FOR i = 1 TO testcount
        IF a(i) <> pb(i) THEN
           ? "Mismatch at line " & STR$(i)
            EXIT FUNCTION
        END IF
    NEXT i
    ? s
END FUNCTION

'quicksort sort of numeric array arr()
SUB Quicksort (arr() AS vtype)
    LOCAL pivot,tmp AS vtype
    REGISTER i AS LONG
    REGISTER j AS LONG
    LOCAL stackptr,l,r,stack(),x,y AS LONG
    DIM stack (100,2)  '100 probably overkill,  never seen it exceed low 20's with 100,000,000 elements
    stack (1, 1) = LBOUND(arr()): stack (1, 2) = UBOUND(arr())
    stackptr = 1
    WHILE stackptr
        l  = stack (stackptr , 1): r  = stack (stackptr , 2):DECR stackptr 'pop stack
        DO
            i  = l : j  = r
            pivot  = arr(INT((i  + j ) / 2))
            DO
                WHILE arr(i) < pivot :INCR i:WEND
                WHILE arr(j) > pivot :DECR j:WEND
                IF i>j  THEN EXIT LOOP
                tmp = arr(i): arr(i) = arr(j): arr(j) = tmp
                INCR i:DECR j
            LOOP UNTIL i>j

            x = j-l:y = r-i
            IF x<y AND i<r  THEN INCR stackptr: stack(stackptr,1)=i: stack(stackptr,2)=r
            IF x>=y AND l<j THEN INCR stackptr: stack(stackptr,1)=l: stack(stackptr,2)=j
            IF x<y THEN r=j ELSE l=i
        LOOP UNTIL l>=r
    WEND
END SUB

'S Durham Recursive Sort
SUB CodeSort(a() AS vtype, BYVAL leftindex AS LONG, BYVAL rightindex AS LONG)
    REGISTER i AS LONG
    REGISTER j AS LONG
    LOCAL items, k AS LONG
    LOCAL value AS vtype

    items = rightindex - leftindex + 1
    IF items > 1 THEN
        IF items = 2 THEN
            'SORT TWO VALUE
            IF a(rightindex) < a(leftindex) THEN SWAP a(rightindex), a(leftindex)
        ELSEIF items <= doalternativesort THEN
            'DO ALTERNATIVE SORT
            InsertionSort(a(), leftindex, rightindex)
        ELSE
            'QUICK SORT
            i = leftIndex : j = rightIndex : k = i + j : SHIFT RIGHT k, 1: value = a(k)
            WHILE i <= j
                WHILE a(i) < value
                    INCR i
                WEND
                WHILE a(j) > value
                    DECR j
                WEND
                IF i <= j THEN
                    SWAP a(i), a(j) : INCR i : DECR j
                END IF
            WEND
            IF leftIndex < j THEN CodeSort(a(), leftIndex, j)
            IF i < rightIndex THEN CodeSort(a(), i, rightIndex)
        END IF
    END IF
END SUB

SUB InsertionSort(a() AS vtype, BYVAL leftindex AS LONG, BYVAL rightindex AS LONG)
    REGISTER i AS LONG
    REGISTER j AS LONG
    LOCAL value AS vtype

    FOR i = leftindex + 1 TO rightindex
        value = a(i)
        j = i - 1
        WHILE j >= leftindex AND a(j) > value
            a(j + 1) = a(j)
            DECR j
        WEND
        a(j + 1) = value
    NEXT i
END SUB
'
�


This is from  Pierre:

Code Select Expand

#Compile Exe
#Dim All
#Include "Win32Api.inc"

%Array_Sort_Ascending   = 0&
%Array_Sort_Descending  = 1&

'----------------------------------------------------------------------------------------------
  Function pDataCalc(ByVal pData As Dword, ByVal lDataLen As Dword, ByVal lIdx As Dword) As Dword
    Function = pData + (lDataLen * (lIdx - 1&))
  End Function

  Function sDataGet(ByVal pData As Dword, ByVal lDataLen As Dword, ByVal lIdx As Dword) As String
    Function = Peek$(pDataCalc(pData, lDataLen, lIdx), lDataLen)
  End Function

  Function sDataSet(ByVal pData As Dword, ByVal lDataLen As Dword, ByVal lIdx As Dword, ByVal sTemp As String) As Dword
    Poke$ pDataCalc(pData, lDataLen, lIdx), sTemp
  End Function

  Sub Mem_QSort(ByVal pData As Dword, ByVal lDataLen As Dword, ByVal low As Dword, ByVal high As Dword, Optional ByVal lOrder As Dword)
      Local scanUp    As Dword
      Local scanDown  As Dword
      Local mid       As Dword
      Local spivot    As String
      Local sTemp     As String                                                                     

      If Not (high - low > 0&) Then 
          Exit Sub 

      ElseIf (high - low = 1&) Then 
        If lOrder = %Array_Sort_Ascending Then
          If (sDataGet(pData, lDataLen, high) < sDataGet(pData, lDataLen, low)) Then
              sTemp = sDataGet(pData, lDataLen, low)
              sDataSet(pData, lDataLen, low, sDataGet(pData, lDataLen, high))
              sDataSet(pData, lDataLen, high, sTemp)
              Exit Sub 
          End If
        Else
          If (sDataGet(pData, lDataLen, high) > sDataGet(pData, lDataLen, low)) Then
              sTemp = sDataGet(pData, lDataLen, low)
              sDataSet(pData, lDataLen, low, sDataGet(pData, lDataLen, high))
              sDataSet(pData, lDataLen, high, sTemp)
              Exit Sub 
          End If 
        End If       
      End If

      mid = (low + high) / 2&
      sPivot = sDataGet(pData, lDataLen, mid)

      sTemp = sDataGet(pData, lDataLen, mid)
      sDataSet(pData, lDataLen, mid, sDataGet(pData, lDataLen, low))
      sDataSet(pData, lDataLen, low, sTemp)

      scanUp = low + 1& 
      scanDown = high

      Do     
        If lOrder = %Array_Sort_Ascending Then
          Do Until ((scanUp > scanDown) Or (sDataGet(pData, lDataLen, scanUp) > sPivot))
              scanUp = scanUp + 1&
          Loop 
        Else
          Do Until ((scanUp > scanDown) Or (sDataGet(pData, lDataLen, scanUp) < sPivot))
              scanUp = scanUp + 1&
          Loop
        End If                                                                                           

        If lOrder = %Array_Sort_Ascending Then
          Do While (sDataGet(pData, lDataLen, scanDown) > sPivot)
              scanDown = scanDown - 1&
          Loop 
        Else
          Do While (sDataGet(pData, lDataLen, scanDown) < sPivot)
              scanDown = scanDown - 1&
          Loop
        End If                                                                                           

        If (scanUp < scanDown) Then
            sTemp = sDataGet(pData, lDataLen, scanUp)
            sDataSet(pData, lDataLen, scanUp, sDataGet(pData, lDataLen, scanDown))
            sDataSet(pData, lDataLen, scanDown, sTemp)
        End If 
      Loop While (scanUp < scanDown)

      sDataSet(pData, lDataLen, low, sDataGet(pData, lDataLen, scanDown))
      sDataSet(pData, lDataLen, scanDown, sPivot)

      If (low < scanDown - 1& ) Then Mem_QSort(pData, lDataLen, low          , scanDown - 1&, lOrder)
      If (scanDown + 1& < high) Then Mem_QSort(pData, lDataLen, scanDown + 1&, high         , lOrder)
  End Sub


'----------------------------------------------------------------------------------------------


Type MyType
  sName   As String * 10
  sValue  As String * 10
  sCount  As String * 10
End Type

Function PBMain() As Long
  Local pData     As Dword
  Local idx       As Long

  Dim MyArray(1 To 9) As MyType

  Randomize 
  For idx = 1 To UBound(MyArray)
    MyArray(idx).sValue = Format$(Rnd(1, 10))
    MyArray(idx).sName  = Choose$(Val(MyArray(idx).sValue), "one", "two", "three", "four", "five", "six", "seven", "height", "nine", "ten")
    MyArray(idx).sCount = Using$("*0######", Rnd(1, 100000))
  Next

  pData = VarPtr(MyArray(1))

  MsgBox "Before Sort> " & $CrLf & ArrayJoin(MyArray(), $CrLf) 
  Mem_QSort(pData, SizeOf(MyArray(1)), 1, UBound(MyArray), %Array_Sort_Ascending)
  MsgBox "After Sort ascending> " & $CrLf & ArrayJoin(MyArray(), $CrLf)
  Mem_QSort(pData, SizeOf(MyArray(1)), 1, UBound(MyArray), %Array_Sort_Descending)
  MsgBox "After Sort descending> " & $CrLf & ArrayJoin(MyArray(), $CrLf)

End Function

Function ArrayJoin(ByRef lArray() As MyType, ByVal sDelim As String) As String
  Local idx       As Long
  Local sBuffer   As String

  For idx = 1 To UBound(lArray)
    sBuffer += lArray(idx) & sDelim
  Next
  Function = sBuffer
End Function