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