Code: Select all
/' benchmark sorts - 2021 Sep 4 - by dafhi
2 fast quicksorts compared
project features:
sort validation
'/
#define def #define
#undef int
def int as Integer
def sng as single
def dbl as double
Type v3
int x,y,z
'As double x,y,z
End Type
type my_sort_type as v3
def dot .z
'' normally pushed to stack (which can be mildly faster)
Dim shared int j, i
dim shared as my_sort_type x, tmp, pivot
def direction <
#macro ifswap(x,y)
if a(y)dot direction a(x)dot then
swap a(x),a(y)
'tmp=a(x) : a(x)=a(y) : a(y)=tmp
endif
#EndMacro
#macro SetQsort3(datatype,fname,dot) '' dodicat's macro concept
Sub fname(a() as datatype, L int, r int)
/' -- quicksort by dafhi - 2020 Jan 26
fast, but sorted lists give O(n^2)
suggest pre-shuffle:
for i in list step 3: swap a(i), a(random element)
'/
ifswap(L,r) '' L becomes pivot
if L < r - 1 then
var j=r, i=L '' shared var i
whiLe i < j
j -= 1: whiLe a(L)dot direction a(j)dot: j-=1: wend
i += 1: while a(i)dot direction a(L)dot: i+=1: wend
if j<=i then i=j: exit while
tmp=a(i) : a(i)=a(j) : a(j)=tmp
Wend
ifswap(L,i)
i -= 1: if L < i then fname a(), L, i
j += 1: if j < r then fname a(), j, r
endif
End Sub
#EndMacro
#macro SetQsort(datatype,fname,dot)
Sub fname(a() As datatype,begin As Long,Finish As Long)
Dim As Long i=begin,j=finish
'Dim As datatype x =a((I+J)\2)
x = a((I+J)\2)
While I <= J
While a(I)dot direction X dot:I+=1:Wend
While x dot direction a(J)dot:J-=1:Wend
If I<=J Then tmp=a(i) : a(i)=a(j) : a(j)=tmp: I+=1:J-=1
wend
'if a(j) dot = x dot then j-=1: i+=1
If J > begin Then fname(a(),begin,J)
If I < Finish Then fname(a(),I,Finish)
End Sub
#endmacro
#macro SetQsortp(datatype,fname,dot)
Sub fname(a() As datatype,l int,r int)
'Dim As datatype x = a( (l+r)\2 )
x = a( (l+r)\2 )
var i=l, j=r
While j > i
While a(i)dot direction x dot:i +=1:Wend
While x dot direction a(j)dot:j-=1:Wend
if i>j then exit while
tmp=a(i) : a(i)=a(j) : a(j)=tmp
i+=1:j-=1
Wend
If j > l Then fname a(),l,j
If i < r Then fname a(),i,r
End Sub
#endmacro
#macro SetQsort_nSquaredResist(datatype,fname,dot) '' dodicat's macro system
Sub fname(a() as datatype, L int, r int)
'' n^2 resistant & faster than average well-balanced quicksort
var j=(l+r)\2
ifswap(j,r)
ifswap(L,r) '' L becomes pivot
ifswap(j,l)
if L < r - 1 then
j=r: i=L '' shared var i
whiLe i < j
j -= 1: whiLe a(L)dot direction a(j)dot: j-=1: wend
i += 1: while a(i)dot direction a(L)dot: i+=1: wend
if j<=i then i=j: exit while
tmp=a(i) : a(i)=a(j) : a(j)=tmp
Wend
ifswap(L,i)
i -= 1: if L < i then fname a(), L, i
j += 1: if j < r then fname a(), j, r
endif
End Sub
#endmacro
setqsort( my_sort_type, q, dot )
setqsort3( my_sort_type, q3, dot )
setqsortp( my_sort_type, qp, dot )
def flr(x) (((x)*2.0-0.5)shr 1) '' Stonemonkey's floor()
' ------- timing ---------------------
'
Const Elements = 49999
dim shared as long ub_times = 3
dim shared as my_sort_type ga(any)
setqsort_nSquaredResist( my_sort_type, qs_n2Resist, dot )
sub RandomData(a() as my_sort_type)
var c = ubound(a) + 1
'' generate some values
for i int = 1 to c-1: a(i)dot = rnd: Next
'for i int = 1 to c-1: a(i)dot = a(i-1)dot + flr(rnd+.5): Next
'' sort using a known correct
q a(), 0, c-1
'' copy for sort validation
for i int = 0 to c-1: ga(i) = a(i): next
'' shuffle
for i int = 0 to c-1 step 3: swap a(i), a(flr(rnd*c)): Next
End Sub
function Sorted(a() as my_sort_type) as boolean
var correct = true, b = a(0)dot
for i int = 0 to ubound(a)
if a(i)dot <> ga(i)dot then correct = false: exit for
Next
return correct
end function
type tTimings
as long ub = -1
dbl a(any)
as string mesg
declare operator cast as string
declare operator cast dbl
declare operator cast sng
End Type
operator tTimings.cast as string: return str(a(ub/2))
End Operator
operator tTimings.cast dbl: return a(ub/2)
End Operator
operator tTimings.cast sng: return a(ub/2)
End Operator
sub Sort_Times(A() As double, UB int = -1, LB int = 0) '' an insertion sort
if lb>ub then lb=lbound(a): ub=ubound(a)
var lo=lb
for i int=lb+1 to ub
if a(i) < a(lo) then lo=i
next
swap a(lb), a(lo)
For i int=lb+1 To ub-1
dim int j=i+1
if a(j) < a(i) then
dim dbl sw=a(j): j=i
while sw<a(j): a(j+1)=a(j): j-=1: wend
a(j+1)=sw
endif
Next
End Sub
dim shared dbl times(ub_times)
#Macro mac_timer(algo, ret, algorithm_name)
ret.mesg = algorithm_name & " "
for i int = 0 to ub_times
RandomData a()
var t = timer
algo
times(i) = timer - t
If not Sorted( a() ) then ? "sort error! "; ret.mesg
Next
'' outliers may skew average
Sort_Times times()
ret.ub+=1
redim preserve ret.a(ret.ub)
ret.a(ret.ub) = times(ub_times/2)
Sort_Times ret.a()
#EndMacro
'
' --------------- timing mechanism
function round(in sng, places as ubyte = 2) as string
dim int mul = 10 ^ places
return str(csng(flr(in * mul + .5) / mul))
End Function
sub Main
dim int ub = Elements - 1
dim as my_sort_type a(ub)
redim ga(ub) '' original list for for verification
dim as tTimings tA, tB
#if 1
'def sort_a mac_timer( q2( a(), 0, ubound(a) ), tA, "q2" )
def sort_a mac_timer( q( a(), 0, ubound(a) ), tA, "q" )
#else
def sort_b mac_timer( qs_n2resist( a(), 0, ubound(a) ), tB, "n2 resist" )
#endif
#if 1
def sort_b mac_timer( q3( a(), 0, ubound(a) ), tB, "q3" )
'def sort_b mac_timer( q( a(), 0, ubound(a) ), tB, "q" )
#elseif 0
def sort_b mac_timer( q2( a(), 0, ubound(a) ), tB, "q2" )
#else
'def sort_b mac_timer( qp( a(), 0, ubound(a) ), tB, "qptr" )
#endif
sleep 250
randomize
? " sorting .."
for i int = 1 to 29
if i mod 2=0 then sleep 1
if rnd<.5 then
sort_a 'order can make a difference
sort_b
else
sort_b
sort_a
endif
next
cls
var s = 0f, mesg = " "
if tA<tB then
s = tA / tB: mesg = tA.mesg
else
s = tB / tA: mesg = tB.mesg
EndIf
?
? " winner: "; mesg
?
? s; " .. "; round(1 / s, 4); "x"
sleep
end sub
Main