binomialheap.pl

   1 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   2 % Binomial Heap imlementation based on
   3 %
   4 %       Functional Binomial Queues
   5 %       James F. King
   6 %       University of Glasgow
   7 %
   8 % Author:       Tom Schrijvers
   9 % Email:        Tom.Schrijvers@cs.kuleuven.be
  10 % Copyright:    K.U.Leuven 2004
  11 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  12
  13 :- module(binomialheap,
  14         [
  15                 empty_q/1,
  16                 insert_q/3,
  17                 insert_list_q/3,
  18                 delete_min_q/3,
  19                 find_min_q/2
  20         ]).
  21
  22 :- use_module(library(lists),[reverse/2]).
  23
  24 % data Tree a = Node a [Tree a]
  25 % type BinQueue a = [Maybe (Tree a)]
  26 % data Maybe a = Zero | One a
  27 % type Item = (Entry,Key)
  28
  29 entry(Entry-_,Entry).
  30 key(_-Key,Key).
  31
  32 empty_q([]).
  33
  34 meld_q(P,Q,R) :-
  35         meld_qc(P,Q,zero,R).
  36
  37 meld_qc([],Q,zero,Q) :- !.
  38 meld_qc([],Q,C,R) :- !,
  39         meld_q(Q,[C],R).
  40 meld_qc(P,[],C,R) :- !,
  41         meld_qc([],P,C,R).
  42 meld_qc([zero|Ps],[zero|Qs],C,R) :- !,
  43         R = [C | Rs],
  44         meld_q(Ps,Qs,Rs).
  45 meld_qc([one(node(X,Xs))|Ps],[one(node(Y,Ys))|Qs],C,R) :- !,
  46         key(X,KX),
  47         key(Y,KY),
  48         ( KX < KY ->
  49                 T = node(X,[node(Y,Ys)|Xs])
  50         ;
  51                 T = node(Y,[node(X,Xs)|Ys])
  52         ),
  53         R = [C|Rs],
  54         meld_qc(Ps,Qs,one(T),Rs).
  55 meld_qc([P|Ps],[Q|Qs],C,Rs) :-
  56         meld_qc([Q|Ps],[C|Qs],P,Rs).
  57
  58 insert_q(Q,I,NQ) :-
  59         meld_q([one(node(I,[]))],Q,NQ).
  60
  61 insert_list_q([],Q,Q).
  62 insert_list_q([I|Is],Q,NQ) :-
  63         insert_q(Q,I,Q1),
  64         insert_list_q(Is,Q1,NQ).
  65
  66 min_tree([T|Ts],MT) :-
  67         min_tree_acc(Ts,T,MT).
  68
  69 min_tree_acc([],MT,MT).
  70 min_tree_acc([T|Ts],Acc,MT) :-
  71         least(T,Acc,NAcc),
  72         min_tree_acc(Ts,NAcc,MT).
  73
  74 least(zero,T,T) :- !.
  75 least(T,zero,T) :- !.
  76 least(one(node(X,Xs)),one(node(Y,Ys)),T) :-
  77         key(X,KX),
  78         key(Y,KY),
  79         ( KX < KY ->
  80                 T = one(node(X,Xs))
  81         ;
  82                 T = one(node(Y,Ys))
  83         ).
  84
  85 remove_tree([],_,[]).
  86 remove_tree([T|Ts],I,[NT|NTs]) :-
  87         ( T == zero ->
  88                 NT = T
  89         ;
  90                 T = one(node(X,_)),
  91                 ( X == I ->
  92                         NT = zero
  93                 ;
  94                         NT = T
  95                 )
  96         ),
  97         remove_tree(Ts,I,NTs).
  98
  99 delete_min_q(Q,NQ,Min) :-
 100         min_tree(Q,one(node(Min,Ts))),
 101         remove_tree(Q,Min,Q1),
 102         reverse(Ts,RTs),
 103         make_ones(RTs,Q2),
 104         meld_q(Q2,Q1,NQ).
 105
 106 make_ones([],[]).
 107 make_ones([N|Ns],[one(N)|RQ]) :-
 108         make_ones(Ns,RQ).
 109
 110 find_min_q(Q,I) :-
 111         min_tree(Q,one(node(I,_))).
 112
 113