\ Heap Sort
\
\ Input:
\	Array of records, indexed from 1 to #records.  Array index 0
\       refers to an extra record location which is used as a temporary.
\	The arrays can be in any format you choose, so long as you
\	provide appropriate rec-copy and rec-test routines.
\
\ You must provide implementations for these deferred words:
\          rec-copy   ( i j -- )       \ Copies a record from position i to j
\          rec-test   ( i j -- flag )  \ True if record(i) is > record(j)
\    For both of these functions, if either index i or j is 0, then the
\    temporary record location is used.
\
\ Output:
\	The array from 1 to #records is left sorted in ascending order
\	according to the comparison function rec-test .
\
\ See forth/test.dir/test-sort.f  for an example use.

\ Discussion:
\ Heap sort is a very clever sorting algorithm, with some nice properties:
\   1) The sort is done in-place.  Only one extra record location is required.
\   2) The worst-case complexity is O(n log n)
\ Drawbacks:
\   1) The inner loop requires 2 comparisons.
\   2) The order of input records with duplicate keys is not necessarily
\      preserved in the sorted output.
\   3) The algorithm is not intuitive.  Consult a sorting (e.g. Knuth Vol.3)
\      or data structures (e.g. Horowitz and Sahni) text for more information.
\
\ As used here, a heap is a binary tree with the following property:
\   Each node is greater than or equal to either of its children.
\ Note that a heap is not necessarily completely sorted, because no ordering
\ is imposed between siblings.  Furthermore, it is possible that the children
\ of a node might be greater than the node's brother.
\
\ The algorithm relies on a clever representation of a heap as an array.
\ No tree pointers are necessary, because the heap is a bushy tree: every
\ level except the last is completely populated.  This yields the following
\ representation:  Node 1 is the root of the tree.  Nodes 2 and 3 are the
\ level 1 siblings, nodes 4 5 6 and 7 are the level 2 siblings, etc.
\ This allows you to traverse the tree with 2* , 2/ , and 1+ .

defer rec-copy	( i j -- )	\ Copies record from position i to position j
defer rec-test	( i j -- flag )	\ Compares record i with record j
\ Convert the initial unordered array into a heap

: create-heap	( #records -- )
	1+  2
	do	i 0 rec-copy   i		( node# )
		begin	dup 2/ 0 over rec-test	( node# parent flag )
		while	tuck swap rec-copy	( parent )
		repeat				( node# parent )
			drop 0 swap rec-copy
	loop ;

\ Reconstruct the heap by inserting the record stored in the temporary
\ location 0.  The root of the heap is empty because we extracted it and
\ put it at location rec#.  We descend the tree, copying records up into
\ vacated spaces, until we find the place where the temporary record fits.
variable more?
: fix-heap	( max-rec# -- )
	1					( rec# parent )
	more? on
	begin	( rec# parent )	2dup 2* 1+ >=	\ Exit if we have reached a leaf node
		\ or if the previous iteration found the right place for the key
		more? @ and
	while	( rec# parent )	dup 2*		( rec# parent left-child )
		\ If the parent node has more than one child, find the largest one
		2 pick  over 1+  >
		if dup dup 1+ swap rec-test if 1+ then then
			\ Do we have to move the child up?
			dup 0  rec-test			( rec# parent child flag )
			if	tuck swap rec-copy	( rec# child )
			else	drop  more? off		( rec# parent )
			then
	repeat					( rec# parent' )
	0 swap rec-copy	drop ;

: heap-sort	( #records -- )
	dup create-heap  ( #records )
	\ Now the array is a heap.  Repeatedly extract the root node of the
	\ heap, put it in its correct place in the output array, and reconstruct
	\ the heap by inserting the displaced record back into the heap.
	begin	( rec# )
		\ Loop Invariant: The array from [1..rec#] is a heap.
		\ The arrary from [rec#..#records] is sorted in ascending order.
		dup 2 >=
	while	( rec# )
		dup 0 rec-copy    \ Save record[rec#] in temporary location 0
		1 over rec-copy   \ Replace it with the record from the root of the heap
		dup fix-heap  ( rec# )
		1-
	repeat
	drop ;
