HeapSort – A compact routine that sorts data in place

' HeapSort.  A compact routine that sorts data in place (no extra memory needed)'  and is guaranteed to run in O(N log N) time no matter how the input data is ' arranged.  On the down side, it's slower than other N log N sorts (Quick and ' Merge) and not stable (does not preserve the original order of records with ' equal keys)  Works by organizing records into a "heap" data structure where ' each node is larger than its two leaves, and then repeatedly selecting the ' largest key from the root of the heap.  Two versions are given.  pHeapSortS ' is an indirect (pointerized) version for strings,'  which can be adapted to doubles by changing the declaration of A().  ' HeapSortL is a direct version for longs, which can be adapted to integers.'' Speed:  pHeapSortS sorts 500,000 random strings in 88 sec; sorts 100186 ' library call numbers in 16.2 sec; sorts 25479 dictionary words in 3.3 sec ' (random order), 3.4 sec (presorted) or 3.2 sec (reverse sorted).  HeapSortL ' sorts 500,000 random longs in 92 seconds.  Timed in Excel 2001 on an 800 mhz ' PowerBook.'' Bottom line:  compact, adapts to any date type and guarantees N log N sorting ' times, but not the fastest and not stable.' Usage:  Dim S1(L To R) As StringDim P1(L To R) As LongDim L1(L To R) As Long For I = L To R    S1(I) = GetRandomString()    P1(I) = I    L1(I) = GetRandomLong()Next IpHeapSortS L, R, S1, P1HeapSortL L, R, L1' CODE:Sub pHeapSortS(L As Long, R As Long, A() As String, P() As Long)    Dim Node As Long    Dim Last As Long    Dim TMP As Long        'build heap    For Node = (R + L)  2 To L Step -1        pHeapS Node, L, R, A, P    Next Node    'repeatedly select item at root of heap    For Last = R To L + 1 Step -1        'swap root item to final position        TMP = P(L)        P(L) = P(Last)        P(Last) = TMP        'get swapped item into right place in heap        pHeapS L, L, Last - 1, A, P    Next LastEnd SubSub pHeapS(ByVal Node As Long, L As Long, R As Long, A() As String, P() As Long)    Dim LEAF As Long    Dim TMP As Long    Do        LEAF = Node + Node - (L - 1)        If LEAF > R Then Exit Sub        'pick the larger leaf        If LEAF < R Then If A(P(LEAF + 1)) > A(P(LEAF)) Then LEAF = LEAF + 1        'if node > leaves, we're done        If A(P(Node)) > A(P(LEAF)) Then Exit Sub        'if not, swap larger leaf with node        TMP = P(Node)        P(Node) = P(LEAF)        P(LEAF) = TMP        'and move further into the heap        Node = LEAF    LoopEnd SubSub HeapSortL(L As Long, R As Long, A() As Long)    Dim Node As Long    Dim Last As Long    Dim TMP AS Long        For Node = (R + L)  2 To L Step -1        HeapL Node, L, R, A    Next Node    For Last = R To L + 1 Step -1    TMP = A(L)    A(L) = A(Last)    A(Last) = TMP        HeapL L, L, Last - 1, A    Next LastEnd SubSub HeapL(ByVal Node As Long, L As Long, R As Long, A() As Long)    Dim LEAF As Long    Dim TMP AS Long    Do        LEAF = Node + Node - (L - 1)        If LEAF > R Then Exit Sub        If LEAF < R Then If A(LEAF + 1) > A(LEAF) Then LEAF = LEAF + 1        If A(Node) > A(LEAF) Then Exit Sub        TMP = A(Node)    A(Node) = A(LEAF)    A(LEAF) = TMP        Node = LEAF    LoopEnd Sub