## benchmark sorts

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
dafhi
Posts: 1303
Joined: Jun 04, 2005 9:51

### benchmark sorts

Code: Select all

`'' benchmark sorts - 2020 Jan 22 - by dafhi'' 2 very fast quicksorts comparedType vector3d  As double         x,y,z  as uinteger       colorEnd Type' -------------------------------------Type my_SORT_TYPE   as vector3d' -------------------------------------'' comment out the .z for plain var type#define dot   .z'' sort direction#define direction <' -------------------------------------  #define sort_type     as my_sort_typenamespace sorts '' using namespace with intent to create "private" global vars  dim sort_type       sw                'swap var  type my_dot_type    as typeof(sw dot)  #define dot_type    as my_dot_type    #undef int    #define int         as Integer      '' normally pushed to stack (which can be faster)  Dim int j, i      #macro ifswap(x,y)    if a(y)dot direction a(x)dot then      swap a(x),a(y)    endif  #EndMacro    '' excellent with quicksort  sub bidi_sel_sort( a() SORT_TYPE, l int, r int )    while l<r      dim int lo=l      j=l      for i int = l+1 to r        if a(i)dot direction a(lo)dot then: lo=i        elseif a(j)dot direction a(i)dot then: j=i        endif      Next      ifswap(l, lo):  if j=l then j=lo      ifswap(j, r):  l+=1: r-=1    wend  End Sub    #macro SetQSort2(datatype,fname,dot)    Sub fname(a() as datatype, L int, r int) '' Munair quicksort modified      if (r-L) < 13 then bidi_sel_sort a(), L, r:  exit sub      ifswap(L,r) '' L becomes pivot      if L < r - 1 then        var j = r:  i = L        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          ifswap(i,j)        Wend        ifswap(L,j)        i -= 1:  if L < i then fname a(), L, i        j += 1:  if j < r then fname a(), j, r      endif    End Sub  #endmacro      setqsort2( my_sort_type, QS2, dot )    #macro SetQsort(datatype,fname,dot)      Sub fname(a() As datatype,L as integer,r as integer) '' dodicat quicksort modified      if (r-L) < 18 then bidi_sel_sort a(), L, r:  exit sub      ifswap( L, (L+r)\2 ) '' L becomes pivot      Dim as integer i = L:  j = r      While I < J  '' modified i <= j          While a(I)dot direction a(L)dot:I+=1:Wend          While a(L)dot direction a(J)dot:J-=1:Wend      If I<=J Then Swap a(I),a(J): I+=1: J-=1       wend      If J > L Then fname(a(),L,J)      If I < r Then fname(a(),I,r)  End Sub  #endmacro    setqsort( my_sort_type, dodi_q, dot )  end namespace' ------- timingConst                 SortElements = 9 * 599dim shared as long    ub_times = 15sub RandomData(a() SORT_TYPE)  for i int = 0 to ubound(a)    a(i)dot = rnd  NextEnd Subfunction Sorted(a() SORT_TYPE) as boolean  var b = a(0)dot, correct = true  for p as my_SORT_TYPE ptr = @a(1) to @a(ubound(a))    if p->z direction b then correct=FALSE: exit for    b = p->z  Next  if not correct then   for p as my_SORT_TYPE ptr = @a(0) to @a(ubound(a))     ? p->z; " ";   Next: ?  end if: return correctend functiontype tTimings  as long           ub = -1  as double         a(any)  as string         mesg  declare operator  cast as string  declare operator  cast as double  declare operator  cast as singleEnd Typeoperator tTimings.cast as string:  return str(a(ub/2))End Operatoroperator tTimings.cast as double:  return a(ub/2)End Operatoroperator tTimings.cast as single:  return a(ub/2)End Operatorsub Sort_Times(A() As double,UB int=-1,LB int=0)  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 as double sw=a(j): j=i: while sw < a(j)        a(j+1)=a(j): j-=1: wend: a(j+1)=sw: endif: NextEnd Subdim shared as double  times(ub_times)#Macro mac_timer(algo,ret, algorithm_name)  ret.mesg = algorithm_name & " "  for i int = 0 to ub_times    RandomData a()    dim as double t = timer      algo    times(i) = timer - t    If not Sorted( a() ) then ? "sort error! "; ret.mesg  Next: 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' ---------------#Define flr(x) (((x)*2.0-0.5)shr 1) '' Stonemonkey's floor()function round(in as single, places as ubyte = 2) as string  dim int mul = 10 ^ places  return str(csng(flr(in * mul + .5) / mul))End Functionsub Main   dim int    ub = SortElements - 1  dim SORT_TYPE a(ub)  dim as tTimings   tA, tB  sleep 250  randomize      #define sort_a mac_timer( dodi_q( a(), 0, ubound(a) ), tA, "dodicat qsort" )    #define sort_b mac_timer( qs2( a(), 0, ubound(a) ), tB, "qs2" )    using sorts ''namespace   ? " sorting .."  for i as long = 1 to 31    sleep 15    if rnd<.5 then 'algorithm sequence can make a difference      sort_a      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, 3); "x"  sleepend subMain`
Last edited by dafhi on Jan 23, 2020 4:59, edited 14 times in total.
paul doe
Posts: 1028
Joined: Jul 25, 2017 17:22
Location: Argentina

### Re: benchmark sorts

Nice! Very useful, thanks.
You have two warnings in the code:

Code: Select all

`FbTemp.bas(219) warning 3(1): Passing different pointer types, at parameter 1 (algo) of PARTITION()FbTemp.bas(221) warning 3(1): Passing different pointer types, at parameter 1 (algo) of PARTITION()`

The last parameter of both signatures should be the same, either both long, or both integer, for FB to stop complaining ;)

Code: Select all

`'' this is the comb_sort signatureSub comb_sort(A() As mysorttype, lb As integer=0, ub As integer=0, k as long=1)'' and this is the ytQS2 signaturesub ytQS2(a() as mysorttype, lb as integer=0, ub as integer=0, q as integer=1)`
srvaldez
Posts: 2177
Joined: Sep 25, 2005 21:54

### Re: benchmark sorts

on my Mac with optimize level -Ofast

Code: Select all

` winner:  ytQS2   0.5809945 .. 1.72x`
jj2007
Posts: 1287
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

### Re: benchmark sorts

dafhi wrote:update 2 - adjusted timing window

Code: Select all

`  var s = 0f, mesg = ""  if tA<tB then    s = tA / tB: mesg = tA.mesg  else    s = tB / tA: mesg = tB.mesg  EndIf`

I get some errors here for s=...:

Code: Select all

`\TmpFile.bas(230) error 24: Invalid data typesJ:\AllBasics\FreeBasic\tmp\TmpFile.bas(232) error 180: Invalid assignment/conversionJ:\AllBasics\FreeBasic\tmp\TmpFile.bas(234) error 180: Invalid assignment/conversion`
srvaldez
Posts: 2177
Joined: Sep 25, 2005 21:54

### Re: benchmark sorts

no problems here, tested with FB versions 1.04, 1.05 and 1.06 both 32 and 64 bit, what version are you using?
MrSwiss
Posts: 3329
Joined: Jun 02, 2013 9:27
Location: Switzerland

### Re: benchmark sorts

Code: Select all

`function Sorted(a() as MySortType) as uinteger  var b = a(0)dot  for p as MySortType ptr = @a(1) to @a(ubound(a))    if b b2 p->z then return FALSE    b = p->z  Next: return TRUEend function`
Seeing the return type: uinteger (which size? FBC 32 = ULong, FBC 64 = ULongInt) and,
return TRUE -- ???
IMHO, a return TRUE is only correct, with a Boolean type (return parameter)!

While a signed int. (any size) might be acceptable, any unsigned int. should at least,
trow a: WARNING: "incompatible variable assignment" ... (trying to assign: -1).
dafhi
Posts: 1303
Joined: Jun 04, 2005 9:51

### Re: benchmark sorts

jj2007 - hopefully MrSwiss caught the error (which I fixed)

srvaldez - I use O 3
jj2007
Posts: 1287
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

### Re: benchmark sorts

srvaldez wrote:no problems here, tested with FB versions 1.04, 1.05 and 1.06 both 32 and 64 bit, what version are you using?

FreeBASIC Compiler - Version 1.05.0 (01-31-2016), built for win32 (32bit)
Copyright (C) 2004-2016 The FreeBASIC development team.
standalone

Code: Select all

`  var s = 0f, mesg = ""  if tA<tB then    s = tA / tB: mesg = tA.mesg  else    s = tB / tA: mesg = tB.mesg  EndIf`

Code: Select all

`TmpFile.bas(232) error 24: Invalid data typesTmpFile.bas(234) error 180: Invalid assignment/conversionTmpFile.bas(236) error 180: Invalid assignment/conversion`

The culprit is mesg; it works with

Code: Select all

`  dim mesg as string=""  var s = 0f`

Code: Select all

` winner:  ytQS2 0.7036515 .. 1.42x`
dafhi
Posts: 1303
Joined: Jun 04, 2005 9:51

### Re: benchmark sorts

updated with Munair's quicksort
dodicat
Posts: 6084
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: benchmark sorts

Here is how I generalise the standard quicksort.

Code: Select all

`'=========================================#define up <,>#define down >,<#macro SetQsort(datatype,fname,b1,b2,dot)Sub fname(array() As datatype,begin As Long,Finish As Ulong)    Dim As Long i=begin,j=finish     Dim As datatype x =array(((I+J)\2))    While  I <= J        While array(I)dot b1 X dot:I+=1:Wend            While array(J)dot b2 X dot:J-=1:Wend                If I<=J Then Swap array(I),array(J): I+=1:J-=1            Wend            If J > begin Then fname(array(),begin,J)            If I < Finish Then fname(array(),I,Finish)        End Sub        #endmacro  '===========================================               #macro printout(a)        For n As Long=Lbound(a) To Ubound(a)            #if typeof(a)<>udt            Print n, a(n)            #else            Print n,a(n).x,a(n).y,a(n).z,a(n).s            #endif        Next        Print        #endmacro                        randomize        'set up required sorts          SetQsort(Integer,sortintegerup,up,)        SetQsort(Double,sortdoubledown,down,)        SetQsort(String,sortstringup,up,)                Type udt            As single x,y,z            as string * 2 s        End Type                SetQsort(udt,sortudtZup,up,.z)  '----------------------------------              Dim As Integer i(3 To 9)        For n As Long=3 To 9            i(n)=Rnd*20        Next        sortintegerup(i(),3,9)        printout(i)                Dim As Double j(5)        For n As Long=0 To 5            j(n)=Rnd*20        Next        sortdoubledown(j(),0,5)        printout(j)                 Dim As String k(...)={"Free","Commercial","Students","Expensive"}        sortstringup(k(),Lbound(k), Ubound(k))        printout(k)                        Dim As udt z(1 To 4)        For n As Long=1 To 4            z(n)=Type(Rnd*10,Rnd*10,Rnd*10,str(n))        Next                printout(z)        sortudtZup(z(),1,4)        printout(z)               Sleep                                  `
D.J.Peters
Posts: 7904
Joined: May 28, 2005 3:28

### Re: benchmark sorts

@dodicat here are how you can make your macro faster for free

B>A is faster than A<=B
DON'T use SWAP
use the native INTEGER for array index and loop counters (32 vs 64-bit)
...

Joshy

Code: Select all

`#macro SetQsort(datatype,fname,b1,b2,dot)Sub fname(array() As datatype,begin As integer,Finish As integer)  Dim As integer iLeft=begin,iRight=finish  Dim As datatype tmp,x = array(((begin+finish)\2))  While iRight>iLeft ' !!! I <= J    While array(iLeft )dot b1 x dot:iLeft +=1:Wend    While array(iRight)dot b2 x dot:iRight-=1:Wend    if iLeft>iRight then exit while      ' !!! If I<=J Then      ' !!! Swap array(I),array(J)    tmp=array(iLeft) : array(iLeft)=array(iRight) : array(iRight)=tmp    iLeft+=1:iRight-=1    ' !!! end if    Wend  If iRight > begin  Then fname(array(),begin,iRight)  If iLeft  < Finish Then fname(array(),iLeft,Finish)End Sub#endmacro`
dodicat
Posts: 6084
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: benchmark sorts

Thanks D.J.Peters.
Your method is faster when using optimised gcc.
Also faster when using -gen gas.
Unoptimised gcc seems to be slower on 32 bits and about the same on 64 bits.
Swap is slower -agreed.
Integer, even on 64 bits is faster than long -- agreed.

10 runs for each method.

Code: Select all

` #define up <,>#define down >,<#macro SetQsort(datatype,fname,b1,b2,dot)Sub fname(array() As datatype,begin As integer,Finish As integer)  Dim As integer iLeft=begin,iRight=finish  Dim As datatype  x = array(((begin+finish)\2))  dim as datatype tmp  While iRight>iLeft ' !!! I <= J    While array(iLeft )dot b1 x dot:iLeft +=1:Wend    While array(iRight)dot b2 x dot:iRight-=1:Wend    if iLeft>iRight then exit while      ' !!! If I<=J Then      ' !!! Swap array(I),array(J)      ''swap array(iLeft),array(iright) 'slow    tmp=array(iLeft) : array(iLeft)=array(iRight) : array(iRight)=tmp    iLeft+=1:iRight-=1    ' !!! end if    Wend  If iRight > begin  Then fname(array(),begin,iRight)  If iLeft  < Finish Then fname(array(),iLeft,Finish)End Sub#endmacro#macro SetQsort2(datatype,fname,b1,b2,dot)Sub fname(array() As datatype,begin As integer,Finish As integer)    Dim As integer i=begin,j=finish     Dim As datatype x =array(((I+J)\2))    While  I <= J        While array(I)dot b1 X dot:I+=1:Wend            While array(J)dot b2 X dot:J-=1:Wend                If I<=J Then Swap array(I),array(J): I+=1:J-=1            Wend            If J > begin Then fname(array(),begin,J)            If I < Finish Then fname(array(),I,Finish)        End Sub        #endmacro         type v3    as single x,y,zend typedim as double addtimessetqsort2(v3,sortz2,down,.z)setqsort(v3,sortz,down,.z)sub set(x() as v3)    randomize 1redim  x(5000000)for n as long=0 to ubound(x)    x(n)=type(rnd,rnd,rnd)nextend subredim as v3 x()set(x())sortz2(x(),0,ubound(x))  'warm upprint "original"for n as long=1 to 10set(x())dim as double t=timer,t2sortz2(x(),0,ubound(x))t2=timeraddtimes+=t2-tprint t2-tnext nprintprint "total + check value "; addtimes,x(111222).zsleep 50printprintaddtimes=0print "D.J.Peters"for n as long=1 to 10set(x())dim as double t=timer,t2sortz(x(),0,ubound(x))t2=timeraddtimes+=t2-tprint t2-tnext nprintprint "total + check value "; addtimes,x(111222).zsleep `
D.J.Peters
Posts: 7904
Joined: May 28, 2005 3:28

### Re: benchmark sorts

@dafhi why do you ignore the FreeBASIC pointer quick sort in your benchmark ?

Joshy
dafhi
Posts: 1303
Joined: Jun 04, 2005 9:51

### Re: benchmark sorts

when I developed 'ytQSort2' it took me at least 2 days to get it working. quicksort, it would seem, is one of my achilles' heels.

D. J. Peters when I run your pointer sort (latest WinFBE which uncludes fbc 1.06) it still shows Munair's version faster.
Have you tried your sort with my profiler?

Code: Select all

`dim shared as SORT_TYPE sw_temp' ' https://www.freebasic.net/forum/viewtopic.php?f=7&t=27173'sub quicksortPointer(l as SORT_TYPE ptr, r as SORT_TYPE ptr)  'if (r - l <= 1) then return  dim as SORT_TYPE ptr  p=l+1, ii=p  'dim as SORT_TYPE t=any  while (p <= r)     if (*(p)dot < *(l)dot) then sw_temp=*p: *p=*ii: *ii=sw_temp: ii+=1'     if (*(p)dot < *(l)dot) then swap *ii,*p: ii+=1    p+=1  wend  p=ii-1:sw_temp=*l:*l=*p:*p=sw_temp  'swap *l, *p  if l<p then quicksortPointer(l, p)  if ii<r then quicksortPointer(ii, r)end sub..   #define sort_b mac_timer( quicksortpointer( @a(0), @a(ubound(a)) ), tB, "qs_djp" )`