/* -------------------------------------------------------------
   Heaps
   -------------------------------------------------------------
   A heaps implementation a la 'Introductions to Algorithms'
   using the non-logical setarg/3 to implement constant time
   array manipulations.

   This version has been tested with SWI-Prolog version 5.6.14,
   and the (great) ECLiPSe Constraint Logic Programming System
   version 5.10 #119. Since it is not using any fancy predicate
   particular to these versions, I expect it to work with any
   other reasonably recent version of these Prolog interpreters.

   The stereo-typical use of heaps is for priority queues, for
   instance when implementing any kind of Best-First Search, like
   A* search. This is also what I have written it for.

   Please feel free to email me with questions and comments.
   
   -------------------------------------------------------------
   @author: Christian Fritz <fritz at cs toronto edu>

   @date: 10.3.2008
   -------------------------------------------------------------

   This program is free software: you can redistribute it and/or
   modify it under the terms of the GNU General Public License as
   published by the Free Software Foundation, either version 3 of
   the License, or (at your option) any later version.
   
   This program is distributed in the hope that it will be
   useful, but WITHOUT ANY WARRANTY; without even the implied
   warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
   PURPOSE. See the GNU General Public License for more details.
   
   You should have received a copy of the GNU General Public
   License along with this program. If not, see
   <http://www.gnu.org/licenses/>.
   
   -----------------------------------------------------------*/

/* Init a new heap, format heap(length[A], heap-size[A], Cmp, A),
 * where A denotes the array, and Cmp is a comparison predicate. */
heap_init(Size, Cmp, heap(Size, 0, Cmp, Array)) :-
	length(List, Size),
	Array =.. [[]|List].

heap_get(Heap, I, X) :-
	Heap = heap(_, _, _, Array),
	arg(I, Array, X).
heap_set(Heap, I, X) :-
	Heap = heap(_, _, _, Array),
	%% this is non-logical but efficient, use with caution:
	setarg(I, Array, X).

heap_empty(heap(_, 0, _, _)).


/* get parent node index */
heap_parent(I, Parent) :-
	Parent is integer(truncate(I/2)).
/* get left child index */
heap_left(I, Left) :-
	Left is 2*I.
/* get right child index */
heap_right(I, Right) :-
	Right is 2*I + 1.

/* exchange the values of two indices */
heap_exchange(Heap, A, B) :-
	heap_get(Heap, A, AA),
	heap_get(Heap, B, AB),
	heap_set(Heap, A, AB),
	heap_set(Heap, B, AA).

%%            -------------------------------
/* Extract the best element. */
heap_extract(Heap, Best) :-
	Heap = heap(_, HeapSize, _, _),
	HeapSize >= 1, %% else fail
	/* move greatest element to top */
	heap_get(Heap, 1, Best),
	heap_get(Heap, HeapSize, AHeapSize),
	heap_set(Heap, 1, AHeapSize),
	/* reduce the heap size */
	HeapSize2 is HeapSize - 1,
	setarg(2, Heap, HeapSize2),
	/* and let the new top element flow down */
	heap_heapify(Heap, 1).

%%            -------------------------------
	    
/* Create a new heap from a given list. This is more efficient
 * than inserting the elements one by one into an empty heap. It
 * can be done in O(n) (Page 133). */   
heap_from_list(Heap, List) :-
	Heap = heap(_, _, _, Array),
	heap_from_list_copy(List, 0, Array, Length),
	I is integer(truncate(Length/2)),
	setarg(2, Heap, Length),
	heap_from_list_heapify(Heap, I).

/* copy all into the array */
heap_from_list_copy([], N, _Array, N).
heap_from_list_copy([H|T], N, Array, Length) :-
	N2 is N+1,
	setarg(N2, Array, H),
	heap_from_list_copy(T, N2, Array, Length).

/* heapify for all indices I downto 1 */
heap_from_list_heapify(_Heap, 0) :- !.
heap_from_list_heapify(Heap, I) :-
	heap_heapify(Heap, I),
	I2 is I-1,
	heap_from_list_heapify(Heap, I2).

%%            -------------------------------

/** create sorted list from heap */
heap_to_list(Heap, []) :- heap_empty(Heap), !.
heap_to_list(Heap, [Best|ListT]) :-
	heap_extract(Heap, Best),
	heap_to_list(Heap, ListT).


%%            -------------------------------
/* Insert a new element. */
heap_insert(Heap, Key) :-
	Heap = heap(_, HeapSize, _, _),
	HeapSize2 is HeapSize + 1,
	setarg(2, Heap, HeapSize2),
	heap_set(Heap, HeapSize2, Key),
	heap_increase_key(Heap, HeapSize2).

/* Flow a value upwards, as long as greater than parent. */
heap_increase_key(Heap, I) :-
	heap_get(Heap, I, AI),
	heap_parent(I, Parent),
	heap_increase_key_aux(Heap, I, AI, Parent).
heap_increase_key_aux(_Heap, I, _AI, _Parent) :-
	I =< 1, !.
heap_increase_key_aux(Heap, _I, AI, Parent) :-
	Heap = heap(_, _, Cmp, _A),
 	heap_get(Heap, Parent, AParent),
	%% recursion base case, everything in order:
	heap_cmp(Cmp, AParent, AI), !.
heap_increase_key_aux(Heap, I, AI, Parent) :-
	%% still less than parent, exchange values and recurse upwards
 	heap_get(Heap, Parent, AParent),
	heap_set(Heap, I, AParent),
	heap_set(Heap, Parent, AI),
	heap_increase_key(Heap, Parent).


%%            -------------------------------
/* Heapify

   Reestablish the heap condition, using LessEq(+A, +B) for
   comparison, cf. page 130 in the algorithms book. */

heap_heapify(Heap, I) :-
	heap_left(I, L),
	heap_right(I, R),
	heap_get(Heap, I, AI),
	heap_heapify_largest(Heap, I, AI, L, Largest, ALargest),
	heap_heapify_largest(Heap, Largest, ALargest, R, Largest2, _ALargest2),
	heap_heapify_recurse(Heap, I, Largest2).

/* heap_heapify_largest(+Heap, +I, +AI, +X, -Largest, -ALargest)
Is an auxiliary predicate for heap_heapify/3 and return the index
and value of the larger of the two elements of index I and X,
where I is know to be inside the heap, while X may be outside
(and invalid in that case). */
heap_heapify_largest(Heap, I, AI, X, Largest, ALargest) :-
	Heap = heap(_,HeapSize,Cmp,_),
	X =< HeapSize, !,
	heap_get(Heap, X, AX),
	heap_heapify_largest_aux(I, AI, X, AX, Cmp, Largest, ALargest).
heap_heapify_largest(_Heap, I, AI, _X, I, AI).

heap_heapify_largest_aux(_I, AI, X, AX, Cmp, X, AX) :-
	heap_cmp(Cmp, AX, AI), !.
heap_heapify_largest_aux(I, AI, _X, _AX, _Cmp, I, AI).

/* heap_heapify_recurse(+Heap, +I, +Largest)
Another auxiliary predicate for heap_heapify/3: Decide whether
we need to let the element flow down and recurse, or stop. */
heap_heapify_recurse(_Heap, I, Largest) :-
	Largest = I, !.
heap_heapify_recurse(Heap, I, Largest) :-
	heap_exchange(Heap, I, Largest),
	heap_heapify(Heap, Largest).

%%             -------------------------------              



/* -------------------------------------------------------------
   Auxiliary
   -----------------------------------------------------------*/

/* compare two values A and B using the given comparison
 * predicate Cmp */
heap_cmp(Cmp, A, B) :-
	Call =.. [Cmp, A, B], !,
	call(Call).


/* -------------------------------------------------------------
   Tests
   -----------------------------------------------------------*/

heap_test1(X, Val) :-
	heap_init(10, <, X),
	heap_insert(X, 1),
	heap_insert(X, 4),
	heap_insert(X, 2),
	heap_insert(X, 3),
	heap_insert(X, 0),
	heap_extract(X, Val).

heap_test2 :-
	heap_init(10, <, X),
	L = [3,4,2,8,6,1,0],
	writeln(L),
	heap_from_list(X, L),
	writeln(X),
	heap_to_list(X, Sorted),
	writeln(Sorted).