Sorting algorithms/Heapsort: Difference between revisions

added FreeBASIC
(added FreeBASIC)
Line 1,541:
 
end program Heapsort_Demo</lang>
=={{header|FreeBASIC}}==
<lang freebasic>' version 22-10-2016
' compile with: fbc -s console
' for boundary checks on array's compile with: fbc -s console -exx
 
' sort from lower bound to the highter bound
' array's can have subscript range from -2147483648 to +2147483647
 
Sub siftdown(hs() As Long, start As ULong , end_ As ULong)
 
Dim As ULong root = start
Dim As Long lb = LBound(hs)
 
While root * 2 +1 < end_
Dim As ULong child = root * 2 +1
If (child +1 < end_) And (hs(lb + child) < hs(lb + child +1)) Then
child = child +1
End If
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 heapify(hs() As Long, count As ULong)
 
Dim As Long start = (count -2) \ 2
 
While start >= 0
siftdown(hs(), start, count)
start = start -1
Wend
 
End Sub
 
Sub heapsort(hs() As Long)
 
Dim As Long lb = LBound(hs)
Dim As ULong count = UBound(hs) - lb
Dim As Long start = (count -2) \ 2
 
While start >= 0
siftdown(hs(), start, count)
start = start -1
Wend
 
Dim As ULong end_ = count
While end_ > 0
Swap hs(lb + end_), hs(lb)
siftdown(hs(), 0, end_)
end_ = end_ -1
Wend
 
End Sub
 
' ------=< MAIN >=------
 
Dim As Long array(-7 To 7)
Dim As Long i, lb = LBound(array), ub = UBound(array)
 
Randomize Timer
For i = lb To ub : array(i) = i : Next
For i = lb To ub
Swap array(i), array(Int(Rnd * (ub - lb +1)) + lb)
Next
 
Print "Unsorted"
For i = lb To ub
Print Using " ###"; array(i);
Next : Print : Print
 
heapsort(array())
 
Print "After heapsort"
For i = lb To ub
Print Using " ###"; array(i);
Next : Print
 
' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End</lang>
{{out}}
<pre>Unsorted
0 3 -6 2 1 -4 7 5 6 -3 4 -7 -1 -5 -2
 
After heapsort
-7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6 7</pre>
 
=={{header|FunL}}==
457

edits