' 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


The Best Mechanical Keyboards For Programmers: Where To Find Them
When it comes to programming, a good mechanical keyboard can make all the difference. Naturally, you would want one of the best mechanical keyboards for programmers. But with so many