%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Binomial Heap imlementation based on
%	
%	Functional Binomial Queues
%	James F. King
%	University of Glasgow
%
% Author:	Tom Schrijvers
% Email:	Tom.Schrijvers@cs.kuleuven.be
% Copyright:	K.U.Leuven 2004
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

:- module(binomialheap,
	[
		empty_q/1,
		insert_q/3,
		insert_list_q/3,
		delete_min_q/3,
		find_min_q/2
	]).	

:- use_module(library(lists),[reverse/2]).

:- use_module(type_check).

:- type tree(A)  	---> node(A,list(tree(A))).

:- type maybe(A) 	---> zero ; one(A).

:- type item(A) 	== pair(A,integer).

:- type binTree(A)	== tree(item(A)).

:- type binQueue(A) 	== list(maybe(binTree(A))).

%------------------------------------------------------------------------------%
:- pred entry(pair(A,_),A).
%------------------------------------------------------------------------------%

entry(Entry-_,Entry).

%------------------------------------------------------------------------------%
:- pred key(pair(_,B),B).
%------------------------------------------------------------------------------%

key(_-Key,Key).

%------------------------------------------------------------------------------%
:- pred empty_q(list(maybe(tree(_)))).
%------------------------------------------------------------------------------%

empty_q([]).

%------------------------------------------------------------------------------%
:- pred meld_q(binQueue(A),
	       binQueue(A),
	       binQueue(A)).
%------------------------------------------------------------------------------%

meld_q(P,Q,R) :-
	meld_qc(P,Q,zero,R).

%------------------------------------------------------------------------------%
:- pred meld_qc(binQueue(A),
		binQueue(A),
		     maybe(binTree(A)),
		binQueue(A)).
%------------------------------------------------------------------------------%

meld_qc([],Q,zero,Q) :- !.
meld_qc([],Q,C,R) :- !,
	meld_q(Q,[C],R).
meld_qc(P,[],C,R) :- !,
	meld_qc([],P,C,R).
meld_qc([zero|Ps],[zero|Qs],C,R) :- !,
	R = [C | Rs],
	meld_q(Ps,Qs,Rs).
meld_qc([one(node(X,Xs))|Ps],[one(node(Y,Ys))|Qs],C,R) :- !,
	key(X,KX),
	key(Y,KY),
	( KX < KY ->
		T = node(X,[node(Y,Ys)|Xs])
	;
		T = node(Y,[node(X,Xs)|Ys])
	),
	R = [C|Rs],
	meld_qc(Ps,Qs,one(T),Rs).
meld_qc([P|Ps],[Q|Qs],C,Rs) :-
	meld_qc([Q|Ps],[C|Qs],P,Rs).

%------------------------------------------------------------------------------%
:- pred insert_q(binQueue(A),item(A),binQueue(A)).
%------------------------------------------------------------------------------%

insert_q(Q,I,NQ) :-
	meld_q([one(node(I,[]))],Q,NQ).

%------------------------------------------------------------------------------%
:- pred insert_list_q(list(item(A)),binQueue(A),binQueue(A)).
%------------------------------------------------------------------------------%

insert_list_q([],Q,Q).
insert_list_q([I|Is],Q,NQ) :-
	insert_q(Q,I,Q1),
	insert_list_q(Is,Q1,NQ).

%------------------------------------------------------------------------------%
:- pred min_tree(binQueue(A),maybe(binTree(A))).
%------------------------------------------------------------------------------%

min_tree([T|Ts],MT) :-
	min_tree_acc(Ts,T,MT).

%------------------------------------------------------------------------------%
:- pred min_tree_acc(binQueue(A),maybe(binTree(A)),maybe(binTree(A))).
%------------------------------------------------------------------------------%

min_tree_acc([],MT,MT).
min_tree_acc([T|Ts],Acc,MT) :-
	least(T,Acc,NAcc),
	min_tree_acc(Ts,NAcc,MT).

%------------------------------------------------------------------------------%
:- pred least(maybe(binTree(A)),maybe(binTree(A)),maybe(binTree(A))).
%------------------------------------------------------------------------------%

least(zero,T,T) :- !.
least(T,zero,T) :- !.
least(one(node(X,Xs)),one(node(Y,Ys)),T) :-
	key(X,KX),
	key(Y,KY),
	( KX < KY ->
		T = one(node(X,Xs))
	;
		T = one(node(Y,Ys))
	).		

%------------------------------------------------------------------------------%
:- pred remove_tree(binQueue(A),item(A),binQueue(A)).
%------------------------------------------------------------------------------%

remove_tree([],_,[]).
remove_tree([T|Ts],I,[NT|NTs]) :-
	( T == zero ->
		NT = T
	;
		T = one(node(X,_)),
		( X == I ->
			NT = zero
		;
			NT = T
		)
	),
	remove_tree(Ts,I,NTs).

%------------------------------------------------------------------------------%
:- pred delete_min_q(binQueue(A),binQueue(A),item(A)).
%------------------------------------------------------------------------------%

delete_min_q(Q,NQ,Min) :-
	min_tree(Q,one(node(Min,Ts))),
	remove_tree(Q,Min,Q1),
	reverse(Ts,RTs) :: reverse(list(binTree(A)),list(binTree(A))),
			% the cast is here because we're calling 	
			% the untyped predicate reverse/2
			% and we don't trust it
	make_ones(RTs,Q2),
	meld_q(Q2,Q1,NQ).	

%------------------------------------------------------------------------------%
:- pred make_ones(list(T),list(maybe(T))).
%------------------------------------------------------------------------------%

make_ones([],[]).
make_ones([N|Ns],[one(N)|RQ]) :-
	make_ones(Ns,RQ).

%------------------------------------------------------------------------------%
:- pred find_min_q(binQueue(A),item(A)).
%------------------------------------------------------------------------------%

find_min_q(Q,I) :-
	min_tree(Q,one(node(I,_))).