benchmark sorts

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

benchmark sorts

Postby dafhi » Dec 03, 2017 10:06

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 this
Type vector3d
  As double         x,y,z
  as uinteger       color
End Type

'' element
#define dot .z


Type SORT_TYPE as vector3d

' ------- timing metrics =============================
'
Const                 SortElements = 9 * 999

dim shared as long    ub_times = 25

sub RandomData(a() as SORT_TYPE)
  for i as integer = 0 to ubound(a)
    a(i)dot = rnd
  Next
End Sub

function 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 TRUE
end function

type 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 single
End Type
operator tTimings.cast as string:  return str(a(ub/2))
End Operator
operator tTimings.cast as double:  return a(ub/2)
End Operator
operator tTimings.cast as single:  return a(ub/2)
End Operator

dim 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: Next
End 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 quicksort
sub 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
  wend
End Sub


dim shared as SORT_TYPE sw_temp
Dim shared As typeof(sw_temp dot) pivot

' standard quicksort by Munair
Sub 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 tweaking
sub 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
  endif
end sub

' -- comb sort - fast iterative sort

' helper
sub 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
  Wend
End Sub

Sub 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, ub
End 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 Function

sub 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"

  sleep
end sub

Main
Last edited by dafhi on Nov 21, 2018 22:21, edited 13 times in total.
paul doe
Posts: 922
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: benchmark sorts

Postby paul doe » Dec 03, 2017 11:05

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 signature
Sub comb_sort(A() As mysorttype, lb As integer=0, ub As integer=0, k as long=1)

'' and this is the ytQS2 signature
sub ytQS2(a() as mysorttype, lb as integer=0, ub as integer=0, q as integer=1)
srvaldez
Posts: 2111
Joined: Sep 25, 2005 21:54

Re: benchmark sorts

Postby srvaldez » Dec 03, 2017 15:12

on my Mac with optimize level -Ofast

Code: Select all

 winner:  ytQS2 

 0.5809945 .. 1.72x
jj2007
Posts: 1242
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: benchmark sorts

Postby jj2007 » Dec 03, 2017 16:20

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 types
J:\AllBasics\FreeBasic\tmp\TmpFile.bas(232) error 180: Invalid assignment/conversion
J:\AllBasics\FreeBasic\tmp\TmpFile.bas(234) error 180: Invalid assignment/conversion
srvaldez
Posts: 2111
Joined: Sep 25, 2005 21:54

Re: benchmark sorts

Postby srvaldez » Dec 03, 2017 16:34

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: 3274
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: benchmark sorts

Postby MrSwiss » Dec 03, 2017 16:41

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 TRUE
end 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: 1251
Joined: Jun 04, 2005 9:51

Re: benchmark sorts

Postby dafhi » Dec 03, 2017 18:28

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

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

Re: benchmark sorts

Postby jj2007 » Dec 03, 2017 21:45

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 types
TmpFile.bas(234) error 180: Invalid assignment/conversion
TmpFile.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: 1251
Joined: Jun 04, 2005 9:51

Re: benchmark sorts

Postby dafhi » Nov 21, 2018 14:46

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

Re: benchmark sorts

Postby dodicat » Nov 21, 2018 16:50

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: 7828
Joined: May 28, 2005 3:28

Re: benchmark sorts

Postby D.J.Peters » Nov 21, 2018 21:31

@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: 5951
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: benchmark sorts

Postby dodicat » Nov 22, 2018 14:07

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,z
end type

dim as double addtimes

setqsort2(v3,sortz2,down,.z)
setqsort(v3,sortz,down,.z)


sub set(x() as v3)
    randomize 1
redim  x(5000000)
for n as long=0 to ubound(x)
    x(n)=type(rnd,rnd,rnd)
next
end sub

redim as v3 x()

set(x())
sortz2(x(),0,ubound(x))  'warm up

print "original"
for n as long=1 to 10
set(x())
dim as double t=timer,t2
sortz2(x(),0,ubound(x))
t2=timer
addtimes+=t2-t
print t2-t
next n
print
print "total + check value "; addtimes,x(111222).z
sleep 50
print
print
addtimes=0
print "D.J.Peters"
for n as long=1 to 10
set(x())
dim as double t=timer,t2
sortz(x(),0,ubound(x))
t2=timer
addtimes+=t2-t
print t2-t
next n
print
print "total + check value "; addtimes,x(111222).z
sleep

 
D.J.Peters
Posts: 7828
Joined: May 28, 2005 3:28

Re: benchmark sorts

Postby D.J.Peters » Nov 22, 2018 15:30

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

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

Re: benchmark sorts

Postby dafhi » Nov 22, 2018 18:43

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 43 guests