Compare sorting algorithms' performance: Difference between revisions
Compare sorting algorithms' performance (view source)
Revision as of 21:06, 19 February 2023
, 1 year agoCompare sorting algorithms' performance in FreeBASIC
(added Raku programming solution) |
(Compare sorting algorithms' performance in FreeBASIC) |
||
Line 338:
Return var
}</syntaxhighlight>
=={{header|FreeBASIC}}==
<syntaxhighlight lang="freebasic">#Macro sort_1(sortname)
Rset buffer, #sortname
Print buffer;
copy_array(rev(), sort())
t1 = Timer
sortname(sort())
t2 = Timer - t1
Print Using " ###.###&"; t2; " sec";
copy_array(ran(), sort())
t1 = Timer
sortname(sort())
t2 = Timer - t1
Print Using " ###.###&"; t2; " sec";
t1 = Timer
sortname(sort())
t2 = Timer - t1
Print Using " ###.###&"; t2; " sec";
copy_array(eq(), sort())
t1 = Timer
sortname(sort())
t2 = Timer - t1
Print Using " ###.###&"; t2; " sec"
#EndMacro
#Macro sort_2(sortname)
Rset buffer, #sortname
Print buffer;
copy_array(rev(), sort())
t1 = Timer
sortname(sort(), Lbound(sort), Ubound(sort))
t2 = Timer - t1
Print Using " ###.###&"; t2; " sec";
copy_array(ran(), sort())
t1 = Timer
sortname(sort(), Lbound(sort), Ubound(sort))
t2 = Timer - t1
Print Using " ###.###&"; t2; " sec";
t1 = Timer
sortname(sort(), Lbound(sort), Ubound(sort))
t2 = Timer - t1
Print Using " ###.###&"; t2; " sec";
copy_array(eq(),sort())
t1 = Timer
sortname(sort(), Lbound(sort), Ubound(sort))
t2 = Timer - t1
Print Using " ###.###&"; t2; " sec"
#EndMacro
Sub bubbleSort(array() As Double)
Dim As Integer i, lb = Lbound(array), ub = Ubound(array)
For p1 As Uinteger = 0 To ub - 1
For p2 As Uinteger = p1 + 1 To ub
'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 i = lb To ub - 1
If array(i) > array(i + 1) Then Beep
Next
End Sub
Sub exchangeSort(array() As Double)
Dim As Uinteger i, j, min, ub = Ubound(array)
For i = 0 To ub
min = i
For j = i+1 To ub
If (array(j) < array(min)) Then min = j
Next j
If min > i Then Swap array(i), array(min)
Next i
End Sub
Sub insertionSort(array() As Double)
Dim As Uinteger ub = Ubound(array)
Dim As Uinteger i, j, temp, temp2
For i = 1 To ub
temp = array(i)
temp2 = temp
j = i
While j >= 1 Andalso array(j-1) > temp2
array(j) = array(j - 1)
j -= 1
Wend
array(j) = temp
Next i
End Sub
Sub siftdown(hs() As Double, inicio As Ulong, final As Ulong)
Dim As Ulong root = inicio
Dim As Long lb = Lbound(hs)
While root * 2 + 1 <= final
Dim As Ulong child = root * 2 + 1
If (child + 1 <= final) Andalso (hs(lb + child) < hs(lb + child + 1)) Then child += 1
If hs(lb + root) < hs(lb + child) Then
Swap hs(lb + root), hs(lb + child)
root = child
Else
Return
End If
Wend
End Sub
Sub heapSort(array() As Double)
Dim As Long lb = Lbound(array)
Dim As Ulong count = Ubound(array) - lb + 1
Dim As Long inicio = (count - 2) \ 2
Dim As Ulong final = count - 1
While inicio >= 0
siftdown(array(), inicio, final)
inicio -= 1
Wend
While final > 0
Swap array(lb + final), array(lb)
final -= 1
siftdown(array(), 0, final)
Wend
End Sub
Sub shellSort(array() As Double)
Dim As Uinteger lb = Lbound(array), ub = Ubound(array)
Dim As Uinteger i, inc = ub - lb
Dim As Boolean done
Do
inc = Int(inc / 2.2)
If inc < 1 Then inc = 1
Do
done = false
For i = lb To ub - inc
' reemplace "<" con ">" para ordenación descendente
If array(i) > array(i + inc) Then
Swap array(i), array(i + inc)
done = true
End If
Next i
Loop Until done = false
Loop Until inc = 1
End Sub
Sub quickSort(array() As Double, l As Integer, r As Integer)
Dim As Uinteger size = r - l +1
If size < 2 Then Exit Sub
Dim As Integer i = l, j = r
Dim As Double pivot = array(l + size \ 2)
Do
While array(i) < pivot
i += 1
Wend
While pivot < array(j)
j -= 1
Wend
If i <= j Then
Swap array(i), array(j)
i += 1
j -= 1
End If
Loop Until i > j
If l < j Then quickSort(array(), l, j)
If i < r Then quickSort(array(), i, r)
End Sub
Sub rapidSort (array()As Double, inicio As Integer, final As Integer)
Dim As Integer n, wert, nptr, arr, rep
Dim As Integer LoVal = array(inicio), HiVal = array(final)
For n = inicio To final
If LoVal> array(n) Then LoVal = array(n)
If HiVal< array(n) Then HiVal = array(n)
Next
Redim SortArray(LoVal To HiVal) As Double
For n = inicio To final
wert = array(n)
SortArray(wert) += 1
Next
nptr = inicio-1
For arr = LoVal To HiVal
rep = SortArray(arr)
For n = 1 To rep
nptr += 1
array(nptr) = arr
Next
Next
Erase SortArray
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
Dim As Integer x, max = 1e5
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
' 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 x
For x = Lbound(rev) To (Ubound(rev) \ 2)
Swap rev(x), rev(Ubound(rev) - x)
Next x
Print !"Test times in sec\nArray size ="; max
Print !"\n *Reversed* *Random* *Sorted* *All ones*"
sort_1(bubbleSort)
sort_1(exchangeSort)
sort_1(insertionSort)
sort_1(heapSort)
sort_1(shellSort)
sort_2(quickSort)
sort_2(rapidSort)
Sleep</syntaxhighlight>
{{out}}
<pre>Test times in sec
Array size = 100000
*Reversed* *Random* *Sorted* *All ones*
bubbleSort 31.645 sec 31.560 sec 12.765 sec 12.754 sec
exchangeSort 12.706 sec 12.708 sec 12.713 sec 12.700 sec
insertionSort 4.724 sec 4.739 sec 0.004 sec 0.004 sec
heapSort 0.028 sec 0.029 sec 0.021 sec 0.002 sec
shellSort 0.049 sec 0.049 sec 0.003 sec 0.003 sec
quickSort 0.013 sec 0.013 sec 0.004 sec 0.005 sec
rapidSort 0.004 sec 0.004 sec 0.004 sec 0.007 sec</pre>
=={{header|BBC BASIC}}==
| |||