Initial data commit

Task/Sorting-algorithms-Heapsort/FreeBASIC/sorting-algorithms-heapsort.basic

@@ -0,0 +1,71 @@
+' 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 higher 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_) AndAlso (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 heapsort(hs() As Long)
+    Dim As Long lb = LBound(hs)
+    Dim As ULong count = UBound(hs) - lb + 1
+    Dim As Long start = (count - 2) \ 2
+    Dim As ULong end_ = count - 1
+
+    While start >= 0
+        siftdown(hs(), start, end_)
+        start = start - 1
+    Wend
+
+    While end_ > 0
+        Swap hs(lb + end_), hs(lb)
+        end_ = end_ - 1
+        siftdown(hs(), 0, end_)
+    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