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 🚀👨�💻📊🔢💡
#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 �
#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:
#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