September 2017 Update

This commit is contained in:
Ingy döt Net 2017-09-23 10:01:46 +02:00
parent bba7bfd280
commit ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions

View file

@ -2,18 +2,17 @@
' 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
' 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)
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
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)
@ -22,27 +21,24 @@ Sub siftdown(hs() As Long, start As ULong , end_ As ULong)
Return
End If
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
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, count)
start = start -1
siftdown(hs(), start, end_)
start = start - 1
Wend
Dim As ULong end_ = count
While end_ > 0
Swap hs(lb + end_), hs(lb)
end_ = end_ - 1
siftdown(hs(), 0, end_)
end_ = end_ -1
Wend
End Sub
' ------=< MAIN >=------
@ -53,7 +49,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)
Swap array(i), array(Int(Rnd * (ub - lb + 1)) + lb)
Next
Print "Unsorted"