## benchmark sorts

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

### benchmark sorts

2018 Nov 20

- updated with Munair's quicksort

2017 Dec 4

- tweaked comb sort
- mesg = " " initialization, based on jj2007's post

Code: Select all

`/' benchmark sorts - 2018 Nov 21 - by dafhi  Info:   1. collection of a few standard sorts  2. fairly consistent performance framework  updates - tweaked comb sort - sub Main():  mesg = " " '/'' sort direction#define direction <'' ------- sort thisType vector3d  As double         x,y,z  as uinteger       colorEnd Type'' element#define dot .zType SORT_TYPE as vector3d' ------- timing metrics ============================='Const                 SortElements = 9 * 999dim shared as long    ub_times = 25sub RandomData(a() as SORT_TYPE)  for i as integer = 0 to ubound(a)    a(i)dot = rnd  NextEnd Subfunction Sorted(a() as SORT_TYPE) as boolean  var b = a(0)dot  for p as SORT_TYPE ptr = @a(1) to @a(ubound(a))    if p->z direction b then return FALSE    b = p->z  Next: return TRUEend 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 Operatordim shared as double  times(ub_times)sub InsertionSort_Timings(A() As double,UB As integer=-1,LB As integer=0)  if lb>ub then lb=lbound(a): ub=ubound(a)  var lo=lb: for i as integer=lb+1 to ub: if a(i) < a(lo) then lo=i  next: swap a(lb), a(lo)  For i as integer=lb+1 To ub-1    dim as integer 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 Sub#Macro mac_timer(algo,ret, algorithm_name)  ret.mesg = algorithm_name & " "  for i as integer = 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: InsertionSort_Timings times()  ret.ub+=1  redim preserve ret.a(ret.ub)  ret.a(ret.ub) = times(ub_times/2)  InsertionSort_Timings ret.a()#EndMacro'' ----' ------------------ helpers'#macro vsw(x,y)  if a(y)dot direction a(x)dot then    swap a(x),a(y)  endif#EndMacro ' good with quicksortsub bidi_sel_sort(a() as SORT_TYPE, lb as integer=0, ub as integer=0)  while lb<ub    var lo=lb, hi=lb    for i as integer = lb+1 to ub      if a(i)dot direction a(lo)dot then: lo=i      elseif a(hi)dot direction a(i)dot then: hi=i      endif    Next    vsw(lb, lo):  if hi=lb then hi=lo    vsw(hi, ub):  lb+=1: ub-=1  wendEnd Subdim shared as SORT_TYPE sw_tempDim shared As typeof(sw_temp dot) pivot' standard quicksort by MunairSub QuickSort(qs() As SORT_TYPE, l As integer, r As integer)     if (r-l) < 16 then bidi_sel_sort qs(), l, r:  exit sub        Dim As integer i = l, j = r    pivot = qs((l + r) \ 2)dot    'Dim As typeof(qs(l)dot) pivot = qs((l + r) \ 2)dot     Do        While qs(i)dot direction pivot            i += 1        Wend        While pivot direction qs(j)dot            j -= 1        Wend        If i <= j Then            'sw_temp = qs(i)            'qs(i)=qs(j): qs(j)=sw_temp            Swap qs(i), qs(j)            i += 1            j -= 1        End If    Loop Until i > j     If l < j Then quicksort(qs(), l, j)    If i < r Then quicksort(qs(), i, r)End Sub' ------ quicksort based upon youtube entry - Z5nSXTnD1I4''  many hours tweakingsub ytQS2(a() as SORT_TYPE, lb as integer=0, ub as integer=0)   if (ub-lb) < 17 then bidi_sel_sort a(), lb, ub:  exit sub '' dec 3 update 2 - 55 to 31   var j = (ub+lb)\2  vsw(j,ub)  vsw(j,lb)  vsw(lb,ub) 'After 3 swaps:  [mid][lo][hi]  if lb<ub-1 then    j=ub: var i=lb    while i<j      j-=1      while a(lb)dot direction a(j)dot: j-=1: wend      i+=1      while a(i)dot direction a(lb)dot: i+=1: wend      if j<=i then i=j: exit while      vsw(i,j)    Wend    vsw(lb,j)    i-=1: ytQS2 a(), lb,i              '2017 Dec 3 .. removed If lb<i then ytQS2    j+=1: if j<ub then ytQS2 a(), j,ub  endifend sub' -- comb sort - fast iterative sort' helpersub insertion_sort(a() As SORT_TYPE, l As integer=0, u As integer=0)  var j = l  for i as integer=l+1 to u: if a(i)dot direction a(j)dot then j=i  next:  swap a(l), a(j):  j = l + 1  while j < u    j += 1    var sw = a(j), k = j    while sw dot direction a(j-1)dot      a(j) = a(j-1)      j -= 1    Wend    a(j) = sw    j = k  WendEnd SubSub comb_sort(A() As SORT_TYPE, ub As integer=0, lb As integer=0)  if ub<=lb then lb=lbound(a): ub=ubound(a)  dim as integer gap = ub  While gap > 2    For i as integer = lb To ub - gap      vsw(i, i+gap)    Next    gap *= .75  wend  insertion_sort a(), lb, ubEnd Sub' --------------------function round(in as single, places as ubyte = 2) as string  dim as integer mul = 10 ^ places  return str(csng(int(in * mul + .5) / mul))End Functionsub Main   dim as integer    ub = SortElements - 1  dim as SORT_TYPE a(ub)  dim as tTimings   tA, tB  sleep 250  randomize     #define sort_a mac_timer( quicksort( a(), 0, ubound(a) ), tA, "munair" )  #if 1   #define sort_b mac_timer( ytQS2( a(), 0, ubound(a) ), tB, "ytQS2" )  #else   #define sort_b mac_timer( comb_sort a(), tB, "comb sort" )  #endif   ? " sorting .."  for i as long = 1 to 10    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); "x"  sleepend subMain`
Last edited by dafhi on Nov 21, 2018 22:21, edited 13 times in total.
paul doe
Posts: 912
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: 1890
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: 1134
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: 1890
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: 3029
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: 1238
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: 1134
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: 1238
Joined: Jun 04, 2005 9:51

### Re: benchmark sorts

updated with Munair's quicksort
dodicat
Posts: 5700
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: 7667
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: 5700
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: 7667
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: 1238
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" )`

Return to “Tips and Tricks”

### Who is online

Users browsing this forum: No registered users and 2 guests