timing program for sort routine's

General FreeBASIC programming questions.
frisian
Posts: 231
Joined: Oct 08, 2009 17:25

timing program for sort routine's

Postby frisian » Apr 30, 2011 15:00

Writing a program to time different sort routine's is something I always wanted to
do but never did. But after seeing dodicat's visual sorts I felt that is was time for
me to write it. Because giving a time and at the same time making visualize what
going on during the sort is not ideal. Also timing small array's gives different
result because some sort routine's perform better on larger array's then small one's

The routine's are taken from dodicat's visual sorts, the part needed to show what
goes on was removed. The result from the MD Quicksort was strange so I added
two other Quick-sort’s for comparison. The MD Quicksort is not only slow on
reversed and already sorted array's it also need lots memory in both cases and
if array only has equal elements. The two other quick-sort’s are fast in every
aspect of the test and don't need extra memory.

Code: Select all


' compile with -t 30000
' if it crashes on MDquicksort you have to increase the stack size

' timings for different sort routine's
' simple and clean sort's, only sorting 1 array ascending
' Sort routine's take from dodicat's visuals sort.
' remove the part needed for making the sort visual.
' MD renamed to MDquicksort. MDquicksort has a problem with array that are
' reversed, already sorted or equal array, it becomes
' very slow and start to get memory hungry
' compile with -t 30000, perhaps less not tryed
' bubble sort is slow so be a litte patience
' added YQSort and Quicksort2 for comparence with MDquicksort

' macro sort_1 = sort(array())
' macor sort_2 = sort(lower limit, upper limit, array)
' macro sort_3 = sort(array(), lower limit, upper limit)

#Macro sort_1(sortname)
RSet buffer,#sortname
Print buffer;
copy_array(rev(),sort())
t1 = Timer
sortname(sort())
t2 = Timer - t1
Print Using "  ###.###";t2;
Print " sec";
copy_array(ran(),sort())
t1 = Timer
sortname(sort())
t2 = Timer - t1
Print Using "  ###.###";t2;
Print " sec";
t1 = Timer
sortname(sort())
t2 = Timer - t1
Print Using "  ###.###";t2;
Print " sec";
copy_array(eq(),sort())
t1 = Timer
sortname(sort())
t2 = Timer - t1
Print Using "  ###.###";t2;
Print " sec"
#EndMacro


#Macro sort_2(sortname)
RSet buffer,#sortname
Print buffer;
copy_array(rev(),sort())
t1 = Timer
sortname(LBound(sort),UBound(sort),sort())
t2 = Timer - t1
Print Using "  ###.###";t2;
Print " sec";
copy_array(ran(),sort())
t1 = Timer
sortname(LBound(sort),UBound(sort),sort())
t2 = Timer - t1
Print Using "  ###.###";t2;
Print " sec";
t1 = Timer
sortname(LBound(sort),UBound(sort),sort())
t2 = Timer - t1
Print Using "  ###.###";t2;
Print " sec";
copy_array(eq(),sort())
t1 = Timer
sortname(LBound(sort),UBound(sort),sort())
t2 = Timer - t1
Print Using "  ###.###";t2;
Print " sec"
#EndMacro

#Macro sort_3(sortname)
RSet buffer,#sortname
Print buffer;
copy_array(rev(),sort())
t1 = Timer
sortname(sort(),LBound(sort), UBound(sort))
t2 = Timer - t1
Print Using "  ###.###";t2;
Print " sec";
copy_array(ran(),sort())
t1 = Timer
sortname(sort(),LBound(sort), UBound(sort))
t2 = Timer - t1
Print Using "  ###.###";t2;
Print " sec";
t1 = Timer
sortname(sort(),LBound(sort), UBound(sort))
t2 = Timer - t1
Print Using "  ###.###";t2;
Print " sec";
copy_array(eq(),sort())
t1 = Timer
sortname(sort(),LBound(sort), UBound(sort))
t2 = Timer - t1
Print Using "  ###.###";t2;
Print " sec"
#EndMacro


Sub bubblesort(array() As Double)
  Dim As Integer n=UBound(array)
  For p1 As Integer = 0 To n - 1
    For p2 As Integer  = p1 + 1 To n
      'change >= to > , don't swap if they are equal
      If (array(p1)) > (array(p2)) Then Swap array(p1),array(p2)
    Next p2
  Next p1
  For n = LBound(array) To UBound(array)-1
    If array(n) > array(n+1) Then Beep
  Next
End Sub

Sub exchangesort(array() As Double)
  For i As Integer=0 To UBound(array)
    Dim As Integer min=i
    For j As Integer=i+1 To UBound(array)
      If (array(j) < array(min)) Then min=j
    Next j
    If min>i Then Swap array(i), array(min)
  Next i
End Sub

Sub shellsort(array() As Double)
  Dim As Integer half=UBound(array)/2,limit,switch
  While half>0
    limit = UBound(array) - half
    Do
      switch = 0
      For x As Integer= 0 To limit
        If array(x) >array(x + half) Then
          Swap array(x),array(x + half)
          switch = 1 ' switch = x  bad idea, x can be 0, you never know
        EndIf
      Next x
    Loop Until switch=0
    half = half \ 2
  Wend
End Sub

Sub insertionsort(array() As Double)
  Dim As Double temp,temp2
  Dim As Integer j
  For row As Integer= 1 To UBound(array)
    temp = array(row)
    temp2 = temp
    j = row
    While j>=1 AndAlso array(j-1)>temp2
      array(j) = array(j - 1)
      j=j-1
    Wend
    array(j)=temp
  Next row
End Sub
'_________________________________ QUICKSORT
' replaced long by integer
' MD renamed to MDquicksort
Sub MDquicksort(g As Integer,d As Integer,a()As Double)
  Dim As Double v,t:Dim As Byte o:Dim As Integer i,j
  If g<d Then
    v=a(d):i=g-1:j=d:
    Do
      Do
        i=i+1
      Loop Until a(i)>=v
      o=0
      Do
        'If j>LBound(a) Then
        If j>g then
          j=j-1
        Else
          o=1
        EndIf
        If a(j)<=v Then
          o=1
        EndIf
      Loop Until o<>0
      Swap a(i),a(j)
    Loop Until j<=i
    t=a(j):a(j)=a(i):a(i)=a(d):a(d)=t
    MDquicksort(g,i-1,a())
    MDquicksort(i+1,d,a())
  EndIf
End Sub

Sub gnomesort(a() As Double)
  Dim As Integer _pos=1,last=0
  While _pos < UBound(a)+1
    If a(_pos)>=a(_pos-1) Then
      If last<>0 Then
        _pos=last
        last=0
      EndIf
      _pos=_pos+1
    Else
      Swap a(_pos),a(_pos-1)
      If _pos>1 Then
        If last=0 Then
          last=_pos
        EndIf
        _pos=_pos-1
      Else
        _pos=_pos+1
      EndIf
    EndIf
  Wend
End Sub


Sub DafhiSort(Ary() As Double)
  'BY DAFHI
  Dim As Integer start_=LBound(ary),End_=UBound(ary)
  Dim  As Integer Position_of_Hi, Position_of_Lo, S_ ,J
  Do While Start_ < End_
    Position_of_Hi = Start_
    Position_of_Lo = Start_
    S_ = Start_ + 1
    For J = S_ To End_
      If Ary(J) > Ary(Position_of_Hi) Then
        Position_of_Hi = J
      ElseIf Ary(J) < Ary(Position_of_Lo) Then
        Position_of_Lo = J
      EndIf
    Next
    'prevent swap conflicts
    If Position_of_Hi = Start_ Then
      If Position_of_Lo <> End_ Then
        'order important!
        Swap  Ary(Position_of_Hi), Ary(End_)
        Swap  Ary(Start_), Ary(Position_of_Lo)
      Else
        Swap  Ary(Start_), Ary(End_)
      EndIf
    Else
      'order important!
      Swap  Ary(Start_), Ary(Position_of_Lo)
      Swap  Ary(Position_of_Hi), Ary(End_)
    EndIf
    Start_ = S_
    End_ = End_ - 1
  Loop
End Sub


' ytwinky quicksort converted to use double
Sub YQSort(a() As Double, l As Integer, r As Integer)
  '(c)longtime ago by someone who could program in pascal
  ' program QSort(pascal) has been successfully ported to FB
  Dim As Integer i=l, j=r
  Dim As Double x=a((l+r)\2)
  Do
    While a(i)<x
      i+=1
    Wend
    While x<a(j)
      j-=1
    Wend
    If i<=j Then
      Swap a(i), a(j)
      i+=1
      j-=1
    EndIf
  Loop Until i>j
  If l<j Then YQSort(a(), l, j)
  If i<r Then YQSort(a(), i, r)
End Sub

Sub QuickSort2(ToSort() As Double, Lower As Integer, Upper As Integer)
  'Standard QuickSort Routine
  Dim Temp As Double
  Dim As Integer First, Last, i, j, StackPtr
  ReDim As Double QStack(Upper\5+10)
  First=lower
  Last=Upper
  Do
    Do
      Temp=ToSort((Last+First)\2)
      i=First
      j=Last
      Do
        While ToSort(i)<Temp
          i=i+1
        Wend
        While ToSort(j)>Temp
          j=j-1
        Wend
        If i>j Then Exit Do
        If i<j Then Swap ToSort(i), ToSort(j)
        i=i+1
        j=j-1
      Loop While i <= j
      If i<Last Then
        QStack(StackPtr)=i
        QStack(StackPtr+1)=Last
        StackPtr=StackPtr+2
      EndIf
      Last=j
    Loop While First<Last
    If StackPtr=0 Then Exit Do
    StackPtr=StackPtr-2
    First=QStack(StackPtr)
    Last=QStack(StackPtr+1)
  Loop
  Erase QStack
End Sub

Sub copy_array(s() As Double, d() As Double)
  For x As Integer = LBound(s) To UBound(s)
    d(x) = s(x)
  Next
End Sub

'===========================
'  MAIN
'===========================

' max is upper limit of the array, make it smaller for faster result or if you have slow computer
' make it bigger for faster computer and better timing of the faster sort routine's
Dim As Integer x, y, max = 50000
Dim As Double t1, t2 , ran(0 To max), sort(0 To max), rev(0 To max), eq(0 To max)
Dim As String buffer = Space(14)

Cls

Print "Starting"

'fill ran() with random numbers and eq() with same number
For x = 0 To max
  ran(x) = Rnd
  rev(x) = ran(x)   ' make reverse array equal to random array
  eq(x) = 1/3
Next

' make the reversed array for testing, first sort then reverse
YQSort(rev(),LBound(rev), UBound(rev))
For  x = LBound(rev) To (UBound(rev) \ 2)
  Swap rev(x),rev(UBound(rev) - x)
Next
'For  x = LBound(rev) To UBound(rev)-1
'  If rev(x) < rev(x+1) Then beep
'Next

Print:Print "May take a while, some routine's are slow (mostly on the random array part)"
Print:Print "                         Array size =";max
Print:Print "                  reversed     random       sorted       equal"

sort_1(bubblesort)
sort_1(exchangesort)
sort_1(shellsort)
sort_1(insertionsort)
sort_1(gnomesort)
sort_1(DafhiSort)
sort_2(MDquicksort)
sort_3(YQSort)
sort_3(QuickSort2)

Print:Print "Finished"
Print:Print:Print:Print "                     -= Hit any key to exit =-"

Sleep
End



some timings for array size = 50000 actual it is 50001
on a Intel Core 2 Duo E7400 2.8Ghz. Win XP + SP 2

Code: Select all

                     Array size = 50000

               reversed    random     sorted      equal
   bubblesort 18.571 sec  15.643 sec  5.100 sec  5.099 sec
 exchangesort  5.380 sec   5.184 sec  5.179 sec  5.179 sec
    shellsort  0.011 sec   0.083 sec  0.003 sec  0.003 sec
insertionsort 12.287 sec   6.169 sec  0.001 sec  0.001 sec
    gnomesort 22.253 sec  11.173 sec  0.000 sec  0.000 sec
    DafhiSort  5.104 sec   4.816 sec  2.797 sec  4.810 sec
  MDquicksort  4.137 sec   0.011 sec  3.535 sec  0.008 sec
       YQSort  0.005 sec   0.012 sec  0.005 sec  0.008 sec
   QuickSort2  0.004 sec   0.010 sec  0.004 sec  0.007 sec

MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Postby MichaelW » Apr 30, 2011 16:14

Your (or dodicat's?) Shell Sort implementation is using a far less than optimal gap sequence.

Code: Select all

'==============================================================================
sub RandomizeArray( array() as double )
    dim as integer low, high, i
    low = lbound(array)
    high = ubound(array)
    for i = low to high
        array(i) = rnd*20000
    next
end sub
'==============================================================================
function BadSort( array() as double ) as integer
    dim as integer low, high, i
    low = lbound(array)
    high = ubound(array)
    for i = low to high - 1
        if array(i) > array(i + 1) then return 1
    next
end function
'==============================================================================
Sub shellsort(array() As double)
  Dim As Integer half=UBound(array)/2,limit,switch
  While half>0
    limit = UBound(array) - half
    Do
      switch = 0
      For x As Integer= 0 To limit
        If array(x) >array(x + half) Then
          Swap array(x),array(x + half)
          switch = 1 ' switch = x  bad idea, x can be 0, you never know
        EndIf
      Next x
    Loop Until switch=0
    half = half \ 2
  Wend
End Sub
'==============================================================================
'-----------------------------------------------------------------------------
'' This implementation, adapted from the second edition of Robert Sedgewick's
'' Algorithms, uses an easy to generate gap sequence that, per the author,
'' better sequences are unlikely to beat by more than 20%.
'-----------------------------------------------------------------------------
sub ShellSortRS( array() as double )
    dim as integer low, high, h, i, j, tmp
    low = lbound(array)
    high = ubound(array)
    h = 1
    do while h <= high + 1
        h = 3 * h + 1
    loop
    do while h >= 3
        h \= 3
        for i = low + h to high
            tmp = array(i)
            j = i
            do while j >= low + h
                if tmp < array(j - h) then
                    array(j) = array(j - h)
                    j -= h
                else
                    exit do
                end if
            loop
            array(j) = tmp
        next
    loop
end sub
'==============================================================================
sub CombSort( array() as double )
    dim as integer low, high, gap, i, size, swapped = 1
    dim as double shrink_factor = 1.3
    low = lbound(array)
    high = ubound(array)
    size = high - low + 1
    gap = size
    do while ( (gap > 1) or swapped )
        if gap > 1 then gap = int(gap / shrink_factor)
        swapped = 0
        i = 0
        do while (gap + i) < size
            if array(i) > array(i + gap) then
                swap array(i), array(i + gap)
                swapped = 1
            end if
            i += 1
        loop
    loop
end sub
'==============================================================================

dim as double t, array( 50000 )

RandomizeArray( array() )
shellsort( array() )
if BadSort( array() ) then print "shellsort error"

RandomizeArray( array() )
ShellSortRS( array() )
if BadSort( array() ) then print "ShellSortRS error"

RandomizeArray( array() )
CombSort( array() )
if BadSort( array() ) then print "CombSort error"
print

sleep 3000

RandomizeArray( array() )
t = timer
shellsort( array() )
print using "ShellSort     ##.####s";timer - t

t = timer
shellsort( array() )
print using "ShellSort     ##.####s";timer - t

RandomizeArray( array() )
t = timer
ShellSortRS( array() )
print using "ShellSortRS   ##.####s";timer - t

t = timer
ShellSortRS( array() )
print using "ShellSortRS   ##.####s";timer - t

RandomizeArray( array() )
t = timer
CombSort( array() )
print using "CombSort      ##.####s";timer - t

t = timer
CombSort( array() )
print using "CombSort      ##.####s";timer - t

sleep


Running on a 500MHz P3:

Code: Select all

ShellSort      0.7222s
ShellSort      0.0378s
ShellSortRS    0.1623s
ShellSortRS    0.0465s
CombSort       0.1669s
CombSort       0.0945s
frisian
Posts: 231
Joined: Oct 08, 2009 17:25

Postby frisian » Apr 30, 2011 19:10

MichaelW

The first 7 sorts in result list are from dodicat's visual sort program I cleaned them up for use in my program.

I know that timing a sort is a tricky business, different random array can produce different timing. A better way would be to take say 10 different random array's and take the average of the total time.

I also are aware of different method of calculating the gap for a shell sort. I seen suggestions like 3*n+1, 2*n+1 or even using Fibonacci numbers. I had in mind to compare the different methods in the future.
I also know that there are more sorts then the one I used and variations on those sorts. The program has three quicksort that are different in the way they work.

I don't claim that my program is prefect.
hopefully answers this your question.

some links i forgot to include in my previous posting.

Seven of the sort are from this posting
http://www.freebasic.net/forum/viewtopic.php?t=17702

Source for YQSort and Quicksort2, the program is a timing/visual sort program outdated and some of the quicksort routine's call a other quicksort routine instead of themself.
http://www.freebasic-portal.de/porticul ... n-513.html

YQsort will sort up or down and can use every FB Type
http://ytwinky.freebasic-portal.de/freebasic/qsort.bas
Use this sort for my program's, simple but does the job
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Postby MichaelW » Apr 30, 2011 22:22

frisian wrote:I don't claim that my program is prefect.

It was not my intent to criticize your program, or dodicat’s code, I was just pointing out that the Shell Sort was nowhere near optimal.
dodicat
Posts: 4495
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » May 01, 2011 2:14

MichaelW wrote:
frisian wrote:I don't claim that my program is prefect.

It was not my intent to criticize your program, or dodicat’s code, I was just pointing out that the Shell Sort was nowhere near optimal.


@ frisian and MichaelW
Thank you for investigating the sorts.
I merely picked up these sorts from previously written algorithms in other languages, Pascal and c, and converted to fb.
My quicksort I've been using for years, and can't remember the origin.
I thought the graphical view would be a bit of fun, so it is not pedantic in any way.

However, I have written a little sort of my own, so I may be forgiven for all the copying.
It's not too fast, but it's a sort.

Code: Select all

'Dodicat sort
Sub sort(unsorted() As Double,sorted() As Double)
    sorted(0)=-1e100 'an arbitrary low number
    For z As Integer=0 To Ubound(unsorted)
        For z2 As Integer=0 To Ubound(sorted)
            If unsorted(z)>sorted(z2) Then
                var _index=z2-Lbound(sorted)
                Redim Preserve sorted(Lbound(sorted) To Ubound(sorted)+1)
                For x As Integer=Ubound(sorted) To Lbound(sorted)+_index+1 Step -1
                    Swap sorted(x),sorted(x-1)
                Next x
                sorted(Lbound(sorted)+_index)=unsorted(z)
                Exit For
            End If
        Next z2
    Next z
     Redim Preserve sorted(ubound(sorted)-1)
End Sub

sub reverse(array() as double)
dim as integer lb=lbound(array),ub=ubound(array)
 For n As Long=Lb To int((lb+Ub)/2):Swap array(n),array(ub+lb-n):Next
end sub

Dim n As Integer=10000

Dim As Double unsorted(n)

For x As Integer=0 To n
    unsorted(x)=Rnd*1000
Next x

print
Dim As Double t1,t2
redim sorted(0) As Double'for the sorted values
Print "START"
t1=Timer
sort(unsorted(),sorted())
t2=Timer

For z As Integer=0 To 20'ubound(sorted)
    Print sorted(z)
Next z
Print "END",Ubound(sorted)+1;" elements time = ",t2-t1
print

reverse(sorted())

t1=Timer
redim as double sorted2(0)
sort(sorted(),sorted2())
t2=Timer
For z As Integer=0 To 20'ubound(sorted)
    Print sorted2(z)
Next z
print "Sort the reversed sorted array"
Print "END",Ubound(sorted2)+1;" elements time = ",t2-t1
Sleep
frisian
Posts: 231
Joined: Oct 08, 2009 17:25

Postby frisian » May 04, 2011 18:20

@MichealW
I'm sorry that you felt attacked or criticized by my text in my previous posting
it was not mend to attack or criticize you (or someone else).

I can't help it but I have to make some remarks about your shellsort ShellSortRS


'' This implementation, adapted from the second edition of Robert Sedgewick's
'' Algorithms, uses an easy to generate gap sequence that, per the author,
'' better sequences are unlikely to beat by more than 20%.


The speedup is not in the gap sequence but in the clever construction of the for next loop and the do while loop.
The do while loop makes multiple runs of the for next loop for the same gap value redundant, making the amount of compares smaller which results in a faster routine.

The routine has a clash of types

Dim As Integer low, high, h, i, j, tmp
tmp = array(i)
Array is of type double

This leads to value of array(i) get converted to a integer
Since the array is correctly sorted BadSort does not detect that the array is incorrect.
Simply remove and tmp from the dim statement and change tmp = array(i) to
VAR tmp = array(i). This is slightly slower on the reversed array but faster on the other test arrays as Dim as double.

@dodicat

Nice idea, I thought that Redim Preserve would slow down the routine but after some tinkering with came to the conclusion that it made no difference in performance.

When I first run it I got some weird results, the reversed array was the fastest and the sorted and equal routine the slowest. After inserting a checking routine I discovered why, the routine sorts from high to low.
I have altered the routine to sort from low to high, so it works like all the other sort routines, to get a fair comparison with the other sorts


Timings of all the sort routines.

Code: Select all

                         Array size = 50000

                  reversed     random       sorted       equal
    bubblesort   18.132 sec   15.551 sec    5.104 sec    5.104 sec
  exchangesort    5.379 sec    5.185 sec    5.180 sec    5.180 sec
     shellsort    0.011 sec    0.082 sec    0.003 sec    0.003 sec
 insertionsort   12.339 sec    6.192 sec    0.001 sec    0.001 sec
     gnomesort   22.186 sec   11.142 sec    0.000 sec    0.000 sec
     DafhiSort    5.101 sec    4.815 sec    2.795 sec    4.810 sec
   MDquicksort    4.140 sec    0.011 sec    3.540 sec    0.008 sec
        YQSort    0.005 sec    0.012 sec    0.005 sec    0.008 sec
    QuickSort2    0.004 sec    0.010 sec    0.004 sec    0.007 sec
   ShellSortRS    0.010 sec    0.024 sec    0.006 sec    0.006 sec
      CombSort    0.012 sec    0.022 sec    0.010 sec    0.010 sec
   dodicatsort   14.523 sec    9.845 sec    5.131 sec    5.132 sec


                         Array size = 100000

                  reversed     random       sorted       equal
    bubblesort   72.527 sec   62.061 sec   20.432 sec   20.432 sec
  exchangesort   21.517 sec   20.730 sec   20.720 sec   20.720 sec
     shellsort    0.024 sec    0.181 sec    0.007 sec    0.007 sec
 insertionsort   49.346 sec   24.619 sec    0.002 sec    0.002 sec
     gnomesort   88.743 sec   44.278 sec    0.001 sec    0.001 sec
     DafhiSort   20.403 sec   19.252 sec   11.181 sec   19.234 sec
   MDquicksort   16.567 sec    0.023 sec   14.152 sec    0.017 sec
        YQSort    0.011 sec    0.024 sec    0.011 sec    0.017 sec
    QuickSort2    0.009 sec    0.021 sec    0.008 sec    0.015 sec
   ShellSortRS    0.020 sec    0.056 sec    0.013 sec    0.013 sec
      CombSort    0.026 sec    0.044 sec    0.021 sec    0.021 sec
   dodicatsort   58.084 sec   39.256 sec   20.516 sec   20.516 sec




Timings for shell sorts and quicksorts and Combsort with large array sizes.
Have a look at Combsort it beats ShellSortRS at the random array.

Code: Select all

                         Array size = 1000000

                  reversed     random       sorted       equal
     shellsort    0.311 sec    3.370 sec    0.086 sec    0.086 sec
        YQSort    0.093 sec    0.251 sec    0.086 sec    0.182 sec
    QuickSort2    0.082 sec    0.247 sec    0.076 sec    0.178 sec
   ShellSortRS    0.235 sec    0.836 sec    0.154 sec    0.154 sec
      CombSort    0.316 sec    0.588 sec    0.266 sec    0.266 sec

                         Array size = 10000000

                  reversed     random       sorted       equal
     shellsort    3.647 sec   55.230 sec    1.057 sec    1.057 sec
        YQSort    1.053 sec    2.889 sec    0.993 sec    2.171 sec
    QuickSort2    0.995 sec    2.844 sec    0.930 sec    2.198 sec
   ShellSortRS    2.962 sec   13.135 sec    1.816 sec    1.816 sec
      CombSort    3.768 sec    6.915 sec    3.206 sec    3.206 sec

dafhi
Posts: 965
Joined: Jun 04, 2005 9:51

Postby dafhi » May 05, 2011 22:56

Researching CombSort (which I am in love with) I discovered that some sorts perform better starting at the edges, working inward.

So the bubble will go like so:

Code: Select all

For A = Start to End - 1
For B = End to A + 1 step -1
integer
Posts: 355
Joined: Feb 01, 2007 16:54
Location: usa

Re: timing program for sort routine's

Postby integer » Oct 24, 2017 17:17

Sorting a huge amount of data is one problem.

My problem is very small.
What method is best for sorting 4 values?
ONLY FOUR (4) values. Not Less than 4 and Not more than.

If you are a medical person this is the triage of 4 patients.
If gaming this is the asteroids from ship sensors.
Mine is a threading decision.

This is bubble sort

Code: Select all

SUB bsort( a() as long )
   if a(1)>a(2) then swap a(1),a(2)
   if a(1)>a(3) then swap a(1),a(3)
   if a(1)>a(4) then swap a(1),a(4)
   if a(2)>a(3) then swap a(2),a(3)
   if a(2)>a(4) then swap a(2),a(4)
   if a(3)>a(4) then swap a(3),a(4)
END SUB

about the same but 5% faster.

Code: Select all

SUB asort ( a() as long)
   if a(1)>a(2) then swap a(1),a(2)
   if a(3)>a(4) then swap a(3),a(4)
   if a(2)>a(3) then
      swap a(2),a(3)
      if a(1)>a(2) then swap a(1),a(2)
      if a(3)>a(4) then swap a(3),a(4)
      if a(2)>a(3) then swap a(2),a(3)
   end if
END SUB
The bubble short always makes 6 comparisons.
It seems that the second method ("asort") in the worst case makes 6 comparisons, and about half the time only 3.
I'm trying to grasp why the second sort ("asort") is not 1/3 or more faster?

Is there a better approach (better sorting algorithm) for sorting ONLY 4 numbers?

========================
This added Oct.31 (as a result of reading/using the forum comments that follow this one)

using a few minutes each morning while waiting for coffee to brew:
time to make a few million calls to the sub
this is the result on my molasses PC

    1.473 -- dafhi sort
    1.458 -- Bubble Sort
    1.423 -- drSort
    1.353 -- drSortDelta
    1.155 -- Bubba Swap
    1.015 -- Counting_pine sort
    0.846 -- dodicat sort

If FreeBasic had a very efficient overloaded SWAP instruction
then counting-pine's routine could not be surpassed.

dodicat avoided the swap instruction with the extra variables/assignments.
That is brilliant!

From this I learned:
1) FreeBasic's SWAP instruction is not efficient.
2) extra variables/assignments is a positive benefit.

for my current problem, I have implemented dodicat's routine. Thank you dodicat.
Thank you all.

dimwit note: for the future, probably, I will use bubble sort for less than 6 items, since it is short and easy to remember.
Last edited by integer on Oct 31, 2017 12:48, edited 1 time in total.
dodicat
Posts: 4495
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: timing program for sort routine's

Postby dodicat » Oct 24, 2017 22:23

Integer.
My input to your thread:
I had a look around and head scratch and found sort four values in 5 moves.
Here in comparison with your a and b sorts.
20 runs, see the results and see the accumulative times for each sort

Code: Select all

sub sortFour(a() as long)
    static as long b(1 to 8)
    if a(1) < a(2) then
        b(1) = a(1)
        b(2) = a(2)
    else
        b(1) = a(2)
        b(2) = a(1)
  end if
    if a(3) < a(4) then
        b(3) = a(3)
        b(4) = a(4)
    else
        b(3) = a(4)
        b(4) = a(3)
end if
    if b(1) < b(3) then
        b(5) = b(1)
        b(6) = b(3)
    else
        b(5) = b(3)
        b(6) = b(1)
end if
    if b(2) > b(4) then
        b(7) = b(2)
        b(8) = b(4)
    else
        b(7) = b(4)
        b(8) = b(2)
end if
    if b(6) < b(8) then
        a(1)=b(5):a(2)=b(6):a(3)=b(8):a(4)=b(7)
    else
         a(1)=b(5):a(2)=b(8):a(3)=b(6):a(4)=b(7)
        end if
    end sub
  '---------------- 
  SUB asort ( a() as long)
   if a(1)>a(2) then swap a(1),a(2)
   if a(3)>a(4) then swap a(3),a(4)
   if a(2)>a(3) then
      swap a(2),a(3)
      if a(1)>a(2) then swap a(1),a(2)
      if a(3)>a(4) then swap a(3),a(4)
      if a(2)>a(3) then swap a(2),a(3)
   end if
END SUB 
 '-------------------
SUB bsort( a() as long )
   if a(1)>a(2) then swap a(1),a(2)
   if a(1)>a(3) then swap a(1),a(3)
   if a(1)>a(4) then swap a(1),a(4)
   if a(2)>a(3) then swap a(2),a(3)
   if a(2)>a(4) then swap a(2),a(4)
   if a(3)>a(4) then swap a(3),a(4)
END SUB
 '---------------
    dim as long a(1 to 4)
    dim as long limit=1000000
    dim as double t,t2
    dim as long one,two,three,four
    dim as double acsort4,acasort,acbsort 'accumulate times
  #define rndlng rnd*100-rnd*100
  randomize
  '=========
 for z as long=1 to 20
     one=rndlng:two=rndlng:three=rndlng:four=rndlng 'initial random longs
   sleep 5 
     t=timer
 for n as long=1 to limit
a(1)=one
a(2)=two
a(3)=three
a(4)=four
sortfour(a())
next
t2=timer
acsort4+=t2-t
print t2-t,a(1),a(2),a(3),a(4),"Sortfour"
sleep 5

t=timer
for n as long=1 to limit 
a(1)=one
a(2)=two
a(3)=three
a(4)=four
asort(a())
next
t2=timer
acasort+=t2-t
print t2-t,a(1),a(2),a(3),a(4),"asort"
sleep 5
t=timer
for n as long=1 to limit 
a(1)=one
a(2)=two
a(3)=three
a(4)=four
bsort(a())
next
t2=timer
acbsort+=t2-t
print t2-t,a(1),a(2),a(3),a(4),"bsort"
print
next z
print
print "Total sortfour  ";acsort4
print "Total asort     ";acasort
print "Total bsort     ";acbsort
sleep
 

test with various compilers and optimisations.
counting_pine
Site Admin
Posts: 5827
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: timing program for sort routine's

Postby counting_pine » Oct 24, 2017 22:48

This routine will sort 4 numbers:

Code: Select all

sub sort4( arr() as long )
   #define A arr(1)
   #define B arr(2)
   #define C arr(3)
   #define D arr(4)

   if A <= B then ' A <= B
      if B <= C then ' A <= B <= C
         if C <= D then ' A <= B <= C <= D
            '' already sorted
         else           ' A <= B <= C, D < C
            if B <= D then ' A <= B <= D < C
               swap C, D
            else           ' A <= B <= C, D < B
               if A <= D then ' A <= D < B <= C
                  swap B, D
                  swap C, D
               else           ' D < A <= B <= C
                  swap A, D
                  swap B, D
                  swap C, D
               end if
            end if
         end if
      else           ' A <= B, C < B
         if A <= C then ' A <= C < B
            if C <= D then ' A <= C < B, C <= D
               if B <= D then ' A <= C < B <= D
                  swap B, C
               else           ' A <= C <= D < B
                  swap B, C
                  swap C, D
               end if
            else           ' A <= C < B, D < C
               if A <= D then ' A <= D < C < B
                  swap B, D
               else           ' D < A <= C < B
                  swap A, D
                  swap B, D
               end if
            end if
         else           ' C < A <= B
            if A <= D then ' C < A <= B, A <= D
               if B <= D then ' C < A <= B <= D
                  swap A, C
                  swap B, C
               else           ' C < A <= D < B
                  swap A, C
                  swap B, C
                  swap C, D
               end if
            else           ' C < A <= B, D < A
               if C <= D then ' C <= D < A <= B
                  swap A, C
                  swap B, D
               else           ' D < C < A <= B
                  swap A, D
                  swap B, C
                  swap C, D
               end if
            end if
         end if
      end if
   else           ' B < A
      if B <= C then ' B < A, B <= C
         if A <= C then ' B < A <= C
            if A <= D then ' B < A <= C, A <= D
               if C <= D then ' B < A <= C <= D
                  swap A, B
               else           ' B < A <= D < C
                  swap A, B
                  swap C, D
               end if
            else           ' B < A <= C, D < A
               if B <= D then ' B <= D < A <= C
                  swap A, B
                  swap B, D
                  swap C, D
               else           ' D < B < A <= C
                  swap A, D
                  swap C, D
               end if
            end if
         else           ' B <= C < A
            if C <= D then ' B <= C < A, C <= D
               if A <= D then ' B <= C < A <= D
                  swap A, B
                  swap B, C
               else           ' B <= C <= D < A
                  swap A, B
                  swap B, C
                  swap C, D
               end if
            else           ' B <= C < A, D < C
               if B <= D then ' B <= D < C < A
                  swap A, B
                  swap B, D
               else           ' D < B <= C < A
                  swap A, D
               end if
            end if
         end if
      else           ' C < B < A
         if C <= D then ' C < B < A, C <= D
            if B <= D then ' C < B < A, B <= D
               if A <= D then ' C < B < A <= D
                  swap A, C
               else           ' C < B < A, D < A
                  swap A, C
                  swap C, D
               end if
            else           ' C <= D < B < A
               swap A, C
               swap B, D
               swap C, D
            end if
         else           ' D < C < B < A
            swap A, D
            swap B, C
         end if
      end if
   end if
end sub

function sorted4(arr() as long) as integer
   for i as integer = 2 to 4
      if arr(i) < arr(i-1) then return 0
   next i
   return -1
end function


dim arr(1 to 4) as long
dim as integer i, j, k, l

for i as integer = 1 to 4
   for j as integer = 1 to 4
      for k as integer = 1 to 4
         for l as integer = 1 to 4

            arr(1) = i: arr(2) = j: arr(3) = k: arr(4) = l
            sort4(arr())
            if not sorted4(arr()) then
               print i; j; k; l,
               print arr(1); arr(2); arr(3); arr(4)
               exit for
            end if

         next l
      next k
   next j
next i
It uses a maximum of 5 comparisons and 3 swaps. Its best case (when already sorted) uses 3 comparisons and no swaps. I also wrote it so the reverse-sorted array would also use 3 comparisons.

It was simple enough to hard-code. I've included a thorough test to make sure no human errors have crept in.

Surprisingly - to me - I found (and eventually fixed) errors that only occurred when there were duplicate items in the array. Surprising, because I would have expected duplicate items to mask errors rather than show them up. A minor lesson learned about test thoroughness.

EDIT: Its length could be improved, at the expense of the structure, by reducing the amount of swap lines. Often the innermost if/else blocks will do similar swaps, which might be relocatable to before/after the block.

EDIT: looks like dodicat's also posted a solution while I wrote this. It uses intermediate assignments, but results in shorter code. I don't fully understand the method though.
deltarho[1859]
Posts: 736
Joined: Jan 02, 2017 0:34
Location: UK

Re: timing program for sort routine's

Postby deltarho[1859] » Oct 25, 2017 0:11

A solution with very few iterations may sound good but if the iterations take a long time to complete then speed may suffer. To me there is only one criteria - who gets over the finishing line first.

I have just dropped a snippet into dodicat's test suite and got this:

Total sortfour 0.2149173505939999
Total asort 0.2019480437502281
Total bsort 0.2316602169908961
Total drsort 0.1375380230252006

Code: Select all

Sub drSort( a() as long )
Dim As Long i, j
For i = 1 to 3
  For j = i+1 to 4
    If a(i) > a(j) Then Swap a(i), a(j)
  Next
Next
End Sub
dodicat
Posts: 4495
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: timing program for sort routine's

Postby dodicat » Oct 25, 2017 0:37

With freebasic speed tests, all the compilers need checked.
32 bit gas and gcc with gcc optimized 1,2 or 3
64 bit gcc with gcc optimized 1,2 or 3
You often get completely different results and winners for each choice.
If you get one outright champion then it's great, but often enough you just get mixed results.

If integer decides on some speedy method, then that particular sub can be made into a macro, which will probably reduce some overheads.
Or, all the methods could be made macros to start with and test from there.
drsort seems best on 32 bit -gen gcc -Wc -O3.
deltarho[1859]
Posts: 736
Joined: Jan 02, 2017 0:34
Location: UK

Re: timing program for sort routine's

Postby deltarho[1859] » Oct 25, 2017 1:18

It is worth remembering that when we execute our code it is not our code that is running but the compiled code.

I kept quiet but drsort is doing exactly the same job as bsort in BASIC terms. The question is how do they compare in compiled terms. The easier we make life for the compiler, by giving it the opportunity to use the optimisation methods at its disposal, the faster code if will give us in return.

The compiler probably looked at my effort, blinked an eye and said "Next!". With respect to some of the other code above the compiler may have said "I need to put the kettle on for this one and I am not sure I can do much in the optimisation department".

Of curse, that argument goes out of the window if we do not ask for any optimisation.
dodicat
Posts: 4495
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: timing program for sort routine's

Postby dodicat » Oct 25, 2017 1:49

FreeBASIC Compiler - Version 1.05.0
Win 10 64 bit OS

32 bit -gen gcc -Wc -O3
Total sortfour 0.2310812827057589
Total asort 0.1660331569233904
Total bsort 0.200703271110342
Total drsort 0.1517230684828519



64 bit -gen gcc -Wc -O3
Total sortfour 0.1213556656148285
Total asort 0.1439282991923392
Total bsort 0.1443115524016321
Total drsort 0.2053796541877091

Yes, the drsort is the standard bubblesort.
I'll try and incorporate counting pine's tomorrow.
deltarho[1859]
Posts: 736
Joined: Jan 02, 2017 0:34
Location: UK

Re: timing program for sort routine's

Postby deltarho[1859] » Oct 25, 2017 4:24

Pretty much the same but I have assumed the responsibility for the increments.

Code: Select all

Sub drSort( a() as long )
Dim As Long i, j
i = 1
Do
  j = i+1
  Do
    If a(i) > a(j) Then Swap a(i), a(j)
    j +=1
  Loop While j < 5
  i +=1
Loop While i < 4
End Sub

Still the fastest with 32 bit -gen gcc -Wc -O3
Neck and Neck with sortfour with 64 bit -gen gcc -Wc -O3

I had a few very odd issues with 64 bit with all my random number generators. There were large gains and losses for, what seemed, small changes in code, ill conditioned in maths, and since I do not tick any of the boxes for using 64 bit I only write 32 bit code. The 32 bit compiler seems to be the more robust of the two but it will not save us from badly written code.

Return to “General”

Who is online

Users browsing this forum: No registered users and 3 guests