Sorting algorithms/Heapsort: Difference between revisions
Content added Content deleted
(→{{header|FreeBASIC}}: fix a bug (e.g. [1, 2, 3, 4, 5] was wrongly sorted to [1, 2, 3, 5, 4]) and formatting) |
(Added VBA) |
||
Line 3,995: | Line 3,995: | ||
PRINT |
PRINT |
||
RETURN</lang> |
RETURN</lang> |
||
=={{header|VBA}}== |
|||
{{trans|FreeBASIC}} |
|||
<lang VBA>Sub SiftDown(list() As Integer, start As Long, eend As Long) |
|||
Dim root As Long : root = start |
|||
Dim lb As Long : lb = LBound(list) |
|||
Dim temp As Integer |
|||
While root * 2 + 1 < eend |
|||
Dim child As Long : child = root * 2 + 1 |
|||
If (child + 1 < eend) And (list(lb + child) < list(lb + child + 1)) Then |
|||
child = child + 1 |
|||
End If |
|||
If list(lb + root) < list(lb + child) Then |
|||
temp = list(lb + root) |
|||
list(lb + root) = list(lb + child) |
|||
list(lb + child) = temp |
|||
root = child |
|||
Else |
|||
Exit Sub |
|||
End If |
|||
Wend |
|||
End Sub |
|||
Sub HeapSort(list() As Integer) |
|||
Dim lb As Long : lb = LBound(list) |
|||
Dim count As Long : count = UBound(list) - lb + 1 |
|||
Dim start As Long : start = lb + (count - 2) \ 2 |
|||
While start >= 0 |
|||
SiftDown list(), start, count |
|||
start = start - 1 |
|||
Wend |
|||
Dim eend As Long : eend = count - 1 |
|||
Dim temp As Integer |
|||
While eend > 0 |
|||
temp = list(lb + eend) |
|||
list(lb + eend) = list(lb) |
|||
list(lb) = temp |
|||
SiftDown list(), 0, eend |
|||
eend = eend - 1 |
|||
Wend |
|||
End Sub</lang> |
|||
=={{header|zkl}}== |
=={{header|zkl}}== |