Sorting Arrays – Heap Sort

Heapsort is a comparison-based sorting algorithm, and is part of the selection sort family. Although somewhat slower in practice on most machines than a good
implementation of quicksort, it has the advantage of a worst-case O(n log n) runtime. Heapsort is an in-place algorithm, but is not a stable sort.

Heap Sort Animation

Heapsort inserts the input list elements into a heap data structure. The largest value (in a max-heap) or the smallest value (in a min-heap) are extracted until none remain, the values having been extracted in sorted order. The heap’s invariant is preserved after each extraction, so the only cost is that of extraction
During extraction, the only space required is that needed to store the heap. In order to achieve constant space overhead, the heap is stored in the part of the input array that has not yet been sorted. (The structure of this heap is described at Binary heap: Heap implementation.)
Heapsort uses two heap operations: insertion and root deletion.
Each extraction places an element in the last empty location of the array. The remaining prefix of the array stores the unsorted elements.

Public Sub heapSort( ByRef arr() )

    Dim i, temp, arrSize

    arrSize = UBound( arr ) + 1

    For i = ( arrSize / 2 ) - 1 To 0 Step - 1

        Call siftDown( arr, i, arrSize )

    Next

    For i = arrSize - 1 To 1 Step - 1

        temp = arr( 0 )

        arr( 0 ) = arr( i )

        arr( i ) = temp

        Call siftDown( arr, 0, i - 1 )

    Next

End Sub

Private Sub siftDown( ByRef arr(), ByVal root, ByVal bottom )

    Dim done, maxChild, temp

    done = 0

    Do While( root * 2 <= bottom ) And ( Not done )

        If root * 2 = bottom Then

            maxChild = root * 2

        ElseIf arr( root * 2 ) > arr( root * 2 + 1 ) Then

            maxChild = root * 2

        Else

            maxChild = root * 2 + 1

        End If

        If arr( root ) < arr( maxChild ) Then

            temp = arr( root )

            arr( root ) = arr( maxChild )

            arr( maxChild ) = temp

            root = maxChild

        Else

            done = True

        End If

    Loop

End Sub