Heap Sort


Option Explicit
Sub Main()
    Dim someArr, x, ArrStr
    someArr = Array(31, 25, 12, 22, 11, 85, 68, 574, 25, 36, 287, 36, 16)
    Call heapSort(someArr)
    For Each x In someArr
        ArrStr = ArrStr & x & ", "
    Next
    ArrStr = left(ArrStr, Len(ArrStr) - 2)
    MsgBox "The Array after Heap Sort is : " & vbCrLf & ArrStr
End Sub
Sub heapSort(TargetArray)
  Dim i, temp, array_size
    array_size = UBound(TargetArray)
  For i = Int((array_size / 2)) To 0 Step -1
    Call siftDown(TargetArray, i, UBound(TargetArray))
  Next
  For i = array_size To 1 Step -1
    temp = TargetArray(0)
    TargetArray(0) = TargetArray(i)
    TargetArray(i) = temp
    Call siftDown(TargetArray, 0, i - 1)
  Next
End Sub

Sub siftDown(TargetArray, root, bottom)
  Dim done, maxChild, temp

  done = 0
  While root * 2 <= bottom And done = 0
    If root * 2 = bottom Then
      maxChild = root * 2
    ElseIf TargetArray(root * 2) > TargetArray(root * 2 + 1) Then
      maxChild = root * 2
    Else
      maxChild = root * 2 + 1
    End If
    If TargetArray(root) < TargetArray(maxChild) Then
      temp = TargetArray(root)
      TargetArray(root) = TargetArray(maxChild)
      TargetArray(maxChild) = temp
      root = maxChild
    Else
      done = 1
    End If
  Wend
End Sub